diff --git a/polyparse.cabal b/polyparse.cabal --- a/polyparse.cabal +++ b/polyparse.cabal @@ -1,5 +1,5 @@ name: polyparse -version: 1.7 +version: 1.8 license: LGPL license-file: COPYRIGHT author: Malcolm Wallace @@ -39,10 +39,11 @@ build-depends: text exposed-modules: Text.ParserCombinators.Poly.ByteString + Text.ParserCombinators.Poly.ByteStringChar Text.Parse.ByteString Text.ParserCombinators.Poly.Text Text.ParserCombinators.Poly.StateText -- Text.Parse.Text - cpp-options: -DVERSION="1.7" + cpp-options: -DVERSION="1.8" nhc98-options: -K6M extensions: CPP diff --git a/src/Text/Parse/ByteString.hs b/src/Text/Parse/ByteString.hs --- a/src/Text/Parse/ByteString.hs +++ b/src/Text/Parse/ByteString.hs @@ -26,7 +26,7 @@ , parseFloat , parseLitChar -- ** Re-export all the more general combinators from Poly too - , module Text.ParserCombinators.Poly.ByteString + , module Text.ParserCombinators.Poly.ByteStringChar -- ** ByteStrings and Strings as whole entities , allAsByteString , allAsString @@ -38,7 +38,7 @@ import Data.Ratio import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) -import Text.ParserCombinators.Poly.ByteString +import Text.ParserCombinators.Poly.ByteStringChar ------------------------------------------------------------------------ -- $parser diff --git a/src/Text/ParserCombinators/Poly/ByteString.hs b/src/Text/ParserCombinators/Poly/ByteString.hs --- a/src/Text/ParserCombinators/Poly/ByteString.hs +++ b/src/Text/ParserCombinators/Poly/ByteString.hs @@ -20,9 +20,10 @@ import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result -import qualified Data.ByteString.Lazy.Char8 as BS -import Data.ByteString.Lazy.Char8 (ByteString) +import qualified Data.ByteString.Lazy as BS +import Data.ByteString.Lazy (ByteString) import Control.Applicative +import Data.Word -- | This @Parser@ datatype is a specialised parsing monad with error -- reporting. Whereas the standard version can be used for arbitrary @@ -83,7 +84,7 @@ ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. -next :: Parser Char +next :: Parser Word8 next = P (\bs-> case BS.uncons bs of Nothing -> Failure bs "Ran out of input (EOF)" Just (h, t) -> Success t h ) @@ -95,7 +96,7 @@ else Failure bs "Expected end of input (EOF)" ) -- | Return the next token if it satisfies the given predicate. -satisfy :: (Char -> Bool) -> Parser Char +satisfy :: (Word8 -> Bool) -> Parser Word8 satisfy f = do { x <- next ; if f x then return x else fail "Parse.satisfy: failed" } @@ -115,11 +116,11 @@ ------------------------------------------------------------------------ -- | @manySatisfy p@ is a more efficient fused version of @many (satisfy p)@ -manySatisfy :: (Char->Bool) -> Parser ByteString +manySatisfy :: (Word8->Bool) -> Parser ByteString manySatisfy f = P (\bs-> let (pre,suf) = BS.span f bs in Success suf pre) -- | @many1Satisfy p@ is a more efficient fused version of @many1 (satisfy p)@ -many1Satisfy :: (Char->Bool) -> Parser ByteString +many1Satisfy :: (Word8->Bool) -> Parser ByteString many1Satisfy f = do x <- manySatisfy f if BS.null x then fail "Parse.many1Satisfy: failed" else return x diff --git a/src/Text/ParserCombinators/Poly/ByteStringChar.hs b/src/Text/ParserCombinators/Poly/ByteStringChar.hs new file mode 100644 --- /dev/null +++ b/src/Text/ParserCombinators/Poly/ByteStringChar.hs @@ -0,0 +1,137 @@ +module Text.ParserCombinators.Poly.ByteStringChar + ( -- * The Parser datatype + Parser(P) + , Result(..) + , runParser + -- ** Basic parsers + , next + , eof + , satisfy + , onFail + -- ** Derived parsers (but implemented more efficiently) + , manySatisfy + , many1Satisfy + -- ** Re-parsing + , reparse + -- * Re-export all more general combinators + , module Text.ParserCombinators.Poly.Base + ) where + + +import Text.ParserCombinators.Poly.Base +import Text.ParserCombinators.Poly.Result +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.ByteString.Lazy.Char8 (ByteString) +import Control.Applicative + +-- | This @Parser@ datatype is a specialised parsing monad with error +-- reporting. Whereas the standard version can be used for arbitrary +-- token types, this version is specialised to ByteString input only. +newtype Parser a = P (ByteString -> Result ByteString a) + +-- | Apply a parser to an input token sequence. +runParser :: Parser a -> ByteString -> (Either String a, ByteString) +runParser (P p) = resultToEither . p + +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 Commitment 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 + + 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 + +instance Applicative Parser where + pure f = return f + pf <*> px = do { f <- pf; x <- px; return (f x) } +#if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 + p <* q = p `discard` q +#endif + +instance Alternative Parser where + empty = fail "no parse" + p <|> q = p `onFail` q + +instance PolyParse Parser + +------------------------------------------------------------------------ + +-- | Simply return the next token in the input tokenstream. +next :: Parser Char +next = P (\bs-> case BS.uncons bs of + Nothing -> Failure bs "Ran out of input (EOF)" + Just (h, t) -> Success t h ) + +-- | Succeed if the end of file/input has been reached, fail otherwise. +eof :: Parser () +eof = P (\bs -> if BS.null bs + then Success bs () + else Failure bs "Expected end of input (EOF)" ) + +-- | Return the next token if it satisfies the given predicate. +satisfy :: (Char -> Bool) -> Parser Char +satisfy f = do { x <- next + ; if f x then return x else fail "Parse.satisfy: failed" + } + +-- | @p `onFail` q@ means parse p, unless p fails, in which case +-- parse q instead. +-- Can be chained together to give multiple attempts to parse something. +-- (Note that q could itself be a failing parser, e.g. to change the error +-- message from that defined in p to something different.) +-- However, a severe failure in p cannot be ignored. +onFail :: Parser a -> Parser a -> Parser a +(P p) `onFail` (P q) = P (\ts-> continue ts $ p ts) + where continue ts (Failure _ _) = q ts + -- continue _ (Committed r) = r -- no, remain Committed + continue _ r = r + +------------------------------------------------------------------------ + +-- | @manySatisfy p@ is a more efficient fused version of @many (satisfy p)@ +manySatisfy :: (Char->Bool) -> Parser ByteString +manySatisfy f = P (\bs-> let (pre,suf) = BS.span f bs in Success suf pre) + +-- | @many1Satisfy p@ is a more efficient fused version of @many1 (satisfy p)@ +many1Satisfy :: (Char->Bool) -> Parser ByteString +many1Satisfy f = do x <- manySatisfy f + if BS.null x then fail "Parse.many1Satisfy: failed" + else return x + +------------------------------------------------------------------------ + +-- | Push some tokens back onto the front of the input stream and reparse. +-- This is useful e.g. for recursively expanding macros. When the +-- user-parser recognises a macro use, it can lookup the macro +-- expansion from the parse state, lex it, and then stuff the +-- lexed expansion back down into the parser. +reparse :: ByteString -> Parser () +reparse ts = P (\inp-> Success (ts `BS.append` inp) ()) + +------------------------------------------------------------------------