I am building a parser using Megaparsec and I don't know which is the best approach to parse a structure like
names a b c
surnames d e f g
where names and surnames are keywords followed by a list of strings, and each of the two line is optional. This means that also
names a b c
and
surnames d e f g
are valid.
I can parse every line with something like
maybeNames <- optional $ do
constant "names"
many identifier
where identifier parses a valid non-reserved string.
Now, I'm not sure how to express that each line is optional, but still retrieve its value if it is present
Start with writing the context free grammar for your format:
program ::= lines
lines ::= line | line lines
line ::= names | surnames
names ::= NAMES ids
surnames ::= SURNAMES ids
ids ::= id | id ids
id ::= STRING
Where upper case names are for terminals,
and lower case names are for non terminals.
You could then easily use Alex + Happy to parse your text file.
You can do something similar to what appears in this guide and use <|>
to select optional arguments. Here are the essence of things:
whileParser :: Parser Stmt
whileParser = between sc eof stmt
stmt :: Parser Stmt
stmt = f <$> sepBy1 stmt' semi
where
-- if there's only one stmt return it without using ‘Seq’
f l = if length l == 1 then head l else Seq l
stmt' = ifStmt
<|> whileStmt
<|> skipStmt
<|> assignStmt
<|> parens stmt
ifStmt :: Parser Stmt
ifStmt = do
rword "if"
cond <- bExpr
rword "then"
stmt1 <- stmt
rword "else"
stmt2 <- stmt
return (If cond stmt1 stmt2)
whileStmt :: Parser Stmt
whileStmt = do
rword "while"
cond <- bExpr
rword "do"
stmt1 <- stmt
return (While cond stmt1)
Related
I have a simple language with following grammar
Expr -> Var | Int | Expr Op Expr
Op -> + | - | * | / | % | == | != | < | > | <= | >= | && | ||
Stmt -> Skip | Var := Expr | Stmt ; Stmt | write Expr | read Expr | while Expr do Stmt | if Expr then Stmt else Stmt
I am writing simple parser for this language using Haskell's Parsec library and i am stuck with some things
When i try to parse statement skip ; skip i get only first Skip, however i want go get something like Colon Skip Skip
Also when i try to parse the assignment, i get an infinite recursion. For example, when i try to parse x := 1 my computer hangs up for long time.
Here is full source code of my parser. Thanks for any help!
module Parser where
import Control.Monad
import Text.Parsec.Language
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as Token
type Id = String
data Op = Add
| Sub
| Mul
| Div
| Mod
| Eq
| Neq
| Gt
| Geq
| Lt
| Leq
| And
| Or deriving (Eq, Show)
data Expr = Var Id
| Num Integer
| BinOp Op Expr Expr deriving (Eq, Show)
data Stmt = Skip
| Assign Expr Expr
| Colon Stmt Stmt
| Write Expr
| Read Expr
| WhileLoop Expr Stmt
| IfCond Expr Stmt Stmt deriving (Eq, Show)
languageDef =
emptyDef { Token.commentStart = ""
, Token.commentEnd = ""
, Token.commentLine = ""
, Token.nestedComments = False
, Token.caseSensitive = True
, Token.identStart = letter
, Token.identLetter = alphaNum
, Token.reservedNames = [ "skip"
, ";"
, "write"
, "read"
, "while"
, "do"
, "if"
, "then"
, "else"
]
, Token.reservedOpNames = [ "+"
, "-"
, "*"
, "/"
, ":="
, "%"
, "=="
, "!="
, ">"
, ">="
, "<"
, "<="
, "&&"
, "||"
]
}
lexer = Token.makeTokenParser languageDef
identifier = Token.identifier lexer
reserved = Token.reserved lexer
reservedOp = Token.reservedOp lexer
semi = Token.semi lexer
parens = Token.parens lexer
integer = Token.integer lexer
whiteSpace = Token.whiteSpace lexer
ifStmt :: Parser Stmt
ifStmt = do
reserved "if"
cond <- expression
reserved "then"
action1 <- statement
reserved "else"
action2 <- statement
return $ IfCond cond action1 action2
whileStmt :: Parser Stmt
whileStmt = do
reserved "while"
cond <- expression
reserved "do"
action <- statement
return $ WhileLoop cond action
assignStmt :: Parser Stmt
assignStmt = do
var <- expression
reservedOp ":="
expr <- expression
return $ Assign var expr
skipStmt :: Parser Stmt
skipStmt = do
reserved "skip"
return Skip
colonStmt :: Parser Stmt
colonStmt = do
s1 <- statement
reserved ";"
s2 <- statement
return $ Colon s1 s2
readStmt :: Parser Stmt
readStmt = do
reserved "read"
e <- expression
return $ Read e
writeStmt :: Parser Stmt
writeStmt = do
reserved "write"
e <- expression
return $ Write e
statement :: Parser Stmt
statement = colonStmt
<|> assignStmt
<|> writeStmt
<|> readStmt
<|> whileStmt
<|> ifStmt
<|> skipStmt
expression :: Parser Expr
expression = buildExpressionParser operators term
term = fmap Var identifier
<|> fmap Num integer
<|> parens expression
operators = [ [Infix (reservedOp "==" >> return (BinOp Eq)) AssocNone,
Infix (reservedOp "!=" >> return (BinOp Neq)) AssocNone,
Infix (reservedOp ">" >> return (BinOp Gt)) AssocNone,
Infix (reservedOp ">=" >> return (BinOp Geq)) AssocNone,
Infix (reservedOp "<" >> return (BinOp Lt)) AssocNone,
Infix (reservedOp "<=" >> return (BinOp Leq)) AssocNone,
Infix (reservedOp "&&" >> return (BinOp And)) AssocNone,
Infix (reservedOp "||" >> return (BinOp Or)) AssocNone]
, [Infix (reservedOp "*" >> return (BinOp Mul)) AssocLeft,
Infix (reservedOp "/" >> return (BinOp Div)) AssocLeft,
Infix (reservedOp "%" >> return (BinOp Mod)) AssocLeft]
, [Infix (reservedOp "+" >> return (BinOp Add)) AssocLeft,
Infix (reservedOp "-" >> return (BinOp Sub)) AssocLeft]
]
parser :: Parser Stmt
parser = whiteSpace >> statement
parseString :: String -> Stmt
parseString str =
case parse parser "" str of
Left e -> error $ show e
Right r -> r`
It's a common problem of parsers based on parser combinator: statement is left-recursive as its first pattern is colonStmt, and the first thing colonStmt will do is try parsing a statement again. Parser combinators are well-known won't terminate in this case.
Removed the colonStmt pattern from statement parser and the other parts worked appropriately:
> parseString "if (1 == 1) then skip else skip"
< IfCond (BinOp Eq (Num 1) (Num 1)) Skip Skip
> parseString "x := 1"
< Assign (Var "x") (Num 1)
The solution is fully described in this repo, there's no license file so I don't really know if it's safe to refer to the code, the general idea is to add another layer of parser when parsing any statement:
statement :: Parser Stmt
statement = do
ss <- sepBy1 statement' (reserved ";")
if length ss == 1
then return $ head ss
else return $ foldr1 Colon ss
statement' :: Parser Stmt
statement' = assignStmt
<|> writeStmt
<|> readStmt
<|> whileStmt
<|> ifStmt
<|> skipStmt
I am trying to learn how can I do a parser for expressions in Haskell and I found this code (below), but I don't even know how to use it.
I tried with: expr (Add (Num 5) (Num 2)) , but it needs a "Parser" data type.
import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Expr
import Text.Parsec.Token
import Text.Parsec.Language
data Expr = Num Int | Var String | Add Expr Expr | Sub Expr Expr | Mul Expr Expr | Div Expr Expr deriving Show
expr :: Parser Expr
expr = buildExpressionParser table factor
<?> "expression"
table = [[op "*" Mul AssocLeft, op "/" Div AssocLeft],
[op "+" Add AssocLeft, op "-" Sub AssocLeft]]
where
op s f assoc = Infix (do{ string s; return f}) assoc
factor = do{ char '('
; x <- expr
; char ')'
; return x}
<|> number
<|> variable
<?> "simple expression"
number :: Parser Expr
number = do{ ds<- many1 digit
; return (Num (read ds))}
<?> "number"
variable :: Parser Expr
variable = do{ ds<- many1 letter
; return (Var ds)}
<?> "variable"
Solution: readExpr input = parse expr "name for error messages" input
and use readExpr.
You can use the function parse which will run a Parser on an input string and return an Either ParseError Expr. I put a simple usage below where I turn that ParseError into a string and pass it along
readExpr :: String -> Either String Expr
readExpr input = case parse expr "name for error messages" input of
Left err -> Left $ "Oh noes parsers are failing: " ++ show err -- Handle error
Right a -> Right a -- Handle success
There are a few other functions, such as parseFromFile, which let you shorthand a few common patterns, to find them, check out the parsec haddock
I'm trying to learn Parsec by implementing a small regular expression parser. In BNF, my grammar looks something like:
EXP : EXP *
| LIT EXP
| LIT
I've tried to implement this in Haskell as:
expr = try star
<|> try litE
<|> lit
litE = do c <- noneOf "*"
rest <- expr
return (c : rest)
lit = do c <- noneOf "*"
return [c]
star = do content <- expr
char '*'
return (content ++ "*")
There are some infinite loops here though (e.g. expr -> star -> expr without consuming any tokens) which makes the parser loop forever. I'm not really sure how to fix it though, because the very nature of star is that it consumes its mandatory token at the end.
Any thoughts?
You should use Parsec.Expr.buildExprParser; it is ideal for this purpose. You simply describe your operators, their precedence and associativity, and how to parse an atom, and the combinator builds the parser for you!
You probably also want to add the ability to group terms with parens so that you can apply * to more than just a single literal.
Here's my attempt (I threw in |, +, and ? for good measure):
import Control.Applicative
import Control.Monad
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
data Term = Literal Char
| Sequence [Term]
| Repeat (Int, Maybe Int) Term
| Choice [Term]
deriving ( Show )
term :: Parser Term
term = buildExpressionParser ops atom where
ops = [ [ Postfix (Repeat (0, Nothing) <$ char '*')
, Postfix (Repeat (1, Nothing) <$ char '+')
, Postfix (Repeat (0, Just 1) <$ char '?')
]
, [ Infix (return sequence) AssocRight
]
, [ Infix (choice <$ char '|') AssocRight
]
]
atom = msum [ Literal <$> lit
, parens term
]
lit = noneOf "*+?|()"
sequence a b = Sequence $ (seqTerms a) ++ (seqTerms b)
choice a b = Choice $ (choiceTerms a) ++ (choiceTerms b)
parens = between (char '(') (char ')')
seqTerms (Sequence ts) = ts
seqTerms t = [t]
choiceTerms (Choice ts) = ts
choiceTerms t = [t]
main = parseTest term "he(llo)*|wor+ld?"
Your grammar is left-recursive, which doesn’t play nice with try, as Parsec will repeatedly backtrack. There are a few ways around this. Probably the simplest is just making the * optional in another rule:
lit :: Parser (Char, Maybe Char)
lit = do
c <- noneOf "*"
s <- optionMaybe $ char '*'
return (c, s)
Of course, you’ll probably end up wrapping things in a data type anyway, and there are a lot of ways to go about it. Here’s one, off the top of my head:
import Control.Applicative ((<$>))
data Term = Literal Char
| Sequence [Term]
| Star Term
expr :: Parser Term
expr = Sequence <$> many term
term :: Parser Term
term = do
c <- lit
s <- optionMaybe $ char '*' -- Easily extended for +, ?, etc.
return $ if isNothing s
then Literal c
else Star $ Literal c
Maybe a more experienced Haskeller will come along with a better solution.
In my work I come across a lot of gnarly sql, and I had the bright idea of writing a program to parse the sql and print it out neatly. I made most of it pretty quickly, but I ran into a problem that I don't know how to solve.
So let's pretend the sql is "select foo from bar where 1". My thought was that there is always a keyword followed by data for it, so all I have to do is parse a keyword, and then capture all gibberish before the next keyword and store that for later cleanup, if it is worthwhile. Here's the code:
import Text.Parsec
import Text.Parsec.Combinator
import Text.Parsec.Char
import Data.Text (strip)
newtype Statement = Statement [Atom]
data Atom = Branch String [Atom] | Leaf String deriving Show
trim str = reverse $ trim' (reverse $ trim' str)
where
trim' (' ':xs) = trim' xs
trim' str = str
printStatement atoms = mapM_ printAtom atoms
printAtom atom = loop 0 atom
where
loop depth (Leaf str) = putStrLn $ (replicate depth ' ') ++ str
loop depth (Branch str atoms) = do
putStrLn $ (replicate depth ' ') ++ str
mapM_ (loop (depth + 2)) atoms
keywords :: [String]
keywords = [
"select",
"update",
"delete",
"from",
"where"]
keywordparser :: Parsec String u String
keywordparser = try ((choice $ map string keywords) <?> "keywordparser")
stuffparser :: Parsec String u String
stuffparser = manyTill anyChar (eof <|> (lookAhead keywordparser >> return ()))
statementparser = do
key <- keywordparser
stuff <- stuffparser
return $ Branch key [Leaf (trim stuff)]
<?> "statementparser"
tp = parse (many statementparser) ""
The key here is the stuffparser. That is the stuff in between the keywords that could be anything from column lists to where criteria. This function catches all characters leading up to a keyword. But it needs something else before it is finished. What if there is a subselect? "select id,(select product from products) from bar". Well in that case if it hits that keyword, it screws everything up, parses it wrong and screws up my indenting. Also where clauses can have parenthesis as well.
So I need to change that anyChar into another combinator that slurps up characters one at a time but also tries to look for parenthesis, and if it finds them, traverse and capture all that, but also if there are more parenthesis, do that until we have fully closed the parenthesis, then concatenate it all and return it. Here's what I've tried, but I can't quite get it to work.
stuffparser :: Parsec String u String
stuffparser = fmap concat $ manyTill somechars (eof <|> (lookAhead keywordparser >> return ()))
where
somechars = parens <|> fmap (\c -> [c]) anyChar
parens= between (char '(') (char ')') somechars
This will error like so:
> tp "select asdf(qwerty) from foo where 1"
Left (line 1, column 14):
unexpected "w"
expecting ")"
But I can't think of any way to rewrite this so that it works. I've tried to use manyTill on the parenthesis part, but I end up having trouble getting it to typecheck when I have both string producing parens and single chars as alternatives. Does anyone have any suggestions on how to go about this?
Yeah, between might not work for what you're looking for. Of course, for your use case, I'd follow hammar's suggestion and grab an off-the-shelf SQL parser. (personal opinion: or, try not to use SQL unless you really have to; the idea to use strings for database queries was imho a historical mistake).
Note: I add an operator called <++> which will concatenate the results of two parsers, whether they are strings or characters. (code at bottom.)
First, for the task of parsing parenthesis: the top level will parse some stuff between the relevant characters, which is exactly what the code says,
parseParen = char '(' <++> inner <++> char ')'
Then, the inner function should parse anything else: non-parens, possibly including another set of parenthesis, and non-paren junk that follows.
parseParen = char '(' <++> inner <++> char ')' where
inner = many (noneOf "()") <++> option "" (parseParen <++> inner)
I'll make the assumption that for the rest of the solution, what you want to do is analgous to splitting things up by top-level SQL keywords. (i.e. ignoring those in parenthesis). Namely, we'll have a parser that will behave like so,
Main> parseTest parseSqlToplevel "select asdf(select m( 2) fr(o)m w where n) from b where delete 4"
[(Select," asdf(select m( 2) fr(o)m w where n) "),(From," b "),(Where," "),(Delete," 4")]
Suppose we have a parseKw parser that will get the likes of select, etc. After we consume a keyword, we need to read until the next [top-level] keyword. The last trick to my solution is using the lookAhead combinator to determine whether the next word is a keyword, and put it back if so. If it's not, then we consume a parenthesis or other character, and then recurse on the rest.
-- consume spaces, then eat a word or parenthesis
parseOther = many space <++>
(("" <$ lookAhead (try parseKw)) <|> -- if there's a keyword, put it back!
option "" ((parseParen <|> many1 (noneOf "() \t")) <++> parseOther))
My entire solution is as follows
-- overloaded operator to concatenate string results from parsers
class CharOrStr a where toStr :: a -> String
instance CharOrStr Char where toStr x = [x]
instance CharOrStr String where toStr = id
infixl 4 <++>
f <++> g = (\x y -> toStr x ++ toStr y) <$> f <*> g
data Keyword = Select | Update | Delete | From | Where deriving (Eq, Show)
parseKw =
(Select <$ string "select") <|>
(Update <$ string "update") <|>
(Delete <$ string "delete") <|>
(From <$ string "from") <|>
(Where <$ string "where") <?>
"keyword (select, update, delete, from, where)"
-- consume spaces, then eat a word or parenthesis
parseOther = many space <++>
(("" <$ lookAhead (try parseKw)) <|> -- if there's a keyword, put it back!
option "" ((parseParen <|> many1 (noneOf "() \t")) <++> parseOther))
parseSqlToplevel = many ((,) <$> parseKw <*> (space <++> parseOther)) <* eof
parseParen = char '(' <++> inner <++> char ')' where
inner = many (noneOf "()") <++> option "" (parseParen <++> inner)
edit - version with quote support
you can do the same thing as with the parens to support quotes,
import Control.Applicative hiding (many, (<|>))
import Text.Parsec
import Text.Parsec.Combinator
-- overloaded operator to concatenate string results from parsers
class CharOrStr a where toStr :: a -> String
instance CharOrStr Char where toStr x = [x]
instance CharOrStr String where toStr = id
infixl 4 <++>
f <++> g = (\x y -> toStr x ++ toStr y) <$> f <*> g
data Keyword = Select | Update | Delete | From | Where deriving (Eq, Show)
parseKw =
(Select <$ string "select") <|>
(Update <$ string "update") <|>
(Delete <$ string "delete") <|>
(From <$ string "from") <|>
(Where <$ string "where") <?>
"keyword (select, update, delete, from, where)"
-- consume spaces, then eat a word or parenthesis
parseOther = many space <++>
(("" <$ lookAhead (try parseKw)) <|> -- if there's a keyword, put it back!
option "" ((parseParen <|> parseQuote <|> many1 (noneOf "'() \t")) <++> parseOther))
parseSqlToplevel = many ((,) <$> parseKw <*> (space <++> parseOther)) <* eof
parseQuote = char '\'' <++> inner <++> char '\'' where
inner = many (noneOf "'\\") <++>
option "" (char '\\' <++> anyChar <++> inner)
parseParen = char '(' <++> inner <++> char ')' where
inner = many (noneOf "'()") <++>
(parseQuote <++> inner <|> option "" (parseParen <++> inner))
I tried it with parseTest parseSqlToplevel "select ('a(sdf'())b". cheers
I'm new to Haskell and I am trying to parse expressions. I found out about Parsec and I also found some articles but I don't seem to understand what I have to do. My problem is that I want to give an expression like "x^2+2*x+3" and the result to be a function that takes an argument x and returns a value. I am very sorry if this is an easy question but I really need some help. Thanks! The code I inserted is from the article that you can find on this link.
import Control.Monad(liftM)
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Token
import Text.ParserCombinators.Parsec.Language
data Expr = Num Int | Var String | Add Expr Expr
| Sub Expr Expr | Mul Expr Expr | Div Expr Expr
| Pow Expr Expr
deriving Show
expr :: Parser Expr
expr = buildExpressionParser table factor
<?> "expression"
table = [[op "^" Pow AssocRight],
[op "*" Mul AssocLeft, op "/" Div AssocLeft],
[op "+" Add AssocLeft, op "-" Sub AssocLeft]]
where
op s f assoc
= Infix (do{ string s; return f}) assoc
factor = do{ char '('
; x <- expr
; char ')'
; return x}
<|> number
<|> variable
<?> "simple expression"
number :: Parser Expr
number = do{ ds<- many1 digit
; return (Num (read ds))}
<?> "number"
variable :: Parser Expr
variable = do{ ds<- many1 letter
; return (Var ds)}
<?> "variable"
This is just a parser for expressions with variables. Actually interpreting the expression is an entirely separate matter.
You should create a function that takes an already parsed expression and values for variables, and returns the result of evaluating the expression. Pseudocode:
evaluate :: Expr -> Map String Int -> Int
evaluate (Num n) _ = n
evaluate (Var x) vars = {- Look up the value of x in vars -}
evaluate (Plus e f) vars = {- Evaluate e and f, and return their sum -}
...
I've deliberately omitted some details; hopefully by exploring the missing parts, you learn more about Haskell.
As a next step, you should probably look at the Reader monad for a convenient way to pass the variable map vars around, and using Maybe or Error to signal errors, e.g. referencing a variable that is not bound in vars, or division by zero.