module Text.ParserCombinators.Poly.ByteString
(
Parser(P)
, Result(..)
, runParser
, next
, eof
, satisfy
, reparse
, module Text.ParserCombinators.Poly.Base
) where
import Text.ParserCombinators.Poly.Base
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Lazy.Char8 (ByteString)
newtype Parser a = P (ByteString -> Result ByteString a)
data Result z a = Success z a
| Failure z String
| Committed (Result z a)
instance Functor (Result z) where
fmap f (Success z a) = Success z (f a)
fmap _ (Failure z e) = Failure z e
fmap f (Committed r) = Committed (fmap f r)
runParser :: Parser a -> ByteString -> (Either String a, ByteString)
runParser (P p) = resultToEither . p
where
resultToEither :: Result z a -> (Either String a, z)
resultToEither (Success z a) = (Right a, z)
resultToEither (Failure z e) = (Left e, z)
resultToEither (Committed r) = resultToEither r
instance Functor Parser where
fmap f (P p) = P (fmap f . p)
instance Monad Parser where
return x = P (\ts-> Success ts x)
fail e = P (\ts-> Failure ts e)
(P f) >>= g = P (continue . f)
where
continue (Success ts x) = let (P g') = g x in g' ts
continue (Committed (Committed r)) = continue (Committed r)
continue (Committed r) = Committed (continue r)
continue (Failure ts e) = Failure ts e
instance PolyParse Parser where
commit (P p) = P (Committed . p)
(P p) `adjustErr` f = P (adjust . p)
where
adjust (Failure z e) = Failure z (f e)
adjust (Committed r) = Committed (adjust r)
adjust good = good
(P p) `onFail` (P q) = P (\ts-> continue ts $ p ts)
where
continue ts (Failure _ _) = q ts
continue _ r = r
oneOf' = accum []
where accum errs [] =
fail ("failed to parse any of the possible choices:\n"
++indent 2 (concatMap showErr (reverse errs)))
accum errs ((e,P p):ps) =
P (\ts-> case p ts of
Failure _ err ->
let (P p') = accum ((e,err):errs) ps
in p' ts
r@(Success _ _) -> r
r@(Committed _) -> r )
showErr (name,err) = name++":\n"++indent 2 err
next :: Parser Char
next = P (\bs-> case BS.uncons bs of
Nothing -> Failure bs "Ran out of input (EOF)"
Just (c, bs') -> Success bs' c )
eof :: Parser ()
eof = P (\bs -> if BS.null bs
then Success bs ()
else Failure bs "Expected end of input (EOF)" )
satisfy :: (Char -> Bool) -> Parser Char
satisfy f = do { x <- next
; if f x then return x else fail "Parse.satisfy: failed"
}
reparse :: ByteString -> Parser ()
reparse ts = P (\inp-> Success (ts `BS.append` inp) ())