module Bookhound.Parser (Parser, ParseResult, ParseError(..), runParser, errorParser, andThen, exactly, isMatch, check, except, anyOf, allOf, char, withTransform, withError) where import Control.Applicative (liftA2) import Control.Monad (join) import Data.Either (fromRight) import Data.List (find) import Data.Maybe (isJust) import Data.Text (Text, pack, uncons, unpack) type Input = Text data Parser a = P { Parser a -> Input -> ParseResult a parse :: Input -> ParseResult a , Parser a -> forall b. Maybe (Parser b -> Parser b) transform :: forall b. Maybe (Parser b -> Parser b) } data ParseResult a = Result Input a | Error ParseError deriving (ParseResult a -> ParseResult a -> Bool (ParseResult a -> ParseResult a -> Bool) -> (ParseResult a -> ParseResult a -> Bool) -> Eq (ParseResult a) 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 deriving (ParseError -> ParseError -> Bool (ParseError -> ParseError -> Bool) -> (ParseError -> ParseError -> Bool) -> Eq ParseError 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 (Int -> ParseError -> ShowS) -> (ParseError -> String) -> ([ParseError] -> ShowS) -> Show ParseError 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: " String -> ShowS forall a. Semigroup a => a -> a -> a <> String " >" String -> ShowS forall a. Semigroup a => a -> a -> a <> Input -> String unpack Input i String -> ShowS forall a. Semigroup a => a -> a -> a <> String "< " String -> ShowS forall a. Semigroup a => a -> a -> a <> String "\n\nResult: \n" String -> ShowS forall a. Semigroup a => a -> a -> a <> a -> String 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 >" String -> ShowS forall a. Semigroup a => a -> a -> a <> Input -> String unpack Input i String -> ShowS forall a. Semigroup a => a -> a -> a <> String "<" show (Error (UnexpectedChar Char c)) = String "Unexpected char: " String -> ShowS forall a. Semigroup a => a -> a -> a <> String "[" String -> ShowS forall a. Semigroup a => a -> a -> a <> Char -> String forall a. Show a => a -> String show Char c String -> ShowS forall a. Semigroup a => a -> a -> a <> String "]" show (Error (UnexpectedString String s)) = String "Unexpected string: " String -> ShowS forall a. Semigroup a => a -> a -> a <> String "[" String -> ShowS forall a. Semigroup a => a -> a -> a <> ShowS forall a. Show a => a -> String show String s String -> ShowS forall a. Semigroup a => a -> a -> a <> String "]" show (Error (NoMatch String s)) = String "Did not match condition: " String -> ShowS forall a. Semigroup a => a -> a -> a <> String s instance Functor ParseResult where fmap :: (a -> b) -> ParseResult a -> ParseResult b fmap a -> b f (Result Input i a a) = Input -> b -> ParseResult b forall a. Input -> a -> ParseResult a Result Input i (a -> b f a a) fmap a -> b _ (Error ParseError pe) = ParseError -> ParseResult b forall a. ParseError -> ParseResult a Error ParseError pe instance Functor Parser where fmap :: (a -> b) -> Parser a -> Parser b fmap a -> b f (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t) = (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform forall b. Maybe (Parser b -> Parser b) t (Parser b -> Parser b) -> Parser b -> Parser b forall a b. (a -> b) -> a -> b $ (Input -> ParseResult b) -> Parser b forall a. (Input -> ParseResult a) -> Parser a mkParser ((a -> b) -> ParseResult a -> ParseResult b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f (ParseResult a -> ParseResult b) -> (Input -> ParseResult a) -> Input -> ParseResult b forall b c a. (b -> c) -> (a -> b) -> a -> c . Input -> ParseResult a p) instance Applicative Parser where pure :: a -> Parser a pure a a = (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a mkParser (Input -> a -> ParseResult a forall a. Input -> a -> ParseResult a `Result` a a) (liftA2 :: (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) mb :: Parser b mb@(P Input -> ParseResult b _ forall b. Maybe (Parser b -> Parser b) t') = (forall b. Maybe (Parser b -> Parser b)) -> Parser c -> Parser c forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform (Maybe (Parser a -> Parser a) -> Maybe (Parser a -> Parser a) -> Maybe (Parser a -> Parser a) forall a. Maybe a -> Maybe a -> Maybe a findJust Maybe (Parser a -> Parser a) forall b. Maybe (Parser b -> Parser b) t Maybe (Parser a -> Parser a) forall b. Maybe (Parser b -> Parser b) t') Parser c combinedParser where combinedParser :: Parser c combinedParser = (Input -> ParseResult c) -> Parser c forall a. (Input -> ParseResult a) -> Parser a mkParser ( \Input x -> case Input -> ParseResult a p Input x of Result Input i a a -> Parser c -> Input -> ParseResult c forall a. Parser a -> Input -> ParseResult a parse ((a -> b -> c f a a) (b -> c) -> Parser b -> Parser c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser b mb) Input i Error ParseError pe -> ParseError -> ParseResult c forall a. ParseError -> ParseResult a Error ParseError pe) instance Monad Parser where >>= :: Parser a -> (a -> Parser b) -> Parser b (>>=) (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t) a -> Parser b f = (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform forall b. Maybe (Parser b -> Parser b) t Parser b combinedParser where combinedParser :: Parser b combinedParser = (Input -> ParseResult b) -> Parser b forall a. (Input -> ParseResult a) -> Parser a mkParser ( \Input x -> case Input -> ParseResult a p Input x of Result Input i a a -> Parser b -> Input -> ParseResult b forall a. Parser a -> Input -> ParseResult a parse (a -> Parser b f a a) Input i Error ParseError pe -> ParseError -> ParseResult b forall a. ParseError -> ParseResult a Error ParseError pe) runParser :: Parser a -> Input -> Either ParseError a runParser :: Parser a -> Input -> Either ParseError a runParser Parser a p Input i = ParseResult a -> Either ParseError a forall b. ParseResult b -> Either ParseError b toEither (ParseResult a -> Either ParseError a) -> ParseResult a -> Either ParseError a forall a b. (a -> b) -> a -> b $ Parser a -> Input -> ParseResult a forall a. Parser a -> Input -> ParseResult a parse (Parser a -> Parser a forall a. Parser a -> Parser a exactly Parser a p) Input i where toEither :: ParseResult b -> Either ParseError b toEither = \case Error ParseError pe -> ParseError -> Either ParseError b forall a b. a -> Either a b Left ParseError pe Result Input _ b a -> b -> Either ParseError b forall a b. b -> Either a b Right b a errorParser :: ParseError -> Parser a errorParser :: ParseError -> Parser a errorParser = (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a mkParser ((Input -> ParseResult a) -> Parser a) -> (ParseError -> Input -> ParseResult a) -> ParseError -> Parser a forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseResult a -> Input -> ParseResult a forall a b. a -> b -> a const (ParseResult a -> Input -> ParseResult a) -> (ParseError -> ParseResult a) -> ParseError -> Input -> ParseResult a forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseError -> ParseResult a forall a. ParseError -> ParseResult a Error char :: Parser Char char :: Parser Char char = (Input -> ParseResult Char) -> Parser Char forall a. (Input -> ParseResult a) -> Parser a mkParser ((Input -> ParseResult Char) -> Parser Char) -> (Input -> ParseResult Char) -> Parser Char forall a b. (a -> b) -> a -> b $ ParseResult Char -> ((Char, Input) -> ParseResult Char) -> Maybe (Char, Input) -> ParseResult Char forall b a. b -> (a -> b) -> Maybe a -> b maybe (ParseError -> ParseResult Char forall a. ParseError -> ParseResult a Error ParseError UnexpectedEof) (\(Char ch, Input rest) -> Input -> Char -> ParseResult Char forall a. Input -> a -> ParseResult a Result Input rest Char ch) (Maybe (Char, Input) -> ParseResult Char) -> (Input -> Maybe (Char, Input)) -> Input -> ParseResult Char forall b c a. (b -> c) -> (a -> b) -> a -> c . Input -> Maybe (Char, Input) uncons andThen :: Parser String -> Parser a -> Parser a andThen :: 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) = (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform forall b. Maybe (Parser b -> Parser b) t (Parser a -> Parser a) -> Parser a -> Parser a forall a b. (a -> b) -> a -> b $ (Input -> ParseResult a) -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a forall a. (Input -> ParseResult a) -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a P (\Input i -> Parser a -> Input -> ParseResult a forall a. Parser a -> Input -> ParseResult a parse Parser a p2 (Input -> ParseResult a) -> Input -> ParseResult a forall a b. (a -> b) -> a -> b $ Input -> Either ParseError Input -> Input forall b a. b -> Either a b -> b fromRight Input i (Either ParseError Input -> Input) -> Either ParseError Input -> Input forall a b. (a -> b) -> a -> b $ String -> Input pack (String -> Input) -> Either ParseError String -> Either ParseError Input forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser String -> Input -> Either ParseError String forall a. Parser a -> Input -> Either ParseError a runParser Parser String p1 Input i) forall b. Maybe (Parser b -> Parser b) t exactly :: Parser a -> Parser a exactly :: Parser a -> Parser a exactly (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t) = (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform forall b. Maybe (Parser b -> Parser b) t (Parser a -> Parser a) -> Parser a -> Parser a forall a b. (a -> b) -> a -> b $ (Input -> ParseResult a) -> Parser a 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 Input -> Input -> Bool forall a. Eq a => a -> a -> Bool == Input forall a. Monoid a => a mempty -> ParseResult a result Result Input i a _ -> ParseError -> ParseResult a forall a. ParseError -> ParseResult a Error (ParseError -> ParseResult a) -> ParseError -> ParseResult a 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 :: [Parser a] -> Parser a anyOf [Parser a] ps = [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a anyOfHelper [Parser a] ps forall a. Maybe a forall b. Maybe (Parser b -> Parser b) Nothing allOf :: [Parser a] -> Parser a allOf :: [Parser a] -> Parser a allOf [Parser a] ps = [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a allOfHelper [Parser a] ps forall a. Maybe a forall b. Maybe (Parser b -> Parser b) Nothing anyOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a anyOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a anyOfHelper [] forall b. Maybe (Parser b -> Parser b) _ = ParseError -> Parser a forall a. ParseError -> Parser a errorParser (ParseError -> Parser a) -> ParseError -> Parser a forall a b. (a -> b) -> a -> b $ String -> ParseError NoMatch String "anyOf" anyOfHelper [Parser a p] forall b. Maybe (Parser b -> Parser b) _ = Parser a p anyOfHelper ((P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t) : [Parser a] rest) forall b. Maybe (Parser b -> Parser b) t' = (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform (Maybe (Parser a -> Parser a) -> Maybe (Parser a -> Parser a) -> Maybe (Parser a -> Parser a) forall a. Maybe a -> Maybe a -> Maybe a findJust Maybe (Parser a -> Parser a) forall b. Maybe (Parser b -> Parser b) t Maybe (Parser a -> Parser a) forall b. Maybe (Parser b -> Parser b) t') (Parser a -> Parser a) -> Parser a -> Parser a forall a b. (a -> b) -> a -> b $ (Input -> ParseResult a) -> Parser a 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 _ -> Parser a -> Input -> ParseResult a forall a. Parser a -> Input -> ParseResult a parse ([Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a anyOfHelper [Parser a] rest forall b. Maybe (Parser b -> Parser b) t) Input x) allOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a allOfHelper :: [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a allOfHelper [] forall b. Maybe (Parser b -> Parser b) _ = ParseError -> Parser a forall a. ParseError -> Parser a errorParser (ParseError -> Parser a) -> ParseError -> Parser a forall a b. (a -> b) -> a -> b $ String -> ParseError NoMatch String "allOf" allOfHelper [Parser a p] forall b. Maybe (Parser b -> Parser b) _ = Parser a p allOfHelper ((P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t) : [Parser a] rest) forall b. Maybe (Parser b -> Parser b) t' = (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform (Maybe (Parser a -> Parser a) -> Maybe (Parser a -> Parser a) -> Maybe (Parser a -> Parser a) forall a. Maybe a -> Maybe a -> Maybe a findJust Maybe (Parser a -> Parser a) forall b. Maybe (Parser b -> Parser b) t Maybe (Parser a -> Parser a) forall b. Maybe (Parser b -> Parser b) t') (Parser a -> Parser a) -> Parser a -> Parser a forall a b. (a -> b) -> a -> b $ (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a mkParser ( \Input x -> case Input -> ParseResult a p Input x of Result Input _ a _ -> Parser a -> Input -> ParseResult a forall a. Parser a -> Input -> ParseResult a parse ([Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a forall a. [Parser a] -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a allOfHelper [Parser a] rest forall b. Maybe (Parser b -> Parser b) t) 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 Char -> Parser Char forall (f :: * -> *) a. Applicative f => a -> f a pure Char c2 else ParseError -> Parser Char forall a. ParseError -> Parser a errorParser (ParseError -> Parser Char) -> ParseError -> Parser Char forall a b. (a -> b) -> a -> b $ Char -> ParseError UnexpectedChar Char c2 check :: String -> (a -> Bool) -> Parser a -> Parser a check :: 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 a -> Parser a forall (f :: * -> *) a. Applicative f => a -> f a pure a c2 else ParseError -> Parser a forall a. ParseError -> Parser a errorParser (ParseError -> Parser a) -> ParseError -> Parser a forall a b. (a -> b) -> a -> b $ String -> ParseError NoMatch String condName except :: Show a => Parser a -> Parser a -> Parser a except :: Parser a -> Parser a -> Parser a except (P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) t) (P Input -> ParseResult a p' forall b. Maybe (Parser b -> Parser b) _) = (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform forall b. Maybe (Parser b -> Parser b) t (Parser a -> Parser a) -> Parser a -> Parser a forall a b. (a -> b) -> a -> b $ (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a mkParser ( \Input x -> case Input -> ParseResult a p' Input x of Result Input _ a a -> ParseError -> ParseResult a forall a. ParseError -> ParseResult a Error (ParseError -> ParseResult a) -> ParseError -> ParseResult a forall a b. (a -> b) -> a -> b $ String -> ParseError UnexpectedString (a -> String forall a. Show a => a -> String show a a) Error ParseError _ -> Input -> ParseResult a p Input x) withError :: String -> Parser a -> Parser a withError :: String -> Parser a -> Parser a withError String str parser :: Parser a parser@(P Input -> ParseResult a p forall b. Maybe (Parser b -> Parser b) _) = Parser a parser { $sel:parse:P :: Input -> ParseResult a parse = \Input i -> case Input -> ParseResult a p Input i of r :: ParseResult a r@(Result Input _ a _) -> ParseResult a r Error ParseError _ -> ParseError -> ParseResult a forall a. ParseError -> ParseResult a Error (ParseError -> ParseResult a) -> ParseError -> ParseResult a forall a b. (a -> b) -> a -> b $ String -> ParseError NoMatch String str } withTransform :: (forall b. Parser b -> Parser b) -> Parser a -> Parser a withTransform :: (forall a. Parser a -> Parser a) -> Parser a -> Parser a withTransform forall a. Parser a -> Parser a f = (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a forall b. (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform ((forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a) -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a -> Parser a forall a b. (a -> b) -> a -> b $ (Parser a -> Parser a) -> Maybe (Parser a -> Parser a) forall a. a -> Maybe a Just Parser a -> Parser a forall a. Parser a -> Parser a f applyTransform :: (forall a. Maybe (Parser a -> Parser a)) -> Parser b -> Parser b applyTransform :: (forall b. Maybe (Parser b -> Parser b)) -> Parser b -> Parser b applyTransform forall b. Maybe (Parser b -> Parser b) f Parser b p = Parser b -> ((Parser b -> Parser b) -> Parser b) -> Maybe (Parser b -> Parser b) -> Parser b forall b a. b -> (a -> b) -> Maybe a -> b maybe Parser b p (\Parser b -> Parser b f' -> (Parser b -> Parser b f' Parser b p){$sel:transform:P :: forall b. Maybe (Parser b -> Parser b) transform = forall b. Maybe (Parser b -> Parser b) f} ) Maybe (Parser b -> Parser b) forall b. Maybe (Parser b -> Parser b) f mkParser :: (Input -> ParseResult a) -> Parser a mkParser :: (Input -> ParseResult a) -> Parser a mkParser Input -> ParseResult a p = P :: forall a. (Input -> ParseResult a) -> (forall b. Maybe (Parser b -> Parser b)) -> Parser a 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 forall b. Maybe (Parser b -> Parser b) Nothing} findJust :: forall a. Maybe a -> Maybe a -> Maybe a findJust :: Maybe a -> Maybe a -> Maybe a findJust Maybe a ma Maybe a mb = Maybe (Maybe a) -> Maybe a forall (m :: * -> *) a. Monad m => m (m a) -> m a join (Maybe (Maybe a) -> Maybe a) -> Maybe (Maybe a) -> Maybe a forall a b. (a -> b) -> a -> b $ (Maybe a -> Bool) -> [Maybe a] -> Maybe (Maybe a) forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find Maybe a -> Bool forall a. Maybe a -> Bool isJust ([Maybe a ma, Maybe a mb] :: [Maybe a])