module Darcs.Util.Parser
    ( Parser
    , anyChar
    , char
    , checkConsumes
    , choice
    , endOfInput
    , int
    , lexChar
    , lexString
    , linesStartingWith
    , linesStartingWithEndingWith
    , lexWord
    , option
    , optional
    , parse
    , skipSpace
    , skipWhile
    , string
    , take
    , takeTill
    , takeTillChar
    ) where

import Control.Applicative ( empty, many, optional, (<|>) )

import Darcs.Prelude hiding ( lex, take )

import qualified Data.Attoparsec.ByteString as A
import Data.Attoparsec.ByteString.Char8 hiding ( parse, char, string )
import qualified Data.Attoparsec.ByteString.Char8 as AC
import qualified Data.ByteString as B

parse :: Parser a -> B.ByteString -> Either String (a, B.ByteString)
parse :: forall a. Parser a -> ByteString -> Either String (a, ByteString)
parse Parser a
p ByteString
bs =
  case forall a. Parser a -> ByteString -> Result a
AC.parse Parser a
p ByteString
bs of
    Fail ByteString
_ [String]
ss String
s -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines (String
sforall a. a -> [a] -> [a]
:[String]
ss)
    Partial ByteString -> IResult ByteString a
k ->
      case ByteString -> IResult ByteString a
k ByteString
B.empty of
        Fail ByteString
_ [String]
ss String
s -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines (String
sforall a. a -> [a] -> [a]
:[String]
ss)
        Partial ByteString -> IResult ByteString a
_ -> forall a. HasCallStack => String -> a
error String
"impossible"
        Done ByteString
i a
r -> forall a b. b -> Either a b
Right (a
r, ByteString
i)
    Done ByteString
i a
r -> forall a b. b -> Either a b
Right (a
r, ByteString
i)

{-# INLINE skip #-}
skip :: Parser a -> Parser ()
skip :: forall a. Parser a -> Parser ()
skip Parser a
p = Parser a
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE lex #-}
lex :: Parser a -> Parser a
lex :: forall a. Parser a -> Parser a
lex Parser a
p = Parser ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p

{-# INLINE lexWord #-}
lexWord :: Parser B.ByteString
lexWord :: Parser ByteString
lexWord = forall a. Parser a -> Parser a
lex ((Word8 -> Bool) -> Parser ByteString
A.takeWhile1 (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isSpace_w8))

{-# INLINE lexChar #-}
lexChar :: Char -> Parser ()
lexChar :: Char -> Parser ()
lexChar Char
c = forall a. Parser a -> Parser a
lex (Char -> Parser ()
char Char
c)

{-# inline lexString #-}
lexString :: B.ByteString -> Parser ()
lexString :: ByteString -> Parser ()
lexString ByteString
s = forall a. Parser a -> Parser a
lex (ByteString -> Parser ()
string ByteString
s)

{-# INLINE char #-}
char :: Char -> Parser ()
char :: Char -> Parser ()
char = forall a. Parser a -> Parser ()
skip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser Char
AC.char

{-# INLINE string #-}
string :: B.ByteString -> Parser ()
string :: ByteString -> Parser ()
string = forall a. Parser a -> Parser ()
skip forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser ByteString
AC.string

{-# INLINE int #-}
int :: Parser Int
int :: Parser Int
int = forall a. Parser a -> Parser a
lex (forall a. Num a => Parser a -> Parser a
signed forall a. Integral a => Parser a
decimal)

{-# INLINE takeTillChar #-}
takeTillChar :: Char -> Parser B.ByteString
takeTillChar :: Char -> Parser ByteString
takeTillChar Char
c = (Char -> Bool) -> Parser ByteString
takeTill (forall a. Eq a => a -> a -> Bool
== Char
c)

{-# INLINE checkConsumes #-}
checkConsumes :: Parser a -> Parser a
checkConsumes :: forall a. Parser a -> Parser a
checkConsumes Parser a
parser = do
  (ByteString
consumed, a
result) <- forall a. Parser a -> Parser (ByteString, a)
match Parser a
parser
  if ByteString -> Bool
B.null ByteString
consumed
    then forall (f :: * -> *) a. Alternative f => f a
empty
    else forall (m :: * -> *) a. Monad m => a -> m a
return a
result

{-# INLINE linesStartingWith #-}
linesStartingWith :: Char -> Parser [B.ByteString]
linesStartingWith :: Char -> Parser [ByteString]
linesStartingWith Char
c = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ do
  Char -> Parser ()
char Char
c
  ByteString
r <- Char -> Parser ByteString
takeTillChar Char
'\n'
  forall a. Parser a -> Parser ()
skip (Char -> Parser ()
char Char
'\n') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall t. Chunk t => Parser t ()
endOfInput
  forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
r

{-# INLINE linesStartingWithEndingWith #-}
linesStartingWithEndingWith :: Char -> Char -> Parser [B.ByteString]
linesStartingWithEndingWith :: Char -> Char -> Parser [ByteString]
linesStartingWithEndingWith Char
st Char
en = do
  [ByteString]
ls <- Char -> Parser [ByteString]
linesStartingWith Char
st
  Char -> Parser ()
char Char
en
  forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
ls