Hi,
Below is code I’m building up for simple monadic and applicative parsers from first principles.
I’ve just added code for single line Haskell style comments.
-- comment being '--'
comment :: Parser ()
comment = do
string "--"
many (sat ( /='\n') )
return ()
— or as applicative
comment' = string "--" *> many (sat (/='\n') )
I’d really appreciate help on writing a function for multi line comments! “{-“ and end with “-}”
I know I need some sort of look ahead but can’t quite get the feel of how!
Thanks
Mike
======================================
import Control.Applicative
import Data.Char
newtype Parser a = P (String -> [(a,String)])
parse :: Parser a -> String -> [(a,String)]
parse (P p) = p
item :: Parser Char
item = P (\s -> case s of
[] -> []
(x:xs) -> [(x, xs)])
instance Functor Parser where
-- fmap :: (a -> b) -> f a -> f b
fmap g p = P (\inp -> case parse p inp of
[] -> []
[(x, xs)] -> [(g x, xs)])
instance Applicative Parser where
-- pure :: a -> Parser a
-- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
pure x = P (\inp -> [(x, inp)])
pab <*> pa = P (\inp -> case parse pab inp of
[] -> []
[(aTob, out)] -> parse (fmap aTob pa) out)
three :: Parser (Char, Char)
three = pure g <*> item <*> item <*> item
where g x y z = (x, z)
instance Monad Parser where
-- return :: a -> Parser a
return x = P (\inp -> [(x, inp)])
-- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
pa >>= f = P (\inp -> case parse pa inp of
[] -> []
[(a, out)] -> parse (f a) out)
instance Alternative Parser where
-- empty :: Parser a
empty = P (\inp -> [])
-- (<|>) :: Parser a-> Parser a -> Parser a
-- if p1 works the that one otherwise p2
p1 <|> p2 = P (\inp -> case parse p1 inp of
[] -> parse p2 inp
out -> out)
sat :: (Char -> Bool) -> Parser Char
sat p = do
x <- item
if p x then return x else empty
digit :: Parser Char
digit = sat isDigit
lower :: Parser Char
lower = sat isLower
upper :: Parser Char
upper = sat isUpper
letter :: Parser Char
letter = sat isAlpha
alphanum :: Parser Char
alphanum = sat isAlphaNum
char :: Char -> Parser Char
char x = sat (==x)
string :: String -> Parser String
string [] = return []
string s@(x:xs) = do
char x *> string xs *> return s
ident :: Parser String
ident = do
x <- lower
xs <- many alphanum
return (x:xs)
ident' :: Parser String
ident' = pure (:) <*> lower <*> many alphanum
nat :: Parser Int
nat = do
xs <- some digit
return (read xs)
nat' :: Parser Int
nat' = pure read <*> some digit
space :: Parser ()
space = do
many (sat isSpace )
return ()
space' :: Parser ()
space' = many (sat isSpace ) *> return ()
int :: Parser Int
int = do
char '-'
n <- nat
return (-n)
<|> nat
int' :: Parser Int
int' = char '-' *> pure ((-1)*) <*> nat <|> nat
token :: Parser a -> Parser a
token p = do
space
v <- p
space
return v
token' :: Parser a -> Parser a
token' p = space *> p <* space
identifier :: Parser String
identifier = token ident
natural :: Parser Int
natural = token nat
integer :: Parser Int
integer = token int
symbol :: String -> Parser String
symbol xs = token (string xs)
nats :: Parser [Int]
nats = do
symbol "["
n <- natural
ns <- many ( do symbol ","
natural )
symbol "]"
return (n:ns)
-- comment being '--'
comment :: Parser ()
comment = do
string "--"
many (sat ( /='\n') )
return ()
comment' = string "--" *> many (sat (/='\n') )
nats' :: Parser [Int]
-- sequence and ignore "[" and the rest
-- the rest is fmap list cons into result of natural and the apply that to many others and
-- finally ignore the closing "]"
nats' = symbol "[" >> (:) <$> natural <*> many (symbol "," >> natural) <* symbol "]"
