module Parser (Parser, ParseResult, ParseError(..), runParser, errorParser, andThen, exactly, isMatch, check, except, anyOf, allOf, char, withTransform) where import Control.Applicative (liftA2) import Control.Monad (join) import Data.Either (fromRight) import Data.List (find) import Data.Maybe (isJust) type Input = String 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 -> Input (Int -> ParseError -> ShowS) -> (ParseError -> Input) -> ([ParseError] -> ShowS) -> Show ParseError forall a. (Int -> a -> ShowS) -> (a -> Input) -> ([a] -> ShowS) -> Show a showList :: [ParseError] -> ShowS $cshowList :: [ParseError] -> ShowS show :: ParseError -> Input $cshow :: ParseError -> Input showsPrec :: Int -> ParseError -> ShowS $cshowsPrec :: Int -> ParseError -> ShowS Show) instance Show a => Show (ParseResult a) where show :: ParseResult a -> Input show (Result Input i a a) = Input "Pending: " Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input " >" Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input i Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input "< " Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input "\n\nResult: \n" Input -> ShowS forall a. [a] -> [a] -> [a] ++ a -> Input forall a. Show a => a -> Input show a a show (Error ParseError UnexpectedEof) = Input "Unexpected end of stream" show (Error (ExpectedEof Input i)) = Input "Expected end of stream, but got >" Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input i Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input "<" show (Error (UnexpectedChar Char c)) = Input "Unexpected char: " Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input "[" Input -> ShowS forall a. [a] -> [a] -> [a] ++ Char -> Input forall a. Show a => a -> Input show Char c Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input "]" show (Error (UnexpectedString Input s)) = Input "Unexpected string: " Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input "[" Input -> ShowS forall a. [a] -> [a] -> [a] ++ ShowS forall a. Show a => a -> Input show Input s Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input "]" show (Error (NoMatch Input s)) = Input "Did not match condition: " Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input 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 parseIt where parseIt :: Input -> ParseResult Char parseIt [] = ParseError -> ParseResult Char forall a. ParseError -> ParseResult a Error ParseError UnexpectedEof parseIt (Char ch : Input rest) = Input -> Char -> ParseResult Char forall a. Input -> a -> ParseResult a Result Input rest Char ch andThen :: Parser Input -> Parser a -> Parser a andThen :: Parser Input -> Parser a -> Parser a andThen Parser Input 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 $ Parser Input -> Input -> Either ParseError Input forall a. Parser a -> Input -> Either ParseError a runParser Parser Input 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 "" a _) -> 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 $ Input -> ParseError NoMatch Input "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 $ Input -> ParseError NoMatch Input "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 :: Input -> (a -> Bool) -> Parser a -> Parser a check Input 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 $ Input -> ParseError NoMatch Input 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 $ Input -> ParseError UnexpectedString (a -> Input forall a. Show a => a -> Input show a a) Error ParseError _ -> Input -> ParseResult a p Input x) 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]