115 lines
3.3 KiB
Haskell
115 lines
3.3 KiB
Haskell
-- monadic parsing
|
|
-- https://bitbucket.org/piyush-kurur/functional-programming/raw/a2b004847c92f88aa6ae3073f4d230b3a770cad8/notes/live.org
|
|
-- Graham Hutton book (2e)
|
|
|
|
import Control.Applicative
|
|
import Data.Char
|
|
|
|
-- | Result of parsing
|
|
data Result a = OK a String -- ^ Parsed data
|
|
| Error String -- ^ error message
|
|
|
|
-- | Parser capable of parsing a value of type `a`
|
|
newtype Parser a = Parser {runParser :: String -> Result a}
|
|
|
|
instance Functor Result where
|
|
-- fmap :: (a -> b) -> Result a -> Result b
|
|
fmap f (OK a s) = OK (f a) s
|
|
fmap _ (Error msg) = Error msg
|
|
--fmap _ obj = obj
|
|
|
|
instance Applicative Result where
|
|
-- pure :: a -> Result a
|
|
pure x = OK x ""
|
|
|
|
-- (<*>) :: Result (a -> b) -> Result a -> Result b
|
|
(OK fa2b rem) <*> a = fa2b <$> a
|
|
(Error msg) <*> _ = Error msg
|
|
|
|
instance Functor Parser where
|
|
-- fmap :: (a -> b) -> Parser a -> Parser b
|
|
fmap f (Parser pa) = Parser pb
|
|
where
|
|
pb inp = f <$> pa inp
|
|
|
|
instance Applicative Parser where
|
|
-- pure :: a -> Parser a
|
|
-- insert a value `x` of type `a` to the parsed part
|
|
pure x = Parser (\inp -> OK x inp)
|
|
|
|
-- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
|
|
(Parser pa2b) <*> (Parser pa) = Parser pb
|
|
where
|
|
-- `pb inp` should be of type `Result b`
|
|
pb inp = case pa2b inp of
|
|
-- fa2b :: a -> b
|
|
-- rem :: String
|
|
--
|
|
-- attempt to parse rem as a, which is then
|
|
-- passed to fa2b to make it b
|
|
-- `pa rem` is of type `Result a`
|
|
-- `fa2b <$> pa rem` is of type `Result b`
|
|
OK fa2b rem -> fa2b <$> (pa rem)
|
|
Error msg -> Error msg
|
|
|
|
instance Monad Parser where
|
|
-- Context sensitive parsing as ppk said
|
|
-- (>>=) :: Parser a -> (a -> Parser b) -> (Parser b)
|
|
(Parser pa) >>= fa2pb = Parser pb
|
|
where
|
|
-- fa2b :: a -> Parser b
|
|
pb inp = case pa inp of
|
|
-- `fa2pb a` is of type `Parser b`
|
|
-- `runParser $ fa2pb a` is of type `String -> Result b`
|
|
OK a rem -> (runParser $ fa2pb a) rem
|
|
Error msg -> Error msg
|
|
|
|
instance Alternative Parser where
|
|
-- empty :: Parser a
|
|
empty = Parser (\inp -> Error "empty!")
|
|
|
|
-- (<|>) :: Parser a -> Parser a -> Parser a
|
|
-- Try parsing with first parser, if that fails
|
|
-- try parsing with the next parser.
|
|
(Parser px) <|> (Parser py) = Parser pz
|
|
where
|
|
pz inp = case px inp of
|
|
OK xval rem -> OK xval rem
|
|
Error _ ->
|
|
case py inp of
|
|
OK yval rem -> OK yval rem
|
|
Error msg -> Error msg
|
|
|
|
{-
|
|
satisfy :: Char -> String -> Result a
|
|
-- `x` is `Char`
|
|
satisfy ch (x:rem) = if ch==x then OK x rem
|
|
else Error "err"
|
|
|
|
helloP = Parser
|
|
-}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- parse :: Parser a -> String -> [(a, String)]
|
|
-- -- p :: String -> [(a, String)]
|
|
-- parse (Parser p) inp = p inp
|
|
--
|
|
-- item :: Parser Char
|
|
-- item = Parser (\inp -> case inp of
|
|
-- [] -> []
|
|
-- (x:xs) -> [(x, xs)])
|
|
-- -- λ> parse item "hello"
|
|
-- -- [('h',"ello")]
|
|
--
|
|
-- instance Functor Parser where
|
|
-- -- fmap :: (a -> b) -> Parser a -> Parser b
|
|
-- fmap f pp = Parser (\inp ->
|
|
-- case parse pp inp of
|
|
-- [] -> []
|
|
-- [(x,xs)] -> [(f x,xs)])
|