The goal of this is to implement <++ in Haskell using StateT to act as a parser
import Control.Monad.State
type Parser = StateT String []
runParser :: Parser a -> String -> [(a,String)]
runParser = runStateT
parser :: (String -> [(a,String)]) -> Parser a
parser = StateT
(<++) :: Parser a -> Parser a -> Parser a
From this base, how could I implement <++ so that it mirrors the definition in Text.ParserCombinators.ReadP
Local, exclusive, left-biased choice: If left parser locally produces any result at all, then right parser is not used.
Your parser are functions String -> [(a,String)] where the argument is the initial state. So lets construct such a function that tries the first parser, and if it fails tries the second parser:
(<++) :: Parser a -> Parser a -> Parser a
p1 <++ p2 =
parser $ \s0 -> -- 1. captures initial state
case runParser p1 s0 of -- 2. run first parser
(x:xs) -> x : xs -- 3. success
[] -> runParser p2 s0 -- 4. otherwise run second parser
Some parsers to try this out
-- | Always fails
failP :: Parser a
failP = parser (const [])
-- | Parses an Int
intP :: Parser Int
intP = parser reads
Output as expected? (Perhaps there are more enlightening test cases...)
λ> runParser (failP <++ intP) "2014"
[(2014,"")]
λ> runParser (intP <++ failP) "2014"
[(2014,"")]
λ> runParser (intP <++ intP) "2014"
[(2014,"")]
Related
I'm practicing writing parsers. I'm using Tsodings JSON Parser video as reference. I'm trying to add to it by being able to parse arithmetic of arbitrary length and I have come up with the following AST.
data HVal
= HInteger Integer -- No Support For Floats
| HBool Bool
| HNull
| HString String
| HChar Char
| HList [HVal]
| HObj [(String, HVal)]
deriving (Show, Eq, Read)
data Op -- There's only one operator for the sake of brevity at the moment.
= Add
deriving (Show, Read)
newtype Parser a = Parser {
runParser :: String -> Maybe (String, a)
}
The following functions is my attempt of implementing the operator parser.
ops :: [Char]
ops = ['+']
isOp :: Char -> Bool
isOp c = elem c ops
spanP :: (Char -> Bool) -> Parser String
spanP f = Parser $ \input -> let (token, rest) = span f input
in Just (rest, token)
opLiteral :: Parser String
opLiteral = spanP isOp
sOp :: String -> Op
sOp "+" = Add
sOp _ = undefined
parseOp :: Parser Op
parseOp = sOp <$> (charP '"' *> opLiteral <* charP '"')
The logic above is similar to how strings are parsed therefore my assumption was that the only difference was looking specifically for an operator rather than anything that's not a number between quotation marks. It does seemingly begin to parse correctly but it then gives me the following error:
λ > runParser parseOp "\"+\""
Just ("+\"",*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:80:14 in base:GHC.Err
undefined, called at /DIRECTORY/parser.hs:110:11 in main:Main
I'm confused as to where the error is occurring. I'm assuming it's to do with sOp mainly due to how the other functions work as intended as the rest of parseOp being a translation of the parseString function:
stringLiteral :: Parser String
stringLiteral = spanP (/= '"')
parseString :: Parser HVal
parseString = HString <$> (charP '"' *> stringLiteral <* charP '"')
The only reason why I have sOp however is that if it was replaced with say Op, I would get the error that the following doesn't exist Op :: String -> Op. When I say this my inclination was that the string coming from the parsed expression would be passed into this function wherein I could return the appropriate operator. This however is incorrect and I'm not sure how to proceed.
charP and Applicative Instance
charP :: Char -> Parser Char
charP x = Parser $ f
where f (y:ys)
| y == x = Just (ys, x)
| otherwise = Nothing
f [] = Nothing
instance Applicative Parser where
pure x = Parser $ \input -> Just (input, x)
(Parser p) <*> (Parser q) = Parser $ \input -> do
(input', f) <- p input
(input', a) <- q input
Just (input', f a)
The implementation of (<*>) is the culprit. You did not use input' in the next call to q, but used input instead. As a result you pass the string to the next parser without "eating" characters. You can fix this with:
instance Applicative Parser where
pure x = Parser $ \input -> Just (input, x)
(Parser p) <*> (Parser q) = Parser $ \input -> do
(input', f) <- p input
(input'', a) <- q input'
Just (input'', f a)
With the updated instance for Applicative, we get:
*Main> runParser parseOp "\"+\""
Just ("",Add)
I'm given the following parsers
newtype Parser a = Parser { parse :: String -> Maybe (a,String) }
instance Functor Parser where
fmap f p = Parser $ \s -> (\(a,c) -> (f a, c)) <$> parse p s
instance Applicative Parser where
pure a = Parser $ \s -> Just (a,s)
f <*> a = Parser $ \s ->
case parse f s of
Just (g,s') -> parse (fmap g a) s'
Nothing -> Nothing
instance Alternative Parser where
empty = Parser $ \s -> Nothing
l <|> r = Parser $ \s -> parse l s <|> parse r s
ensure :: (a -> Bool) -> Parser a -> Parser a
ensure p parser = Parser $ \s ->
case parse parser s of
Nothing -> Nothing
Just (a,s') -> if p a then Just (a,s') else Nothing
lookahead :: Parser (Maybe Char)
lookahead = Parser f
where f [] = Just (Nothing,[])
f (c:s) = Just (Just c,c:s)
satisfy :: (Char -> Bool) -> Parser Char
satisfy p = Parser f
where f [] = Nothing
f (x:xs) = if p x then Just (x,xs) else Nothing
eof :: Parser ()
eof = Parser $ \s -> if null s then Just ((),[]) else Nothing
eof' :: Parser ()
eof' = ???
I need to write a new parser eof' that does exactly what eof does but is built only using the given parsers and the
Functor/Applicative/Alternative instances above. I'm stuck on this as I don't have experience in combining parsers. Can anyone help me out ?
To understand it easier, we can write it in an equational pseudocode, while we substitute and simplify the definitions, using Monad Comprehensions for clarity and succinctness.
Monad Comprehensions are just like List Comprehensions, only working for any MonadPlus type, not just []; while corresponding closely to do notation, e.g. [ (f a, s') | (a, s') <- parse p s ] === do { (a, s') <- parse p s ; return (f a, s') }.
This gets us:
newtype Parser a = Parser { parse :: String -> Maybe (a,String) }
instance Functor Parser where
parse (fmap f p) s = [ (f a, s') | (a, s') <- parse p s ]
instance Applicative Parser where
parse (pure a) s = pure (a, s)
parse (pf <*> pa) s = [ (g a, s'') | (g, s') <- parse pf s
, (a, s'') <- parse pa s' ]
instance Alternative Parser where
parse empty s = empty
parse (l <|> r) s = parse l s <|> parse r s
ensure :: (a -> Bool) -> Parser a -> Parser a
parse (ensure pred p) s = [ (a, s') | (a, s') <- parse p s, pred a ]
lookahead :: Parser (Maybe Char)
parse lookahead [] = pure (Nothing, [])
parse lookahead s#(c:_) = pure (Just c, s )
satisfy :: (Char -> Bool) -> Parser Char
parse (satisfy p) [] = mzero
parse (satisfy p) (x:xs) = [ (x, xs) | p x ]
eof :: Parser ()
parse eof s = [ ((), []) | null s ]
eof' :: Parser ()
eof' = ???
By the way thanks to the use of Monad Comprehensions and the more abstract pure, empty and mzero instead of their concrete representations in terms of the Maybe type, this same (pseudo-)code will work with a different type, like [] in place of Maybe, viz. newtype Parser a = Parser { parse :: String -> [(a,String)] }.
So we have
ensure :: (a -> Bool) -> Parser a -> Parser a
lookahead :: Parser (Maybe Char)
(satisfy is no good for us here .... why?)
Using that, we can have
ensure ....... ...... :: Parser (Maybe Char)
(... what does ensure id (pure False) do? ...)
but we'll have a useless Nothing result in case the input string was in fact empty, whereas the eof parser given to use produces the () as its result in such case (and otherwise it produces nothing).
No fear, we also have
fmap :: ( a -> b ) -> Parser a -> Parser b
which can transform the Nothing into () for us. We'll need a function that will always do this for us,
alwaysUnit nothing = ()
which we can use now to arrive at the solution:
eof' = fmap ..... (..... ..... ......)
I'm trying to write a simple Parser, so all the declarations are listed in the image below, but when I try to compile this module it fails.
I'm following the tutorial provided by this source ->
Haskell lessons suggested by official site and specifically this video by Dr. Erik Meijer (Lesson on Parser with "do" construct).
The problem is that I thought that the "do" construct was able to "concatenate" outputs from a previous function in a descending way, but the way that this p function should work seems to be magic to me. What's the right implementation?
-- Generic Parser.
type Parser a = String -> [(a, String)]
-- A simple Parser that captures the first char of the string, puts it in
-- the first position of the couple and then puts the rest of the string into
-- the second place of the couple inside the singleton list.
item :: Parser Char
item = \inp -> case inp of
[] -> []
(x:xs) -> [(x, xs)]
-- Simple parser that always fails.
failure :: Parser a
failure = \inp -> []
-- Returns the type of the parser without operating on the input.
return1 :: a -> Parser a
return1 v = \inp -> [(v, inp)]
-- Explicit call to parse.
parse :: Parser a -> String -> [(a, String)]
parse p inp = p inp
-- Some kind of "or" operator that if the first parser fails (returning an empty list) it
-- parses the second parser.
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = \inp -> case p inp of
[] -> parse q inp
[(v, out)] -> [(v, out)]
-- The function within I'm having troubles.
p :: Parser (Char,Char)
p = do
x <- item
item
y <- item
return1 (x, y)
This is how it's explained by Dr. Meijer:
And this is how it should work:
Your Parser is just a type synonym for a function. The friendly parsers you've seen in use are all proper types of their own, with Functor and Applicative instances, along with (in most cases) Alternative, Monad, and MonadPlus instances. You probably want something that looks like the following (untested, never compiled) version.
import Control.Monad (ap, liftM)
import Control.Applicative (Alternative (..))
newtype Parser a = Parser
{ runParser :: String -> [(a, String)] }
instance Functor Parser where
fmap = liftM
instance Applicative Parser where
pure v = Parser $ \inp -> [(v, inp)]
(<*>) = ap
instance Monad Parser where
-- The next line isn't required for
-- recent GHC versions
-- return = pure
Parser m >>= f = Parser $ \s ->
[(r, s'') | (x, s') <- m s
, (r, s'') <- runParser (f r) s']
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = Parser $ \inp -> case runParser p inp of
[] -> runParser q inp
[(v, out)] -> [(v, out)]
failure :: Parser a
failure = Parser $ \inp -> []
instance Alternative Parser where
(<|>) = (+++)
empty = failure
instance MonadPlus Parser
Given a data type data CI = CI Int Int, representing a complex number, I want to build a parser for CI that can convert "a" to CI a 0 and "(a,b)" to CI a b. For example, I want a function parseCI such runParser parseCI "(1,2)" returns the value [(CI 1 2, "")] (ideally, but something similar is fine). I also want to make CI an instance of read.
I would like to do this using functions and definitions from the code below (basically, without anything advanced, like Parsec), but I'm not sure where to start. Some starting code to set me on the right track and/or a hint would be helpful. I'm not looking for a full answer, as I'd like to figure that out myself.
module Parser where
import Control.Applicative
import Control.Monad
newtype Parser a = Parser { runParser :: String -> [(a,String)] }
satisfy :: (Char -> Bool) -> Parser Char
satisfy f = Parser $ \s -> case s of
[] -> []
a:as -> [(a,as) | f a]
char :: Char -> Parser Char
char = satisfy . (==)
string :: String -> Parser String
string str = Parser $ \s -> [(t,u) | let (t,u) = splitAt (length str) s, str == t]
instance Functor Parser where
fmap f p = Parser $ \s ->
[ (f a,t)
| (a,t) <- runParser p s
]
instance Applicative Parser where
pure a = Parser $ \s -> [(a,s)]
af <*> aa = Parser $ \s ->
[ (f a,u)
| (f,t) <- runParser af s
, (a,u) <- runParser aa t
]
instance Alternative Parser where
empty = Parser $ \s -> []
p1 <|> p2 = Parser $ (++) <$> runParser p1 <*> runParser p2`
instance Monad Parser where
return = pure
ma >>= f = Parser $ \s ->
[ (b,u)
| (a,t) <- runParser ma s
, (b,u) <- runParser (f a) t
]
instance MonadPlus Parser where
mzero = empty
mplus = (<|>)
You've probably already seen it, but in case you haven't: Monadic Parsing in Haskell sets up parsing like this.
Since you have two different ways of parsing CI, you might want to approach this as two problems: make one parser parseCI1 that parses "a" to CI a 0 and make another parser parseCI2 that parses "(a,b)" to CI a b. Then, you can combine these into one with
parseCI = parseCI1 <|> parseCI2
For both of these subparsers, you will need some way of parsing integers: parseInt :: Parser Int. When making parseInt, you will likely want to use some combination of satisfy, isDigit, read, and possibly some (depending on how you go about solving this).
Making CI an instance of read is a bit more straightforward once you have parseCI done:
instance Read CI where
readsPrec _ = runParser parseCI
I am trying to understand Parsers. Therefore I have created my own parser. Unfortunately it does not work. Why?
type Parser a = String -> [(a, String)]
preturn :: a -> Parser a
preturn t = \inp -> [(t,inp)]
pfailure :: Parser a
pfailure = \inp -> []
pitem :: Parser Char
pitem = \inp -> case inp of
[] -> []
(x:xs) -> [(x,xs)]
parse :: Parser a -> Parser a
--parse :: Parser a -> String -> [(a,String)]
parse p inp = p inp
{-
combine :: Parser a -> Parser b -> Parser (a,b)
combine p1 p2 = \inp -> p2 t output
where
p1 inp = ([
-}
-- firstlast :: Parser (Char,Char)
firstlast = do
x <- pitem
z <- pitem
y <- pitem
preturn (x,y)
another = do
x <- pitem
y <- pitem
Firstlast is supposed to take a string and return the first and third character. Unfortunately, it returns odd values, and it does not accept its type (Parser (Char,Char))
For example,
*Main> firstlast "abc"
[(([('a',"bc")],[('a',"bc")]),"abc")]
What should happen is:
*Main> firstlast "abc"
[("ac",[])]
Please use code that compiles. Your another function does not.
What's the problem?
Your code for firstlast and another makes use of do-notation. And the way you're using pitem here, it looks as if you're expecting Parser to be a monad. But it isn't, at least not in the way you expect it to be.
There is a monad instance pre-defined which make GHC think that Parser is a monad, namely
instance Monad ((->) r) where
return = const
f >>= k = \ r -> k (f r) r
What this instance says is that, for any type r the function type r -> ... can be considered a monad, namely by distributing the parameter everywhere. So returning something in this monad amounts to producing a value ignoring the parameter of type r, and binding a value means that you take r and pass it on both to the left and right computation.
This is not what you want for a parser. The input string will be distributed to all computations. So each pitem will operate on the original input string. Furthermore, as
pitem :: String -> [(Char, String)]
the result of your monadic computation will be of type [(Char, String)], so x and y are both of this type. That's why you get the result
[(([('a',"bc")],[('a',"bc")]),"abc")]
You're calling pitem three times on the same input string. You're putting two results in a pair, and you're preturn-ing the whole thing.
How to fix it?
You need to define your own monad instance for the Parser type. You cannot do that directly, because Parser is a type synonym, and type synonyms cannot be partially applied,
so you cannot write
instance Monad Parser where
...
Instead, you have to wrap Parser in a new datatype or newtype:
newtype Parser a = Parser { parse :: String -> [(a, String)] }
This gives you a constructor Parser and a function parse to convert between the unwrapped and wrapped parser types:
Parser :: String -> [(a, String)] -> Parser a
parse :: Parser a -> String -> [(a, String)]
This implies you'll have to adapt your other functions. For example, preturn becomes
preturn :: a -> Parser a
preturn t = Parser (\inp -> [(t,inp)])
Change pfailure and pitem similarly. Then, you have to define the Monad instance:
instance Monad Parser where
return = preturn
(>>=) = ... -- to be completed by you
The function (>>=) is not contained in your code above. You'll want to implement the behaviour that the input is passed to the first parser, and for every result of that, the result and the remaining input are passed to the second argument of (>>=). Once this is done, a call to parse firstlast "abc" will have the following result:
[(('a','c'),"")]
which isn't quite what you want in your question, but I believe it's what you're actually after.