module Parser where import Data.Maybe (maybeToList) import Data.Either (fromRight) type Input = String newtype Parser a = P { Parser a -> Input -> ParseResult a parse :: Input -> ParseResult a} 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] ++ ShowS forall a. Show a => a -> Input show Input i Input -> ShowS forall a. [a] -> [a] -> [a] ++ Input "<" show (Error (UnexpectedChar Char c)) = Input "Unexpected character: " Input -> ShowS forall a. [a] -> [a] -> [a] ++ Char -> Input forall a. Show a => a -> Input show Char c show (Error (UnexpectedString Input s)) = Input "Unexpected string: " Input -> ShowS forall a. [a] -> [a] -> [a] ++ ShowS forall a. Show a => a -> Input show Input s 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 f (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) = (Input -> ParseResult b) -> Parser b forall a. (Input -> ParseResult a) -> Parser a P ((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 P (Input -> a -> ParseResult a forall a. Input -> a -> ParseResult a `Result` a a) <*> :: Parser (a -> b) -> Parser a -> Parser b (<*>) Parser (a -> b) mf Parser a ma = Parser (a -> b) mf Parser (a -> b) -> ((a -> b) -> Parser b) -> Parser b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (\a -> b f -> Parser a ma Parser a -> (a -> Parser b) -> Parser b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (b -> Parser b forall (f :: * -> *) a. Applicative f => a -> f a pure (b -> Parser b) -> (a -> b) -> a -> Parser b forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> b f)) instance Monad Parser where >>= :: Parser a -> (a -> Parser b) -> Parser b (>>=) (P Input -> ParseResult a p) a -> Parser b f = (Input -> ParseResult b) -> Parser b forall a. (Input -> ParseResult a) -> Parser a P ( \Input i -> case Input -> ParseResult a p Input i 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 a. ParseResult a -> Either ParseError a 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 p Input i toEither :: ParseResult a -> Either ParseError a toEither :: ParseResult a -> Either ParseError a toEither ParseResult a result = case ParseResult a result of Error ParseError pe -> ParseError -> Either ParseError a forall a b. a -> Either a b Left ParseError pe Result Input input a a -> if Input -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null Input input then a -> Either ParseError a forall a b. b -> Either a b Right a a else ParseError -> Either ParseError a forall a b. a -> Either a b Left (ParseError -> Either ParseError a) -> ParseError -> Either ParseError a forall a b. (a -> b) -> a -> b $ Input -> ParseError ExpectedEof Input input char :: Parser Char char :: Parser Char char = (Input -> ParseResult Char) -> Parser Char forall a. (Input -> ParseResult a) -> Parser a P Input -> ParseResult Char parseIt where parseIt :: Input -> ParseResult Char parseIt [] = ParseError -> ParseResult Char forall a. ParseError -> ParseResult a Error ParseError UnexpectedEof parseIt (Char char : Input rest) = Input -> Char -> ParseResult Char forall a. Input -> a -> ParseResult a Result Input rest Char char errorParser :: ParseError -> Parser a errorParser :: ParseError -> Parser a errorParser = (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a P ((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 andThen :: Parser Input -> Parser a -> Parser a andThen :: Parser Input -> Parser a -> Parser a andThen Parser Input p1 Parser a p2 = (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> 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) exactly :: Parser a -> Parser a exactly :: Parser a -> Parser a exactly (P Input -> ParseResult a p) = (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a P ( \Input i -> case Input -> ParseResult a p Input i of result :: ParseResult a result @ (Result Input "" a _) -> ParseResult a result result :: 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 error :: ParseResult a error @ (Error ParseError _) -> ParseResult a error) anyOf :: [Parser a] -> Parser a anyOf :: [Parser a] -> Parser a anyOf [] = ParseError -> Parser a forall a. ParseError -> Parser a errorParser ParseError UnexpectedEof anyOf [Parser a x] = Parser a x anyOf ((P Input -> ParseResult a p) : [Parser a] rest) = (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a P ( \Input i -> case Input -> ParseResult a p Input i of result :: ParseResult a result @ (Result Input _ a _) -> ParseResult a result error :: ParseResult a error @ (Error ParseError _) -> Parser a -> Input -> ParseResult a forall a. Parser a -> Input -> ParseResult a parse ([Parser a] -> Parser a forall a. [Parser a] -> Parser a anyOf [Parser a] rest) Input i) allOf :: [Parser a] -> Parser a allOf :: [Parser a] -> Parser a allOf [] = ParseError -> Parser a forall a. ParseError -> Parser a errorParser ParseError UnexpectedEof allOf [Parser a x] = Parser a x allOf ((P Input -> ParseResult a p) : [Parser a] rest) = (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a P ( \Input i -> case Input -> ParseResult a p Input i of result :: ParseResult a result @ (Result Input _ a _) -> Parser a -> Input -> ParseResult a forall a. Parser a -> Input -> ParseResult a parse ([Parser a] -> Parser a forall a. [Parser a] -> Parser a allOf [Parser a] rest) Input i error :: ParseResult a error @ (Error ParseError _) -> ParseResult a error) 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 let next :: a -> Parser a next = if Char -> Char -> Bool cond Char c1 Char c2 then a -> Parser a forall (f :: * -> *) a. Applicative f => a -> f a pure else Parser a -> a -> Parser a forall a b. a -> b -> a const (Parser a -> a -> Parser a) -> (ParseError -> Parser a) -> ParseError -> a -> Parser a forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseError -> Parser a forall a. ParseError -> Parser a errorParser (ParseError -> a -> Parser a) -> ParseError -> a -> Parser a forall a b. (a -> b) -> a -> b $ Char -> ParseError UnexpectedChar Char c2 Char -> Parser Char forall a. a -> Parser a next 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 let next :: a -> Parser a next = if a -> Bool cond a c2 then a -> Parser a forall (f :: * -> *) a. Applicative f => a -> f a pure else Parser a -> a -> Parser a forall a b. a -> b -> a const (Parser a -> a -> Parser a) -> (ParseError -> Parser a) -> ParseError -> a -> Parser a forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseError -> Parser a forall a. ParseError -> Parser a errorParser (ParseError -> a -> Parser a) -> ParseError -> a -> Parser a forall a b. (a -> b) -> a -> b $ Input -> ParseError NoMatch Input condName a -> Parser a forall a. a -> Parser a next a c2 except :: Show a => Parser a -> Parser a -> Parser a except :: Parser a -> Parser a -> Parser a except Parser a alt (P Input -> ParseResult a p) = (Input -> ParseResult a) -> Parser a forall a. (Input -> ParseResult a) -> Parser a P ( \Input i -> case Input -> ParseResult a p Input i of result :: ParseResult a result @ (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 :: ParseResult a error @ (Error ParseError _) -> Parser a -> Input -> ParseResult a forall a. Parser a -> Input -> ParseResult a parse Parser a alt Input i)