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

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

{-# INLINE lex #-}
lex :: Parser a -> Parser a
lex :: Parser a -> Parser a
lex Parser a
p = Parser ()
skipSpace Parser () -> Parser a -> Parser a
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 = Parser ByteString -> Parser ByteString
forall a. Parser a -> Parser a
lex ((Word8 -> Bool) -> Parser ByteString
A.takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
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 = Parser () -> Parser ()
forall a. Parser a -> Parser a
lex (Char -> Parser ()
char Char
c)

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

{-# INLINE char #-}
char :: Char -> Parser ()
char :: Char -> Parser ()
char = Parser Char -> Parser ()
forall a. Parser a -> Parser ()
skip (Parser Char -> Parser ())
-> (Char -> Parser Char) -> Char -> Parser ()
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 = Parser ByteString -> Parser ()
forall a. Parser a -> Parser ()
skip (Parser ByteString -> Parser ())
-> (ByteString -> Parser ByteString) -> ByteString -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser ByteString
AC.string

{-# INLINE int #-}
int :: Parser Int
int :: Parser Int
int = Parser Int -> Parser Int
forall a. Parser a -> Parser a
lex (Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
signed Parser Int
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)

{-# INLINE checkConsumes #-}
checkConsumes :: Parser a -> Parser a
checkConsumes :: Parser a -> Parser a
checkConsumes Parser a
parser = do
  (ByteString
consumed, a
result) <- Parser a -> Parser (ByteString, a)
forall a. Parser a -> Parser (ByteString, a)
match Parser a
parser
  if ByteString -> Bool
B.null ByteString
consumed
    then Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
    else a -> Parser a
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 = Parser ByteString -> Parser [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString -> Parser [ByteString])
-> Parser ByteString -> Parser [ByteString]
forall a b. (a -> b) -> a -> b
$ do
  Char -> Parser ()
char Char
c
  ByteString
r <- Char -> Parser ByteString
takeTillChar Char
'\n'
  Parser () -> Parser ()
forall a. Parser a -> Parser ()
skip (Char -> Parser ()
char Char
'\n') Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall t. Chunk t => Parser t ()
endOfInput
  ByteString -> Parser ByteString
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
  [ByteString] -> Parser [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
ls