module Bookhound.Parser (Parser, ParseResult, ParseError(..), runParser, errorParser, andThen, exactly, isMatch, check, anyOf, allOf, char, withTransform, withError, except) where import Bookhound.Utils.Foldable (findJust) import Control.Applicative (liftA2) import Data.Either (fromRight) import Data.Maybe (fromMaybe) import Data.Text (Text, pack, uncons, unpack) type Input = Text data Parser a = P { forall a. Parser a -> Input -> ParseResult a parse :: Input -> ParseResult a , forall a. Parser a -> forall b. Maybe (Parser b -> Parser b) transform :: forall b. Maybe (Parser b -> Parser b) , forall a. Parser a -> Maybe ParseError error :: Maybe ParseError } data ParseResult a = Result Input a | Error ParseError deriving (ParseResult a -> ParseResult a -> Bool forall a. Eq a => ParseResult a -> ParseResult a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ParseResult a -> ParseResult a -> Bool $c/= :: forall a. Eq a => ParseResult a -> ParseResult a -> Bool == :: ParseResult a -> ParseResult a -> Bool $c== :: forall a. Eq a => ParseResult a -> ParseResult a -> Bool Eq) data ParseError = UnexpectedEof | ExpectedEof Input | UnexpectedChar Char | UnexpectedString String | NoMatch String | ErrorAt String deriving (ParseError -> ParseError -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ParseError -> ParseError -> Bool $c/= :: ParseError -> ParseError -> Bool == :: ParseError -> ParseError -> Bool $c== :: ParseError -> ParseError -> Bool Eq, Int -> ParseError -> ShowS [ParseError] -> ShowS ParseError -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ParseError] -> ShowS $cshowList :: [ParseError] -> ShowS show :: ParseError -> String $cshow :: ParseError -> String showsPrec :: Int -> ParseError -> ShowS $cshowsPrec :: Int -> ParseError -> ShowS Show) instance Show a => Show (ParseResult a) where show :: ParseResult a -> String show (Result Input i a a) = String "Pending: " forall a. Semigroup a => a -> a -> a <> String " >" forall a. Semigroup a => a -> a -> a <> Input -> String unpack Input i forall a. Semigroup a => a -> a -> a <> String "< " forall a. Semigroup a => a -> a -> a <> String "\n\nResult: \n" forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show a a show (Error ParseError UnexpectedEof) = String "Unexpected end of stream" show (Error (ExpectedEof Input i)) = String "Expected end of stream, but got >" forall a. Semigroup a => a -> a -> a <> Input -> String unpack Input i forall a. Semigroup a => a -> a -> a <> String "<" show (Error (UnexpectedChar Char c)) = String "Unexpected char: " forall a. Semigroup a => a -> a -> a <> String "[" forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Char c forall a. Semigroup a => a -> a -> a <> String "]" show (Error (UnexpectedString String s)) = String "Unexpected string: " forall a. Semigroup a => a -> a -> a <> String "[" forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show String s forall a. Semigroup a => a -> a -> a <> String "]" show (Error (NoMatch String s)) = String "Did not match condition: " forall a. Semigroup a => a -> a -> a <> String s show (Error (ErrorAt String s)) = String "Error at " forall a. Semigroup a => a -> a -> a <> String s instance Functor ParseResult where fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b fmap a -> b f (Result Input i a a) = forall a. Input -> a -> ParseResult a Result Input i (a -> b f a a) fmap a -> b _ (Error ParseError pe) = forall a. ParseError -> ParseResult a Error ParseError pe instance Functor Parser where fmap :: forall a b. (a -> b) -> Parser a -> Parser b fmap a -> b f (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) = forall a. (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a -> Parser a applyTransformError forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e forall a b. (a -> b) -> a -> b $ forall a. (Input -> ParseResult a) -> Parser a mkParser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f forall b c a. (b -> c) -> (a -> b) -> a -> c . Input -> ParseResult a p) instance Applicative Parser where pure :: forall a. a -> Parser a pure a a = forall a. (Input -> ParseResult a) -> Parser a mkParser (forall a. Input -> a -> ParseResult a `Result` a a) liftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c liftA2 a -> b -> c f (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) mb :: Parser b mb@(P Input -> ParseResult b _ forall b. Maybe (Parser b -> Parser b) t' Maybe ParseError e') = forall a. (forall b. [Maybe (Parser b -> Parser b)]) -> [Maybe ParseError] -> Parser a -> Parser a applyTransformsErrors [forall b. Maybe (Parser b -> Parser b) t, forall b. Maybe (Parser b -> Parser b) t'] [Maybe ParseError e, Maybe ParseError e'] Parser c combinedParser where combinedParser :: Parser c combinedParser = forall a. (Input -> ParseResult a) -> Parser a mkParser \Input x -> case Input -> ParseResult a p Input x of Result Input i a a -> forall a. Parser a -> Input -> ParseResult a parse ((a -> b -> c f a a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser b mb) Input i Error ParseError pe -> forall a. ParseError -> ParseResult a Error ParseError pe instance Monad Parser where >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b (>>=) (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) a -> Parser b f = forall a. (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a -> Parser a applyTransformError forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e Parser b combinedParser where combinedParser :: Parser b combinedParser = forall a. (Input -> ParseResult a) -> Parser a mkParser \Input x -> case Input -> ParseResult a p Input x of Result Input i a a -> forall a. Parser a -> Input -> ParseResult a parse (a -> Parser b f a a) Input i Error ParseError pe -> forall a. ParseError -> ParseResult a Error ParseError pe runParser :: Parser a -> Input -> Either ParseError a runParser :: forall a. Parser a -> Input -> Either ParseError a runParser p :: Parser a p@(P Input -> ParseResult a _ forall b. Maybe (Parser b -> Parser b) _ Maybe ParseError err) Input i = ParseResult a -> Either ParseError a toEither forall a b. (a -> b) -> a -> b $ forall a. Parser a -> Input -> ParseResult a parse (forall a. Parser a -> Parser a exactly Parser a p) Input i where toEither :: ParseResult a -> Either ParseError a toEither = \case Error ParseError pe -> forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a -> a fromMaybe ParseError pe Maybe ParseError err Result Input _ a a -> forall a b. b -> Either a b Right a a errorParser :: ParseError -> Parser a errorParser :: forall a. ParseError -> Parser a errorParser = forall a. (Input -> ParseResult a) -> Parser a mkParser forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. a -> b -> a const forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. ParseError -> ParseResult a Error andThen :: Parser String -> Parser a -> Parser a andThen :: forall a. Parser String -> Parser a -> Parser a andThen Parser String p1 p2 :: Parser a p2@(P Input -> ParseResult a _ forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) = forall a. (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a -> Parser a applyTransformError forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e forall a b. (a -> b) -> a -> b $ forall a. (Input -> ParseResult a) -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a P (\Input i -> forall a. Parser a -> Input -> ParseResult a parse Parser a p2 forall a b. (a -> b) -> a -> b $ forall b a. b -> Either a b -> b fromRight Input i forall a b. (a -> b) -> a -> b $ String -> Input pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Parser a -> Input -> Either ParseError a runParser Parser String p1 Input i) forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e char :: Parser Char char :: Parser Char char = forall a. (Input -> ParseResult a) -> Parser a mkParser forall a b. (a -> b) -> a -> b $ forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall a. ParseError -> ParseResult a Error ParseError UnexpectedEof) (\(Char ch, Input rest) -> forall a. Input -> a -> ParseResult a Result Input rest Char ch) forall b c a. (b -> c) -> (a -> b) -> a -> c . Input -> Maybe (Char, Input) uncons exactly :: Parser a -> Parser a exactly :: forall a. Parser a -> Parser a exactly (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) = forall a. (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a -> Parser a applyTransformError forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e forall a b. (a -> b) -> a -> b $ forall a. (Input -> ParseResult a) -> Parser a mkParser (\Input x -> case Input -> ParseResult a p Input x of result :: ParseResult a result@(Result Input i a _) | Input i forall a. Eq a => a -> a -> Bool == forall a. Monoid a => a mempty -> ParseResult a result Result Input i a _ -> forall a. ParseError -> ParseResult a Error forall a b. (a -> b) -> a -> b $ Input -> ParseError ExpectedEof Input i err :: ParseResult a err@(Error ParseError _) -> ParseResult a err ) anyOf :: [Parser a] -> Parser a anyOf :: forall a. [Parser a] -> Parser a anyOf [Parser a] ps = forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a anyOfHelper [Parser a] ps forall a. Maybe a Nothing forall a. Maybe a Nothing allOf :: [Parser a] -> Parser a allOf :: forall a. [Parser a] -> Parser a allOf [Parser a] ps = forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a allOfHelper [Parser a] ps forall a. Maybe a Nothing forall a. Maybe a Nothing anyOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a anyOfHelper :: forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a anyOfHelper [] forall b. Maybe (Parser b -> Parser b) _ Maybe ParseError _ = forall a. ParseError -> Parser a errorParser forall a b. (a -> b) -> a -> b $ String -> ParseError NoMatch String "anyOf" anyOfHelper [Parser a p] forall b. Maybe (Parser b -> Parser b) _ Maybe ParseError _ = Parser a p anyOfHelper ((P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) : [Parser a] rest) forall b. Maybe (Parser b -> Parser b) t' Maybe ParseError e' = forall a. (forall b. [Maybe (Parser b -> Parser b)]) -> [Maybe ParseError] -> Parser a -> Parser a applyTransformsErrors [forall b. Maybe (Parser b -> Parser b) t, forall b. Maybe (Parser b -> Parser b) t'] [Maybe ParseError e, Maybe ParseError e'] forall a b. (a -> b) -> a -> b $ forall a. (Input -> ParseResult a) -> Parser a mkParser (\Input x -> case Input -> ParseResult a p Input x of result :: ParseResult a result@(Result Input _ a _) -> ParseResult a result Error ParseError _ -> forall a. Parser a -> Input -> ParseResult a parse (forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a anyOfHelper [Parser a] rest forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) Input x ) allOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a allOfHelper :: forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a allOfHelper [] forall b. Maybe (Parser b -> Parser b) _ Maybe ParseError _ = forall a. ParseError -> Parser a errorParser forall a b. (a -> b) -> a -> b $ String -> ParseError NoMatch String "allOf" allOfHelper [Parser a p] forall b. Maybe (Parser b -> Parser b) _ Maybe ParseError _ = Parser a p allOfHelper ((P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) : [Parser a] rest) forall b. Maybe (Parser b -> Parser b) t' Maybe ParseError e' = forall a. (forall b. [Maybe (Parser b -> Parser b)]) -> [Maybe ParseError] -> Parser a -> Parser a applyTransformsErrors [forall b. Maybe (Parser b -> Parser b) t, forall b. Maybe (Parser b -> Parser b) t'] [Maybe ParseError e, Maybe ParseError e'] forall a b. (a -> b) -> a -> b $ forall a. (Input -> ParseResult a) -> Parser a mkParser (\Input x -> case Input -> ParseResult a p Input x of Result Input _ a _ -> forall a. Parser a -> Input -> ParseResult a parse (forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a allOfHelper [Parser a] rest forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) Input x err :: ParseResult a err@(Error ParseError _) -> ParseResult a err ) isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char isMatch :: (Char -> Char -> Bool) -> Parser Char -> Char -> Parser Char isMatch Char -> Char -> Bool cond Parser Char parser Char c1 = do Char c2 <- Parser Char parser if Char -> Char -> Bool cond Char c1 Char c2 then forall (f :: * -> *) a. Applicative f => a -> f a pure Char c2 else forall a. ParseError -> Parser a errorParser forall a b. (a -> b) -> a -> b $ Char -> ParseError UnexpectedChar Char c2 check :: String -> (a -> Bool) -> Parser a -> Parser a check :: forall a. String -> (a -> Bool) -> Parser a -> Parser a check String condName a -> Bool cond Parser a parser = do a c2 <- Parser a parser if a -> Bool cond a c2 then forall (f :: * -> *) a. Applicative f => a -> f a pure a c2 else forall a. ParseError -> Parser a errorParser forall a b. (a -> b) -> a -> b $ String -> ParseError NoMatch String condName except :: Parser a -> Parser a -> Parser a except :: forall a. Parser a -> Parser a -> Parser a except (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e) (P Input -> ParseResult a p' forall b. Maybe (Parser b -> Parser b) _ Maybe ParseError _) = forall a. (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a -> Parser a applyTransformError forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e forall a b. (a -> b) -> a -> b $ forall a. (Input -> ParseResult a) -> Parser a mkParser ( \Input x -> case Input -> ParseResult a p' Input x of Result Input _ a _ -> forall a. ParseError -> ParseResult a Error forall a b. (a -> b) -> a -> b $ String -> ParseError NoMatch String "except" Error ParseError _ -> Input -> ParseResult a p Input x ) withError :: String -> Parser a -> Parser a withError :: forall a. String -> Parser a -> Parser a withError = forall a. Maybe ParseError -> Parser a -> Parser a applyError forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ParseError ErrorAt withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a withTransform :: forall a. (forall a. Parser a -> Parser a) -> Parser a -> Parser a withTransform forall a. Parser a -> Parser a t = forall a. (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a applyTransform forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a Just forall a. Parser a -> Parser a t applyTransformError :: (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a -> Parser a applyTransformError :: forall a. (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a -> Parser a applyTransformError forall b. Maybe (Parser b -> Parser b) t Maybe ParseError e = forall a. (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a applyTransform forall b. Maybe (Parser b -> Parser b) t forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Maybe ParseError -> Parser a -> Parser a applyError Maybe ParseError e applyTransformsErrors :: (forall b. [Maybe (Parser b -> Parser b)]) -> [Maybe ParseError] -> Parser a -> Parser a applyTransformsErrors :: forall a. (forall b. [Maybe (Parser b -> Parser b)]) -> [Maybe ParseError] -> Parser a -> Parser a applyTransformsErrors forall b. [Maybe (Parser b -> Parser b)] ts [Maybe ParseError] es = forall a. (forall b. Maybe (Parser b -> Parser b)) -> Maybe ParseError -> Parser a -> Parser a applyTransformError (forall (t :: * -> *) a. Foldable t => t (Maybe a) -> Maybe a findJust forall b. [Maybe (Parser b -> Parser b)] ts) (forall (t :: * -> *) a. Foldable t => t (Maybe a) -> Maybe a findJust [Maybe ParseError] es) applyTransform :: (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a applyTransform :: forall a. (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a applyTransform forall b. Maybe (Parser b -> Parser b) f Parser a p = forall b a. b -> (a -> b) -> Maybe a -> b maybe Parser a p (\Parser a -> Parser a f' -> (Parser a -> Parser a f' Parser a p) {$sel:transform:P :: forall b. Maybe (Parser b -> Parser b) transform = forall b. Maybe (Parser b -> Parser b) f}) forall b. Maybe (Parser b -> Parser b) f applyError :: Maybe ParseError -> Parser a -> Parser a applyError :: forall a. Maybe ParseError -> Parser a -> Parser a applyError Maybe ParseError e Parser a p = forall b a. b -> (a -> b) -> Maybe a -> b maybe Parser a p (\ParseError _ -> Parser a p {$sel:error:P :: Maybe ParseError error = Maybe ParseError e}) Maybe ParseError e mkParser :: (Input -> ParseResult a) -> Parser a mkParser :: forall a. (Input -> ParseResult a) -> Parser a mkParser Input -> ParseResult a p = P {$sel:parse:P :: Input -> ParseResult a parse = Input -> ParseResult a p, $sel:transform:P :: forall b. Maybe (Parser b -> Parser b) transform = forall a. Maybe a Nothing, $sel:error:P :: Maybe ParseError error = forall a. Maybe a Nothing}