I'm working on a Parsec parser to handle a somewhat complex data file format (and I have no control over this format).
I've made a lot of progress, but am currently stuck with the following.
I need to be able to parse a line somewhat like this:
4 0.123 1.452 0.667 * 3.460 149 - -
Semantically, the 4 is a nodeNum, the Floats and the * are negative log probabilities (so, * represents the negative log of probability zero). The 149 and the minus signs are really junk, which I can discard, but I need to at least make sure they don't break the parser.
Here's what I have so far:
This handles the "junk" I mentioned. It could probably be simpler, but it works by itself.
emAnnotationSet = (,,) <$> p_int <*>
(reqSpaces *> char '-') <*>
(reqSpaces *> char '-')
the nodeNum at the beginning of the line is handled by another parser that works and I need not get into.
The problem is in trying to pick out all the p_logProbs from the line, without consuming the digits at the beginning of the emAnnotationSet.
the parser for p_logProb looks like this:
p_logProb = liftA mkScore (lp <?> "logProb")
where lp = try dub <|> string "*"
dub = (++) <$> ((++) <$> many1 digit <*> string ".") <*> many1 digit
And finally, I try to separate the logProb entries from the trailing emAnnotationSet (which starts with an integer) as follows:
hmmMatchEmissions = optSpaces *> (V.fromList <$> sepBy p_logProb reqSpaces)
<* optSpaces <* emAnnotationSet <* eol
<?> "matchEmissions"
So, p_logProb will only succeed on a float that begins with digits, includes a decimal point, and then has further digits (this restriction is respected by the file format).
I'd hoped that the try in the p_logProb definition would avoid consuming the leading digits if it didn't parse the decimal and the rest, but this doesn't seem to work; Parsec still complains that it sees an unexpected space after the digits of that integer in the emAnnotationSet:
Left "hmmNode" (line 1, column 196):
unexpected " "
expecting logProb
column 196 corresponds to the space after the integer preceding the minus signs, so it's clear to me that the problem is that the p_logProb parser is consuming the integer. How can I fix this so the p_logProb parser uses lookahead correctly, thus leaving that input for the emAnnotationSet parser?
The integer which terminates the probabilities cannot be mistaken for a probability since it doesn't contain a decimal point. The lexeme combinator converts a parser into one that skips trailing spaces.
import Text.Parsec
import Text.Parsec.String
import Data.Char
import Control.Applicative ( (<$>), (<*>), (<$), (<*), (*>) )
fractional :: Fractional a => Parser a
fractional = try $ do
n <- fromIntegral <$> decimal
char '.'
f <- foldr (\d f -> (f + fromIntegral (digitToInt d))/10.0) 0.0 <$> many1 digit
return $ n + f
decimal :: Parser Int
decimal = foldl (\n d -> 10 * n + digitToInt d) 0 <$> many1 digit
lexeme :: Parser a -> Parser a
lexeme p = p <* skipMany (char ' ')
data Row = Row Int [Maybe Double]
deriving ( Show )
probability :: Fractional a => Parser (Maybe a)
probability = (Just <$> fractional) <|> (Nothing <$ char '*')
junk = lexeme decimal <* count 2 (lexeme $ char '-')
row :: Parser Row
row = Row <$> lexeme decimal <*> many1 (lexeme probability) <* junk
rows :: Parser [Row]
rows = spaces *> sepEndBy row (lexeme newline) <* eof
Usage:
*Main> parseTest rows "4 0.123 1.234 2.345 149 - -\n5 0.123 * 2.345 149 - -"
[Row 4 [Just 0.123,Just 1.234,Just 2.345],Row 5 [Just 0.123,Nothing,Just 2.345]]
I'm not exactly sure of your problem. However, to parse the line given based on your description, it would be much easier to use existing lexers define in Text.Parsec.Token1, and join them together.
The below code parses the line into a Line data type, you can process it further from there if necessary. Instead of attempting to filter out the - and integers before parsing, it uses a parseEntry parser that returns a Just Double if it is a Float value, Just 0 for *, and Nothing for integers and dashes. This is then very simply filtered using catMaybes.
Here is the code:
module Test where
import Text.Parsec
import qualified Text.Parsec.Token as P
import Text.Parsec.Language (haskellDef)
import Control.Applicative ((<$>))
import Data.Maybe (catMaybes)
lexer = P.makeTokenParser haskellDef
parseFloat = P.float lexer
parseInteger = P.natural lexer
whiteSpace = P.whiteSpace lexer
parseEntry = try (Just <$> parseFloat)
<|> try (const (Just 0) <$> (char '*' >> whiteSpace))
<|> try (const Nothing <$> (char '-' >> whiteSpace))
<|> (const Nothing <$> parseInteger)
data Line = Line {
lineNodeNum :: Integer
, negativeLogProbabilities :: [Double]
} deriving (Show)
parseLine = do
nodeNum <- parseInteger
whiteSpace
probabilities <- catMaybes <$> many1 parseEntry
return $ Line { lineNodeNum = nodeNum, negativeLogProbabilities = probabilities }
Example usage:
*Test> parseTest parseLine "4 0.123 1.452 0.667 * 3.460 149 - -"
Line {lineNodeNum = 4, negativeLogProbabilities = [0.123,1.452,0.667,0.0,3.46]}
The only issue that may (or may not) be a problem is it will parse *- as two different tokens, rather than fail at parsing. Eg
*Test> parseTest parseLine "4 0.123 1.452 0.667 * 3.460 149 - -*"
Line {lineNodeNum = 4, negativeLogProbabilities = [0.123,1.452,0.667,0.0,3.46,0.0]}
Note the extra 0.0 at the end of the log probabilities.
Related
If I have a parser than reads a string of numbers separated by spaces into a list of Ints, how do I handle a trailing space? At the moment I have:
row :: Parser [Int]
row = do
optional spaces
f <- (many (oneOf "0123456789"))
r <- ((char ' ') >> row) <|> pure []
pure (read f:r)
Which works fine with a string that does not have a trailing space but fails with a trailing space.
>λ= parse row "" " 2 0 12 3 7"
Right [2,0,12,3,7]
>λ= parse row "" " 2 0 12 3 7 "
Right [2,0,12,3,7,*** Exception: Prelude.read: no parse
What is the solution to this problem and more so, how would I have a condition where if '\n' is consumed then the parser returns []
EDIT:
From reading #amalloy's answer and the parsec source code, I thought it useful to add a version that works here (although, #amalloy's advice to not try and roll existing functions makes more sense)
row :: Parser [Int]
row = do
spaces
f <- (read <$> many1 digit)
do
many1 $ char ' '
r <- row
pure (f:r) <|> pure [x]
<|> pure []
Instead of implementing all this low-level stuff yourself, I suggest just using sepEndBy. For example,
row :: Parser [Int]
row = spaces *> (int `sepEndBy` many1 space)
where int = read <$> many1 digit
I am working on some programming exercises. The one I am working on has following input format:
Give xxxxxxxxx as yyyy.
xxxxxxxx can be in several formats that repeatedly show up during these exercises. In particular its either binary (groups of 8 separated by spaces), hexadecimal (without spaces) or octal (groups of up to 3 numbers). I have already written parsers for these formats - however they all stumble over the "as". They looked like this
binaryParser = BinaryQuestion <$> (count 8 ( oneOf "01") ) `sepBy1` space
I solved using this monstrosity (trimmed unnecessary code)
{-# LANGUAGE OverloadedStrings #-}
import Text.Parsec.ByteString
import Text.Parsec
import Text.Parsec.Char
import Data.ByteString.Char8 (pack, unpack, dropWhile, drop, snoc)
import qualified Data.ByteString as B
data Input = BinaryQuestion [String]
| HexQuestion [String]
| OctalQuestion [String]
deriving Show
data Question = Question {input :: Input, target :: Target} deriving Show
data Target = Word deriving Show
test1 :: B.ByteString
test1 = "Give 01110100 01110101 01110010 01110100 01101100 01100101 as a word."
test2 :: B.ByteString
test2 = "Give 646f63746f72 as a word."
test3 :: B.ByteString
test3 = "Give 164 151 155 145 as a word."
targetParser :: Parser Target
targetParser = string "word" >> return Word
wrapAs :: Parser a -> Parser [a]
wrapAs kind = manyTill kind (try (string " as"))
inputParser :: Parser Input
inputParser = choice [try binaryParser, try (space >> hexParser), try octParser]
binaryParser :: Parser Input
binaryParser = BinaryQuestion <$> wrapAs (space >> count 8 ( oneOf "01") )
hexParser :: Parser Input
hexParser = HexQuestion <$> wrapAs (count 2 hexDigit)
octParser :: Parser Input
octParser = OctalQuestion <$> wrapAs (many1 space >> many1 (oneOf ['0'..'7']))
questionParser :: Parser Question
questionParser = do
string "Give"
inp <- inputParser
string " a "
tar <- targetParser
char '.'
eof
return $ Question inp tar
I don't like that I need to use the following string "as" inside the parsing of Input, and they generally are less readable. I mean using regex it would be trivial to have a trailing string. So I am not satisfied with my solution.
Is there a way I can reuse the 'nice' parsers - or at least use more readable parsers?
additional notes
The code I along the lines I wish I could get working would look like this:
{-# LANGUAGE OverloadedStrings #-}
import Text.Parsec.ByteString
import Text.Parsec
import Text.Parsec.Char
import Data.ByteString.Char8 (pack, unpack, dropWhile, drop, snoc)
import qualified Data.ByteString as B
data Input = BinaryQuestion [String]
| HexQuestion [String]
| OctalQuestion [String]
deriving Show
data Question = Question {input :: Input, target :: Target} deriving Show
data Target = Word deriving Show
test1 :: B.ByteString
test1 = "Give 01110100 01110101 01110010 01110100 01101100 01100101 as a word."
test2 :: B.ByteString
test2 = "Give 646f63746f72 as a word."
test3 :: B.ByteString
test3 = "Give 164 151 155 145 as a word."
targetParser :: Parser Target
targetParser = string "word" >> return Word
inputParser :: Parser Input
inputParser = choice [try binaryParser, try hexParser, try octParser]
binaryParser :: Parser Input
binaryParser = BinaryQuestion <$> count 8 ( oneOf "01") `sepBy1` space
hexParser :: Parser Input
hexParser = HexQuestion <$> many1 (count 2 hexDigit)
octParser :: Parser Input
octParser = OctalQuestion <$> (many1 (oneOf ['0'..'7'])) `sepBy1` space
questionParser :: Parser Question
questionParser = do
string "Give"
many1 space
inp <- inputParser
many1 space
string "as a"
many1 space
tar <- targetParser
char '.'
eof
return $ Question inp tar
but parseTest questionParser test3 will return me parse error at (line 1, column 22):
unexpected "a"
I suppose the problem is that space is used as separator inside the input but also comes in the as a string. I don't see any function inside parsec that would fit. In frustration I tried adding try in various places - however no success.
You are working with the pattern: Give {source} as a {target}.
So you can pipe:
Parser for Give a
Parser for {source}
Parser for as a
Parser for {target}
No need to wrap the parser for {source} with the parser for as a.
EDIT:
As said in comment, the clean parser cannot be reused by Previouse solution stated at the end of this post.
It led to develop a small parser using Parsec to handle all the possible situations for end parsing of numeric string separated by space i.e.
end with a space followed by non-required-digit character, e.g. "..11 as"
end with a space, e.g. "..11 "
end with eof, e.g. "..11"
and such a parser as below:
numParser:: (Parser Char->Parser String)->[Char]->Parser [String]
numParser repeatParser digits =
let digitParser = repeatParser $ oneOf digits
endParser = (try $ lookAhead $ (space >> noneOf digits)) <|>
(try $ lookAhead $ (space <* eof)) <|>
(eof >> return ' ')
in do init <- digitParser
rest <- manyTill (space >> digitParser) endParser
return (init : rest)
And binaryParser and octParser need to be modified as below:
binaryParser = BinaryQuestion <$> numParser (count 8) "01"
octParser = OctalQuestion <$> numParser many1 ['0'..'7']
And Nothing need to change of questionParser stated in question, for reference, I state it again here:
questionParser = do
string "Give"
many1 space
inp <- inputParser
many1 space --no need change to many
string "as a"
many1 space
tar <- targetParser
char '.'
eof
return $ Question inp tar
Previous Solution:
The functions endBy1 and many in Text.Parsec are helpful in this situation.
To replace sepBy1 by endBy1 as
binaryParser = BinaryQuestion <$> count 8 ( oneOf "01") `endBy1` space
and
octParser = OctalQuestion <$> (many1 (oneOf ['0'..'7'])) `endBy1` space
Unlike sepBy1, endBy1 will read next some chars to determine whether end the parsing, and therefor, one space after the last digit will be consumed, i.e.
Give 164 151 155 145 as a word.
^ this space will be consumed
So, instead of checking one or many space before "as a...", it need check zero or many space, so why use many function instead of many1, now the code become:
...
inp <- inputParser
many space -- change to many
string "as a"
....
I'm a newbie to Haskell, and now I'm learning to use parsec. I get stuck in one problem, that is, I want to get all the sub-strings which satisfies some specific pattern in a string. For example, from the following string,
"I want to choose F12 or F 12 from F1(a), F2a, F5-A, F34-5 and so on,
but F alone should not be chosen, that is, choose those which start with F
followed by a digit (before the digit there could be zero or more than one space) and then by any character from ['a'..'z'] ++
['A'..'Z'] ++ ['0'..'9'] ++ ['(',')',"-"]."
the result should be [F12, F12, F1(a), F2a, F5-A, F34-5], where the space between the F and the digit should be deleted.
With the parsec, I have succeeded in getting one sub-string, such as F12, F2a. The code is as follows:
hao :: Parser Char
hao = oneOf "abcdefghijklmnopqrstuvwxyz1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ()-"
tuhao :: Parser String
tuhao = do { c <- char 'F'
; many space
; c1 <- digit
; cs <- many hao
; return (c:c1:cs)
}
parse tuhao "" str -- can parse the str and get one sub-string.
However, I am stuck at how to parse the example string above and get all the sub-strings of the specific pattern. I have an idea that if F is found, then begin parsing, else skip parsing or if parsing fails then skip parsing. But I don't know how to implement the plan. I have another idea that uses State to record the remaining string that is not parsed, and use recursion, but still fail to carry it out.
So I appreciate any tip! ^_^
F12, F 12, F1(a), F2a, F5-A, F34-5
This is an incomplete description, so I'll make some guesses.
I would start by defining a type that can contain the logical parts of these expressions. E.g.
newtype F = F (Int, Maybe String) deriving Show
That is, "F" followed by a number and an optional part that is either letters, parenthesised letters, or a dash followed by letters/digits. Since the number after "F" can have multiple digits, I assume that the optional letters/digits may be multiple, too.
Since the examples are limited, I assume that the following aren't valid: F1a(b), F1(a)b, F1a-5, F1(a)-A, F1a(a)-5, F1a1, F1-(a), etc. and that the following are valid: F1A, F1abc, F1(abc), F1-abc, F1-a1b2. This is probably not true. [1]
I would then proceed to write parsers for each of these sub-parts and compose them:
module Main where
import Text.Parsec
import Data.Maybe (catMaybes)
symbol :: String -> Parser String
symbol s = string s <* spaces
parens :: Parser a -> Parser a
parens = between (string "(") (string ")")
digits :: Parser Int
digits = read <$> many1 digit
parseF :: Parser F
parseF = curry F <$> firstPart <*> secondPart
where
firstPart :: Parser Int
firstPart = symbol "F" >> digits
secondPart :: Parser (Maybe String)
secondPart = optionMaybe $ choice
[ many1 letter
, parens (many1 letter)
, string "-" >> many1 alphaNum
]
(As Jon Purdy writes in a comment,) using this parser on a string to get multiple matches,
extract :: Parser a -> Parser [a]
extract p = do (:) <$> try p <*> extract p
<|> do anyChar >> extract p
<|> do eof >> return []
readFs :: String -> Either ParseError [F]
readFs s = parse (extract parseF) "" s
main :: IO ()
main = print (readFs "F12, F 12, F1(a), F2a, F5-A, F34-5")
This prints:
Right [F (12,Nothing),F (12,Nothing),F (1,Just "a"),F (2,Just "a"),F (5,Just "A"),F (34,Just "5")]
Takeaways:
You can parse optional whitespace using token parsing (symbol).
You can parse optional parts with option, optionMaybe or optional.
You can alternate between combinators using a <|> b <|> c or choice [a, b, c].
When alternating between choices, make sure they don't have overlapping FIRST sets. Otherwise you need to try; this is nasty but sometimes unavoidable. (In this case, FIRST sets for the three choices are letter, string "(" and string "-", i.e. not overlapping.)
[1]: For the sake of restriction, I kept to the assumptions above, but I felt that I could also have assumed that F1a-B, F1(a)-5 and F1(a)-5A are valid, in which case I might change the model to:
newtype F = F (Int, Maybe String, Maybe String)
We can get sub-strings of specific pattern in a string with the
findAll
combinator from
replace-megaparsec.
Notice that this tuhao parser doesn't actually return anything. The findAll combinator just checks for success of the parser to find sub-strings which match the pattern.
import Replace.Megaparsec
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Maybe
import Data.Either
let tuhao :: Parsec Void String ()
tuhao = do
void $ single 'F'
void $ space
void $ digitChar
void $ many $ oneOf "abcdefghijklmnopqrstuvwxyz1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ()-"
input = "I want to choose F12 or F 12 from F1(a), F2a, F5-A, F34-5 and so on, but F alone should not be chosen, that is, choose those which start with F followed by a digit (before the digit there could be zero or more than one space) and then by any character from ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['(',')',\"-\"]."
rights $ fromJust $ parseMaybe (findAll tuhao) input
["F12","F 12","F1(a)","F2a","F5-A","F34-5"]
I am trying to distinguish between Ints and floats in a parser. I have 2 parsers one for each int and float. However, I am having trouble getting into to fail on a '.'. I looked for negating and look ahead and didn't seem to get and fruits.
I hope I am not duplicating any questions.
I had it working with looking at the next character that is not a '.' but that is an ugly solution.
EDIT: Added more code.
--Int--------------------------------------------------------------------
findInt :: Parser String
findInt = plus <|> minus <|> number
number :: Parser String
number = many1 digit
plus :: Parser String
plus = char '+' *> number
minus :: Parser String
minus = char '-' <:> number
makeInt :: Parser Int
makeInt = prepareResult (findInt <* many (noneOf ".") <* endOfLine)
where readInt = read :: String -> Int
prepareResult = liftA readInt
makeInt2 :: Parser Int
makeInt2 = do
numberFound <- (findInt <* many (noneOf ".") <* endOfLine)
match <- char '.'
return (prepareResult numberFound)
where readInt = read :: String -> Int
prepareResult = readInt
--End Int----------------------------------------------------------------
I think you are best off actually combining the two parsers into one. Try something like this:
import Text.Parsec.String (Parser)
import Control.Applicative ((<|>))
import Text.Parsec.Char (char,digit)
import Text.Parsec.Combinator (many1,optionMaybe)
makeIntOrFloat :: Parser (Either Int Float)
makeIntOrFloat = do
sign <- optionMaybe (char '-' <|> char '+')
n <- many1 digit
m <- optionMaybe (char '.' *> many1 digit)
return $ case (m,sign) of
(Nothing, Just '-') -> Left (negate (read n))
(Nothing, _) -> Left (read n)
(Just m, Just '-') -> Right (negate (read n + read m / 10.0^(length m)))
(Just m, _) -> Right (read n + read m / 10.0^(length m))
ErikR has a correct solution, but the use of try means that parsec has to keep track of the possibility of backtracking (which is a bit inefficient) when in fact that is unnecessary in this case.
Here, the key difference is that we can actually tell right away if we have a float or not - if we don't have a float, the char '.' *> many1 digit parser in optionMaybe will fail immediately (without consuming input), so there is no need to consider backtracking.
At GHCi
ghci> import Text.Parsec.Prim
ghci> parseTest makeIntOrFloat "1234.012"
Right 1234.012
ghci> parseTest makeIntOrFloat "1234"
Left 1234
I would use notFollowedBy - e.g.:
import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Combinator
int :: Parser String
int = many1 digit <* notFollowedBy (char '.')
float :: Parser (String,String)
float = do whole <- many1 digit
fracpart <- try (char '.' *> many digit) <|> (return "")
return (whole, fracpart)
intOrFloat :: Parser (Either String (String,String))
intOrFloat = try (fmap Left int) <|> (fmap Right float)
test1 = parseTest (intOrFloat <* eof) "123"
test2 = parseTest (intOrFloat <* eof) "123.456"
test3 = parseTest (intOrFloat <* eof) "123."
It is typically easiest to use applicative combinators to build your parsers - this makes your parsers easier to reason about and often you do not need monadic and backtracking functions of the parser.
For example, a parser for integers could be written as such:
import Text.Parsec hiding ((<|>), optional)
import Text.Parsec.String
import Numeric.Natural
import Control.Applicative
import Data.Foldable
natural :: Parser Natural
natural = read <$> many1 digit
sign :: Num a => Parser (a -> a)
sign = asum [ id <$ char '+'
, negate <$ char '-'
, pure id
]
integer :: Parser Integer
integer = sign <*> (fromIntegral <$> natural)
A decimal number is an integer optionally followed by a decimal portion (a '.' followed by another integer), which is itself a number proper, so your parser can be written as
decimalPart :: Parser Double
decimalPart = read . ("0."++) <$> (char '.' *> many1 digit)
integerOrDecimal :: Parser (Either Integer Double)
integerOrDecimal = liftA2 cmb integer (optional decimalPart) where
cmb :: Integer -> Maybe Double -> Either Integer Double
cmb x Nothing = Left x
cmb x (Just d) = Right (fromIntegral x + d)
The definition of cmb is obvious - if the is no decimal part, then produce an Integer, and if there is, produce a Double, by adding the integer part to the decimal part.
You can also define a parser for decimals in terms of the above:
decimal :: Parser Double
decimal = either fromIntegral id <$> integerOrDecimal
Note that none of the above parsers directly use monadic functions (i.e. >>=) or backtracking - making them simple and efficient.
I took the example below partially from SO and changed it to my needs. It almost fits, but what I want to do is that always the first string in the commaSep expr is parsed as identifier whilst all subsequent strings should be strings only.
Currently they are all parsed as Identifiers.
*Parser> parse expr "" "rd (isFib, test2, 100.1, ?BOOL)"
Right (FuncCall "rd" [Identifier "isFib",Identifier "test2",Number 100.1,Query "?BOOL"])
I have tried a number of solutions that in the end all would break down to parsing the whole input without using commaSep. Means I would have to ignore the structure and do something like
expr_parse = do
name <- resvd_cmd
char '('
skipMany space
worker <- ident
char ','
skipMany1 space
args <- commaSep expr --not fully worked this out yet
query <- theQuery
skipMany space
char ')'
return (name, worker, args, query)
that looks less optimal and very clunky to me. Is there any way to refactor expr in the code below, achive what I need and keep it simple?
module Parser where
import Control.Monad (liftM)
import Text.Parsec
import Text.Parsec.String (Parser)
import Lexer
import AST
expr = ident <|> astring <|> number <|> theQuery <|> callOrIdent
astring = liftM String stringLiteral <?> "String"
number = liftM Number float <?> "Number"
ident = liftM Identifier identifier <?> "WorkerName"
questionm :: Parser Char
questionm = oneOf "?"
theQuery :: Parser AST
theQuery = do first <- questionm
rest <- many1 letter
let query = first:rest
return ( Query query )
resvd_cmd = do { reserved "rd"; return ("rd") }
<|> do { reserved "eval"; return ("eval") }
<|> do { reserved "read"; return ("read") }
<|> do { reserved "in"; return ("in") }
<|> do { reserved "out"; return ("out") }
<?> "LINDA-like Tuple"
callOrIdent = do
name <- resvd_cmd
liftM (FuncCall name)(parens $ commaSep expr) <|> return (Identifier name)
AST.hs
{-# LANGUAGE DeriveDataTypeable #-}
module AST where
import Data.Typeable
data AST
= Number Double
| Identifier String
| String String
| FuncCall String [AST]
| Query String
deriving (Show, Eq, Typeable)
Lexer.hs
module Lexer (
identifier, reserved, operator, reservedOp, charLiteral, stringLiteral,
natural, integer, float, naturalOrFloat, decimal, hexadecimal, octal,
symbol, lexeme, whiteSpace, parens, braces, angles, brackets, semi,
comma, colon, dot, semiSep, semiSep1, commaSep, commaSep1
)where
import Text.Parsec
import qualified Text.Parsec.Token as P
import Text.Parsec.Language (haskellStyle)
lexer = P.makeTokenParser ( haskellStyle
{P.reservedNames = ["rd", "in", "out", "eval", "take"]}
)
identifier = P.identifier lexer
reserved = P.reserved lexer
operator = P.operator lexer
reservedOp = P.reservedOp lexer
charLiteral = P.charLiteral lexer
stringLiteral = P.stringLiteral lexer
natural = P.natural lexer
integer = P.integer lexer
float = P.float lexer
naturalOrFloat = P.naturalOrFloat lexer
decimal = P.decimal lexer
hexadecimal = P.hexadecimal lexer
octal = P.octal lexer
symbol = P.symbol lexer
lexeme = P.lexeme lexer
whiteSpace = P.whiteSpace lexer
parens = P.parens lexer
braces = P.braces lexer
angles = P.angles lexer
brackets = P.brackets lexer
semi = P.semi lexer
comma = P.comma lexer
colon = P.colon lexer
dot = P.dot lexer
semiSep = P.semiSep lexer
semiSep1 = P.semiSep1 lexer
commaSep = P.commaSep lexer
commaSep1 = P.commaSep1 lexer
First, I'd like to introduce you to the function lexeme which alters a parser to eat trailing whitespace. You're encouraged to use it rather than explicitly eating the whitespace. The difficulty is with commaSep because it eats the , and then fails. It would be nice to write a less optimistic commaSep, but let's solve your problem directly.
Let's apply lexeme to comma
acomma = lexeme comma
One of the problems with your code was you were expecting it to see test2 as String "test2" but the astring parser expects its strings to begin and end with ". Let's make a parser for bald strings, but make sure they don't start with ? and don't contain spaces or commas:
baldString = lexeme $ do
x <- noneOf "? ,)"
xs <- many (noneOf " ,)") -- problematic - see comment below
return . String $ x:xs
The breakthrough came when I realised that because there has to be a query at the end, there was always a comma after a baldString:
baldStringComma = do
s <- baldString
acomma
return s
Now let's make a parser for one or more queries at the end of the tuple:
queries = commaSep1 (lexeme theQuery)
And now we can take the identifier, the baldStrings and the queries
therest = do
name <- lexeme ident
acomma
args <- many baldStringComma
qs <- queries
return (name,args,qs)
finally giving
tuple = do
name <- lexeme resvd_cmd
stuff <- parens therest
return (name,stuff)
So you get
*Parser> parseTest tuple "rd (isFib, test2, 100.1, ?BOOL)"
("rd",(Identifier "isFib",[String "test2",String "100.1"],[Query "?BOOL"]))
But if you want to lump the strings with the queries, you can return (name,args++qs) at the end of therest.
Applicative is Less Ugly
I found it frustrating to be tied to the Monad interface, when there are lovely things like <$>, <*> etc, so first
import Control.Applicative hiding (many, (<|>))
Then
baldString = lexeme . fmap String $
(:) <$> noneOf "? ,)"
<*> many (noneOf " ,)") -- problematic - see comment below
Here <$> is an infix version of fmap, so (:) will be applied to the output of noneOf "? ,", giving a parser that returns something like ('c':). This can then be applied to the output of many (noneOf " ,") using <*> to give the string we want.
baldStringComma = baldString <* acomma
This one's nice because we got the <*> operator to ignore the output of acomma and just return the output of baldString, using <*. If we wanted it the other way round, we could do *>, but you may as well use >> for that, which already ignores the output of the first parser.
therest = (,,) <$>
lexeme ident <* acomma
<*> many baldStringComma
<*> queries
and
tuple = (,) <$> lexeme resvd_cmd
<*> parens therest
But wouldn't it be nicer if we did
data Tuple = Tuple {cmd :: String,
id :: AST,
argumentList :: [AST],
queryList :: [AST]} deriving Show
so we could do
niceTuple = Tuple <$> lexeme resvd_cmd <* lexeme (char '(')
<*> lexeme ident <* acomma
<*> many baldStringComma
<*> queries <* lexeme (char ')')
which gives (with a little manual pretty-printing to get it into the width)
*Parser> parseTest niceTuple "rd (isFib, test2, 100.1, ?BOOL)"
Tuple {cmd = "rd",
id = Identifier "isFib",
argumentList = [String "test2",String "100.1"],
queryList = [Query "?BOOL"]}
I also think your current AST is more of an abstract syntax store than an abstract syntax tree, and that you might get more milage from designing your own Tuple type and use that. Use
newtype Command = Cmd String deriving Show
and suchlike to ensure type safety, then roll them together into your Tuple type with a parser to generate them.