Assume there is a data structure representing a text with comments inside.
data TWC
= T Text TWC -- text
| C Text TWC -- comment
| E -- end
deriving Show
Thus string like
"Text, {-comment-}, and something else"
could be encoded as
T "Text, " (C "comment" (T ", and something else" E))
Parsers for comment chunk and for E are pretty trivial:
twcP :: Parser TWC
twcP = eP <|> cP <|> tP
cP :: Parser TWC
cP = do
_ <- string "{-"
c <- manyTill anyChar (string "-}")
rest <- cP <|> tP <|> eP
return (C (pack c) rest)
eP :: Parser TWC
eP = do
endOfInput
return E
Implementing parser for text chunk in such a trivial way
tP :: Parser TWC
tP = do
t <- many1 anyChar
rest <- cP <|> eP
return (T (pack t) rest)
make it consume comments section as a text because of its greedy nature
> parseOnly twcP "text{-comment-}"
Right (T "text{-comment-}" E)
it ∷ Either String TWC
So, the question is how to express the logic of parsing until end of input or until comment section? In other words, how to implement conditional lookahead parser?
You're right, the problematic code is the first line of of tP, which parses text greedily without stopping at comments:
tP = do
t <- many1 anyChar
Before addressing that, I first want to refactor your code a little to introduce helpers and use applicative style, with the problematic code isolated into the text helper:
-- Like manyTill, but pack the result to Text.
textTill :: Alternative f => f Char -> f b -> f Text
textTill p end = pack <$> manyTill p end
-- Parse one comment string
comment :: Parser Text
comment = string "{-" *> textTill anyChar (string "-}")
-- Parse one non-comment text string (problematic implementation)
text :: Parser Text
text = pack <$> many1 anyChar
-- TWC parsers:
twcP :: Parser TWC
twcP = eP <|> cP <|> tP
cP :: Parser TWC
cP = C <$> comment <*> twcP
eP :: Parser TWC
eP = E <$ endOfInput
tP :: Parser TWC
tP = T <$> text <*> twcP
To implement lookahead, we can use the lookAhead combinator, which applies a parser without consuming the input. That allows us to make text parse until it reaches either a comment (without consuming it), or endOfInput:
-- Parse one non-comment text string (working implementation)
text :: Parser Text
text = textTill anyChar (void (lookAhead comment) <|> endOfInput)
With that implementation, twcP behaves as expected:
ghci> parseOnly twcP "text{-comment-} post"
Right (T "text" (C "comment" (T " post" E)))
Related
I was reading this Monadic Parsing article while I was trying to implement a pretty simple string parser in Haskell and also get a better understanding of using monads. Down below you can see my code, implementing functions for matching a single character or a whole string. It works as expected, but I observed two strange behaviors that I can't explain.
I have to handle single characters in string, otherwise, the parser will return only empty lists. To be exact, if I remove this line string [c] = do char c; return [c] it won't work anymore. I was expecting that string (c:s) would handle string (c:[]) properly. What could be the cause here?
In my opinion, string definition should be equivalent to string s = mapM char s as it would create a list of [Parser Char] for each character in s and collect the results as Parser [Char]. If I use the definition based on mapM, the program would get stuck in an infinite loop and won't print anything. Is something about lazy evalutation that I miss here?
.
module Main where
newtype Parser a = Parser { apply :: String->[(a, String)] }
instance Monad Parser where
return a = Parser $ \s -> [(a, s)]
ma >>= k = Parser $ \s -> concat [apply (k a) s' | (a, s') <- apply ma s]
instance Applicative Parser where
pure = return
mf <*> ma = do { f <- mf; f <$> ma; }
instance Functor Parser where
fmap f ma = f <$> ma
empty :: Parser a
empty = Parser $ const []
anychar :: Parser Char
anychar = Parser f where
f [] = []
f (c:s) = [(c, s)]
satisfy :: (Char -> Bool) -> Parser Char
satisfy prop = do
c <- anychar
if prop c then return c
else empty
char :: Char -> Parser Char
char c = satisfy (== c)
string :: String -> Parser String
string [] = empty
string [c] = do char c; return [c] --- if I remove this line, all results will be []
string (c:s) = do char c; string s; return (c:s)
main = do
let s = "12345"
print $ apply (string "123") s
print $ apply (string "12") s
print $ apply (string "1") s
print $ apply (string []) s
PS. I think the title of the question is not suggestive enough, please propose an edit if you have a better idea.
Since you did string [] = empty instead of string [] = return [], you can't use it as a base case for recursion that builds up a list.
fmap f ma = f <$> ma is wrong, since <$> is defined in terms of fmap. If you want to define fmap in terms of your other instances, then do fmap = liftA or fmap = liftM. Since mapM uses fmap internally but your original string didn't, this problem didn't come up in your first simple test.
string [] = empty
means: "If you need to parse an empty string, fail -- it can not be parsed at all, no matter what's the input string".
By comparison,
string [] = return ""
means: "If you need to parse an empty string, succeed and return the empty string -- it can always be parsed, no matter what's the input string".
By using the first equation, when you recurse in the case string (c:cs) you need to stop at one character (string [c]) since reaching zero characters will run empty and make the whole parser fail.
Hence, you need to either use that string [c] = return [c] equation, or modify the base "empty string" case so that it succeeds. Arguably, the latter would be more natural.
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 have actually asked this question before (here) but it turns out that the solution provided did not handle all test cases. Also, I need 'Text' parser rather than 'String', so I need parsec3.
Ok, the parser should allow for EVERY type of char inbetween quotes, even quotes. The end of the quoted text is marked by a ' character, followed by |, a space or end of input.
So,
'aa''''|
should return a string
aa'''
This is what I have:
import Text.Parsec
import Text.Parsec.Text
quotedLabel :: Parser Text
quotedLabel = do -- reads the first quote.
spaces
string "'"
lab <- liftM pack $ endBy1 anyChar endOfQuote
return lab
endOfQuote = do
string "'"
try(eof) <|> try( oneOf "| ")
Now, the problem here is of course that eof has a different type than oneOf "| ", so compilation falls.
How do I fix this? Is there a better way to achieve what I am trying to do?
Whitespace
First a comment on handling white space...
Generally the practice is to write your parsers so that they
consume the whitespace following a token
or syntactic unit. It's common to define combinator like:
lexeme p = p <* spaces
to easily convert a parser p to one that discards the whitespace
following whatever p parses. E.g., if you have
number = many1 digit
simply use lexeme number whenever you want to eat up the
whitespace following the number.
For more on this approach to handling whitespace and other advice
on parsing languages, see this Megaparsec tutorial.
Label expressions
Based on your previous SO question it appears you want
to parse expressions of the form:
label1 | label2 | ... | labeln
where each label may be a simple label or a quoted label.
The idiomatic way to parse this pattern is to use sepBy like this:
labels :: Parser String
labels = sepBy1 (try quotedLabel <|> simpleLabel) (char '|')
We define both simpleLabel and quotedLabel in terms of
what characters may occur in them. For simpleLabel a valid
character is a non-| and non-space:
simpleLabel :: Parser String
simpleLabel = many (noneOf "| ")
A quotedLabel is a single quote followed by a run
of valid quotedLabel-characters followed by an ending
single quote:
sq = char '\''
quotedLabel :: Parser String
quotedLabel = do
char sq
chs <- many validChar
char sq
return chs
A validChar is either a non-single quote or a single
quote not followed by eof or a vertical bar:
validChar = noneOf [sq] <|> try validQuote
validQuote = do
char sq
notFollowedBy eof
notFollowedBy (char '|')
return sq
The first notFollowedBy will fail if the single quote appears just
before the end of input. The second notFollowedBy will fail if
next character is a vertical bar. Therefore the sequence of the two
will succeed only if there is a non-vertical bar character following
the single quote. In this case the single quote should be interpreted
as part of the string and not the terminating single quote.
Unfortunately this doesn't quite work because the
current implementation of notFollowedBy
will always succeed with a parser which does not consume any
input -- i.e. like eof. (See this issue for more details.)
To work around this problem we can use this alternate
implementation:
notFollowedBy' :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()
notFollowedBy' p = try $ join $
do {a <- try p; return (unexpected (show a));}
<|> return (return ())
Here is the complete solution with some tests. By adding a few lexeme
calls you can make this parser eat up any white space where you decide
it is not significant.
import Text.Parsec hiding (labels)
import Text.Parsec.String
import Control.Monad
notFollowedBy' :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()
notFollowedBy' p = try $ join $
do {a <- try p; return (unexpected (show a));}
<|> return (return ())
sq = '\''
validChar = do
noneOf "'" <|> try validQuote
validQuote = do
char sq
notFollowedBy' eof
notFollowedBy (char '|')
return sq
quotedLabel :: Parser String
quotedLabel = do
char sq
str <- many validChar
char sq
return str
plainLabel :: Parser String
plainLabel = many (noneOf "| ")
labels :: Parser [String]
labels = sepBy1 (try quotedLabel <|> try plainLabel) (char '|')
test input expected = do
case parse (labels <* eof) "" input of
Left e -> putStrLn $ "error: " ++ show e
Right v -> if v == expected
then putStrLn $ "OK - got: " ++ show v
else putStrLn $ "NOT OK - got: " ++ show v ++ " expected: " ++ show expected
test1 = test "a|b|c" ["a","b","c"]
test2 = test "a|'b b'|c" ["a", "b b", "c"]
test3 = test "'abc''|def" ["abc'", "def" ]
test4 = test "'abc'" ["abc"]
test5 = test "x|'abc'" ["x","abc"]
To change the result of any functor computation you can just use:
fmap (const x) functor_comp
e.g.:
getLine :: IO String
fmap (const ()) getLine :: IO ()
eof :: Parser ()
oneOf "| " :: Parser Char
fmap (const ()) (oneOf "| ") :: Parser ()
Another option is to use operators from Control.Applicative:
getLine *> return 3 :: IO Integer
This performs getLine, discards the result and returns 3.
In your case, you might use:
try(eof) <|> try( oneOf "| " *> return ())
I'm trying to write a parser for a JSON String.
A valid example, per my parser, would be: "\"foobar\"" or "\"foo\"bar\"".
Here's what I attempted, but it does not terminate:
parseEscapedQuotes :: Parser String
parseEscapedQuotes = Parser f
where
f ('"':xs) = Just ("\"", xs)
f _ = Nothing
parseStringJValue :: Parser JValue
parseStringJValue = (\x -> S (concat x)) <$>
((char '"') *>
(zeroOrMore (alt parseEscapedQuotes (oneOrMore (notChar '"'))))
<* (char '"'))
My reasoning is that, I can have a repetition of either escaped quotes "\"" or characters not equal to ".
But it's not working as I expected:
ghci> runParser parseStringJValue "\"foobar\""
Nothing
I don't know what parser combinator library you are using, but here is a working example using Parsec. I'm using monadic style to make it clearer what's going on, but it is easily translated to applicative style.
import Text.Parsec
import Text.Parsec.String
jchar :: Parser Char
jchar = escaped <|> anyChar
escaped :: Parser Char
escaped = do
char '\\'
c <- oneOf ['"', '\\', 'r', 't' ] -- etc.
return $ case c of
'r' -> '\r'
't' -> '\t'
_ -> c
jstringLiteral :: Parser String
jstringLiteral = do
char '"'
cs <- manyTill jchar (char '"')
return cs
test1 = parse jstringLiteral "" "\"This is a test\""
test2 = parse jstringLiteral "" "\"This is an embedded quote: \\\" after quote\""
test3 = parse jstringLiteral "" "\"Embedded return: \\r\""
Note the extra level of backslashes needed to represent parser input as Haskell string literals. Reading the input from a file would make creating the parser input more convenient.
The definition of the manyTill combinator is:
manyTill p end = scan
where
scan = do{ end; return [] }
<|>
do{ x <- p; xs <- scan; return (x:xs) }
and this might help you figure out why your definitions aren't working.
My use of Text.Parsec is a little rusty. If I just want to return the matched string is this idiomatic?
category :: Stream s m Char => ParsecT s u m [Char]
category = concat <$> (many1 $ (:) <$> char '/' <*> (many1 $ noneOf "/\n"))
I feel like there might be an existing operator for liftM concat . many1 or (:) <$> p1 <*> p2 that I'm ignoring, but I'm not sure.
That's fine, I think. A little judicious naming would make it prettier:
category = concat <$> many1 segment
where
segment = (:) <$> char '/' <*> many1 (noneOf "/\n")
I think it would be slightly more idiomatic use of Parsec to return something more structured, for example, the list of strings:
catList :: Parser [String]
catList = char '/' *> many1 alphaNum `sepBy1` char '/'
I don't think there's a combinator like the one you were wondering there was, but this is Haskell, and roll-your-own-control-structure-or-combinator is always available:
concatMany1 :: Parser [a] -> Parser [a]
concatMany1 p = concat <$> many1 p
catConcat = concatMany1 $ (:) <$> char '/' <*> many1 alphaNum
But this next combinator is even nicer, and definitely idiomatic Haskell at least:
infixr 5 <:>
(<:>) :: Applicative f => f a -> f [a] -> f [a]
hd <:> tl = (:) <$> hd <*> tl
So now we can write
catCons :: Parser String
catCons = concatMany1 (char '/' <:> many1 alphaNum)
but incidentally also
contrivedExample :: IO String
contrivedExample = getChar <:> getLine
moreContrived :: String -> Maybe String
moreContrived name = find isLetter name <:> lookup name symbolTable
noneOf
You'll notice I've used alphaNum where you used noneOf "/\n". I think noneOf is not good practice; parsers should be really careful to accept onlt the right thing. Are you absolutely sure you want your parser to accept /qwerty/12345/!"£$%^&*()#:?><.,#{}[] \/ "/" /-=_+~? Should it really be happy with /usr\local\bin?
As it stands, your parser accepts any string as long as it starts with / and ends before \n with something that's not /. I think you should rewrite it with alphaNum <|> oneOf "_-.',~+" or similar instead of using noneOf. Using noneOf allows you to avoid thinking about what you should allow and focus on getting positive examples to parse instead of only positive examples to parse.
Parser
I've also always gone for Parser a instead of Stream s m t => ParsecT s u m a. That's just lazy typing, but let's pretend I did it to make it clearer what my code was doing, shall we? :) Use what type signature suits you, of course.