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: https://www.youtube.com/watch?v=OrAVS4QbMqo
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"
}