module Darcs.Util.Parser
    ( Parser
    , anyChar
    , char
    , checkConsumes
    , choice
    , endOfInput
    , int
    , lexChar
    , lexString
    , linesStartingWith
    , linesStartingWithEndingWith
    , lexWord
    , A.lookAhead
    , many
    , option
    , optional
    , parse
    , parseAll
    , skipSpace
    , skipWhile
    , string
    , take
    , takeTill
    , takeTillChar
    , unsigned
    , withPath
    , (<|>)
    ) where

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

import Darcs.Prelude hiding ( lex, take )

import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.Combinator 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

withPath :: FilePath -> Either String a -> Either String a
withPath :: forall a. FilePath -> Either FilePath a -> Either FilePath a
withPath FilePath
fp (Left FilePath
s) = FilePath -> Either FilePath a
forall a b. a -> Either a b
Left (FilePath
"in file: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
fpFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
": "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
s)
withPath FilePath
_ Either FilePath a
r = Either FilePath a
r

parseAll :: Parser a -> B.ByteString -> Either String a
parseAll :: forall a. Parser a -> ByteString -> Either FilePath a
parseAll Parser a
p ByteString
bs =
  case Parser a -> ByteString -> Either FilePath (a, ByteString)
forall a. Parser a -> ByteString -> Either FilePath (a, ByteString)
parse Parser a
p ByteString
bs of
    Left FilePath
e -> FilePath -> Either FilePath a
forall a b. a -> Either a b
Left FilePath
e
    Right (a
r, ByteString
leftover)
      | ByteString -> Bool
B.null ((Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile Word8 -> Bool
isSpace_w8 ByteString
leftover) -> a -> Either FilePath a
forall a b. b -> Either a b
Right a
r
      | Bool
otherwise -> FilePath -> Either FilePath a
forall a b. a -> Either a b
Left (FilePath -> Either FilePath a) -> FilePath -> Either FilePath a
forall a b. (a -> b) -> a -> b
$ FilePath
"leftover: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
leftover

parse :: Parser a -> B.ByteString -> Either String (a, B.ByteString)
parse :: forall a. Parser a -> ByteString -> Either FilePath (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
_ [FilePath]
ss FilePath
s -> FilePath -> Either FilePath (a, ByteString)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (a, ByteString))
-> FilePath -> Either FilePath (a, ByteString)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines (FilePath
sFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ss)
    Partial ByteString -> Result a
k ->
      case ByteString -> Result a
k ByteString
B.empty of
        Fail ByteString
_ [FilePath]
ss FilePath
s -> FilePath -> Either FilePath (a, ByteString)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (a, ByteString))
-> FilePath -> Either FilePath (a, ByteString)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines (FilePath
sFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ss)
        Partial ByteString -> Result a
_ -> FilePath -> Either FilePath (a, ByteString)
forall a. HasCallStack => FilePath -> a
error FilePath
"impossible"
        Done ByteString
i a
r -> (a, ByteString) -> Either FilePath (a, ByteString)
forall a b. b -> Either a b
Right (a
r, ByteString
i)
    Done ByteString
i a
r -> (a, ByteString) -> Either FilePath (a, ByteString)
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 Parser a -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall a. a -> Parser ByteString a
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 Parser () -> Parser a -> Parser a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
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 unsigned #-}
unsigned :: Integral a => Parser a
unsigned :: forall a. Integral a => Parser a
unsigned = Parser a -> Parser a
forall a. Parser a -> Parser a
lex Parser a
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 :: forall a. 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 a. Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a
empty
    else a -> Parser a
forall a. a -> Parser ByteString 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 a. Parser ByteString a -> Parser ByteString [a]
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 a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall t. Chunk t => Parser t ()
endOfInput
  ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
ls