bookhound 0.1.4.0 → 0.1.5.0
raw patch · 2 files changed
+45/−34 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- bookhound.cabal +1/−1
- src/Parser.hs +44/−33
bookhound.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: bookhound-version: 0.1.4.0+version: 0.1.5.0 synopsis: Simple Parser Combinators & Parsers description: Please see the README on GitHub at <https://github.com/albertprz/bookhound#readme> category: Parsers
src/Parser.hs view
@@ -1,13 +1,16 @@ module Parser (Parser, ParseResult(..), ParseError(..), runParser, errorParser, andThen, exactly, isMatch, check, except, anyOf, allOf, char,- withTransform) where+ withTransform) where +import Control.Monad (join)+import Data.Maybe (isJust) import Data.Either (fromRight)+import Data.List (find) type Input = String data Parser a = P { parse :: Input -> ParseResult a- , transform :: forall b. Parser b -> Parser b+ , transform :: forall b. Maybe (Parser b -> Parser b) } data ParseResult a = Result Input a | Error ParseError@@ -23,35 +26,38 @@ show (Result i a) = "Pending: " ++ " >" ++ i ++ "< " ++ "\n\nResult: \n" ++ show a show (Error UnexpectedEof) = "Unexpected end of stream"- show (Error (ExpectedEof i)) = "Expected end of stream, but got >" ++ show i ++ "<"- show (Error (UnexpectedChar c)) = "Unexpected character: " ++ show c- show (Error (UnexpectedString s)) = "Unexpected string: " ++ show s+ show (Error (ExpectedEof i)) = "Expected end of stream, but got >" ++ i ++ "<"+ show (Error (UnexpectedChar c)) = "Unexpected char: " ++ "[" ++ show c ++ "]"+ show (Error (UnexpectedString s)) = "Unexpected string: " ++ "[" ++ show s ++ "]" show (Error (NoMatch s)) = "Did not match condition: " ++ s instance Functor ParseResult where fmap f (Result i a) = Result i (f a)- fmap _ (Error pe) = Error pe-+ fmap _ (Error pe) = Error pe instance Functor Parser where fmap f (P p t) = P (fmap f . p) t instance Applicative Parser where- pure a = P (`Result` a) id+ pure a = mkParser (`Result` a) (<*>) mf ma = mf >>= (<$> ma) instance Monad Parser where- (>>=) (P p t) f = t $ P (- \x -> case p x of- Result i a -> (parse) (f a) i- Error pe -> Error pe)- t+ (>>=) (P p t) f = applyTransform transf combinedParser+ where+ combinedParser = mkParser (+ \x -> case p x of+ Result i a -> (parse) (f a) i+ Error pe -> Error pe) -withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a-withTransform f p = p{transform = f}+ transf :: Maybe (Parser a -> Parser a)+ transf = findJust t (transform $ f undefined) +withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a+withTransform f p = f $ p{transform = Just f}+ runParser :: Parser a -> Input -> Either ParseError a runParser p i = toEither $ (parse) (exactly p) i where @@ -71,11 +77,11 @@ andThen :: Parser Input -> Parser a -> Parser a-andThen p1 p2@(P _ t) = t $ P (\i -> (parse) p2 $ fromRight i $ runParser p1 i) t+andThen p1 p2@(P _ t) = applyTransform t $ P (\i -> (parse) p2 $ fromRight i $ runParser p1 i) t exactly :: Parser a -> Parser a-exactly (P p t) = t $ P (+exactly (P p t) = applyTransform t $ P ( \x -> case p x of result@(Result "" _) -> result Result i _ -> Error $ ExpectedEof i@@ -85,7 +91,7 @@ anyOf :: [Parser a] -> Parser a anyOf [] = errorParser UnexpectedEof anyOf [x] = x-anyOf ((P p t) : rest) = t $ P (+anyOf ((P p t) : rest) = applyTransform t $ P ( \x -> case p x of result@(Result _ _) -> result Error _ -> (parse) (anyOf rest) x) t@@ -94,36 +100,41 @@ allOf :: [Parser a] -> Parser a allOf [] = errorParser UnexpectedEof allOf [x] = x-allOf ((P p t) : rest) = t $ P (+allOf ((P p t) : rest) = applyTransform t $ P ( \x -> case p x of Result i _ -> (parse) (allOf rest) i err@(Error _) -> err) t isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char-isMatch cond parser c1 = do- c2 <- parser- let next = if cond c1 c2- then pure- else const . errorParser $ UnexpectedChar c2- next c2+isMatch cond parser c1 =+ do c2 <- parser+ if cond c1 c2+ then pure c2+ else errorParser $ UnexpectedChar c2 check :: String -> (a -> Bool) -> Parser a -> Parser a-check condName cond parser = do- c2 <- parser- let next = if cond c2- then pure- else const . errorParser $ NoMatch condName- next c2+check condName cond parser =+ do c2 <- parser+ if cond c2+ then pure c2+ else errorParser $ NoMatch condName except :: Show a => Parser a -> Parser a -> Parser a-except alt (P p t) = t $ P (+except alt (P p t) = applyTransform t $ P ( \x -> case p x of Result _ a -> Error $ UnexpectedString (show a) Error _ -> (parse) alt x) t + mkParser :: (Input -> ParseResult a) -> Parser a-mkParser p = P {parse = p, transform = id}+mkParser p = P {parse = p, transform = Nothing}++applyTransform :: (forall a. Maybe (Parser a -> Parser a)) -> Parser b -> Parser b+applyTransform f p = maybe id id f $ p++findJust :: forall a. Maybe a -> Maybe a -> Maybe a+findJust ma mb = join $ find isJust [ma, mb]