Just running piece of code..
I had some problems with code from Erik Meijer and Graham Hutton publication from this pdf: https://www.researchgate.net/publication/2619685_Monadic_Parsing_in_Haskell
Older version of this parser example was used by Erik Meijer in video "C9 Lectures: Dr. Erik Meijer - Functional Programming Fundamentals Chapter 8 of 13" here:
Hope this will be usefull for somebody, this minimal example is good starting point for learning parsers and monads in Haskell language.
import System.IO
import Data.Char
import Control.Monad
import Control.Applicative
--https://www.researchgate.net/publication/2619685_Monadic_Parsing_in_Haskell
newtype Parser a = Parser (String -> [(a, String)])
instance Functor Parser where
fmap = liftM
instance Applicative Parser where
pure a = Parser (\cs -> [(a,cs)])
(<*>) = ap
instance Monad Parser where
return a = Parser (\cs -> [(a,cs)])
p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])
instance MonadPlus Parser where
p mplus
q = Parser (\cs -> parse p cs ++ parse q cs)
mzero = Parser (const [])
instance Alternative Parser where
(<|>) = mplus
empty = mzero
parse :: Parser a -> String -> [(a, String)]
parse (Parser p) = p
apply :: Parser a -> String -> [(a,String)]
apply p = parse (do {space; p})
failure :: Parser a
failure = mzero
-- (+++) :: Parser a -> Parser a -> Parser a
-- p +++ q = Parser (\cs -> case parse (p ++ q) cs of
-- [] -> []
-- (x:xs) -> [x])
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = p mplus
q
-- sat :: (Char -> Bool) -> Parser Char
-- sat p = do {c <- item; if p c then return c else zero}
sat :: (Char -> Bool) -> Parser Char
sat p = do {
; x <- item
; if p x then return x else failure
}
char :: Char -> Parser Char
char c = sat (c ==)
manyP :: Parser a -> Parser [a]
manyP p = manyP1 p +++ return []
manyP1 :: Parser a -> Parser [a]
manyP1 p = do {
; a <- p;
; as <- manyP p;
; return (a:as)
}
space :: Parser String
space = manyP (sat isSpace)
item :: Parser Char
item = Parser (\cs -> case cs of
"" -> []
(c:cs) -> [(c,cs)])
main = do {
; print $ apply ( do {a <- item ; b <- item; return (a,b)} ) "abcd"
; putStrLn "bye"
}