Last active
March 16, 2021 16:43
-
-
Save codgician/72b592c21a9cd9df0956f7c81c933e50 to your computer and use it in GitHub Desktop.
An example of monadic parsing written in Haskell.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE LambdaCase #-} | |
| import Control.Applicative | |
| import Data.Char | |
| newtype Parser a = P { parse :: String -> [(a, String)] } | |
| instance Functor Parser where | |
| -- fmap :: (a -> b) -> Parser a -> Parser b | |
| -- applies a function to the result value of the parser if | |
| -- the parser succeeds, and propagates the failure otherwise. | |
| fmap g p = P (\inp -> case parse p inp of | |
| [] -> [] | |
| [(v, out)] -> [(g v, out)]) | |
| instance Applicative Parser where | |
| -- pure :: a -> f a | |
| -- transforms a value into a parser that always | |
| -- succeeds with this value as its result, without | |
| -- consuming any of the input string. | |
| pure v = P (\inp -> [(v, inp)]) | |
| -- <*> :: Parser (a -> b) -> Parser a -> Parser b | |
| -- applies a parser that returns a function to a parser that | |
| -- returns an argument, to give a parser that returns | |
| -- the result of applying the function to the argument, | |
| -- and only succeeds if all the compomnents succeed. | |
| pg <*> px = P (\inp -> case parse pg inp of | |
| [] -> [] | |
| [(g, out)] -> parse (fmap g px) out) | |
| instance Monad Parser where | |
| -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b | |
| -- p >>= f fails if the application of parser `p` to | |
| -- the input string `inp` fails, and otherwise | |
| -- applies the function `f` to the result value `v` to | |
| -- give another parser `f v`, which is then applied to | |
| -- the output string `out` that was produced by the first parser | |
| -- to give the final result. | |
| p >>= f = P (\inp -> case parse p inp of | |
| [] -> [] | |
| [(v, out)] -> parse (f v) out) | |
| instance Alternative Parser where | |
| -- empty :: Parser a | |
| -- the parser that always fails regardless of the input string. | |
| empty = P (const []) | |
| -- (<|>) :: Parser a -> Parser a -> Parser a | |
| -- returns the first parser if it succeeds on the input, and | |
| -- applies the second parser to the same input otherwise. | |
| p <|> q = P (\inp -> case parse p inp of | |
| [] -> parse q inp | |
| [(v, out)] -> [(v, out)]) | |
| -- item: Fails if the input is empty, otherwise | |
| -- succeeds with the first character as result value | |
| item :: Parser Char | |
| item = P (\case | |
| [] -> [] | |
| (x:xs) -> [(x, xs)]) | |
| -- sat: Consumes a single character, and fails if | |
| -- given character does not satisfy predicate p | |
| -- otherwise succeeds with itself as result value | |
| sat :: (Char -> Bool) -> Parser Char | |
| sat p = do | |
| x <- item | |
| if p x then return x else empty | |
| -- opt: Consumes zero or one character, and | |
| -- returns v if no character is consumed | |
| opt :: Alternative f => a -> f a -> f a | |
| opt v p = p <|> pure v | |
| -- digit := 0 | 1 | ... | 9 | |
| digit :: Parser Char | |
| digit = sat isDigit | |
| -- sgn :: + | - | |
| sgn :: Parser Integer | |
| sgn = (const 1) <$> sat (== '+') | |
| <|> (const (-1)) <$> sat (== '-') | |
| -- num := { digit } | |
| num :: Parser Integer | |
| num = f <$> some digit | |
| where f x = read x | |
| -- expr := [ op ] num { op num } | |
| expr :: Parser Integer | |
| expr = do | |
| s <- opt 1 sgn | |
| x <- num | |
| y <- many $ (*) <$> sgn <*> num | |
| return (x + sum y) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment