I am writing a parser for a custom jupter kernel using megaparsec. I was able to re-use the parser to provide completions too: the custom error message generated from the megaparsec library are transformed to the list of expected symbols. It that way, whenever I change the parser, completion automatically adjust itself. Which is great.
The only thing I am struggling is how to get info from the optional parsers. The minimal example illustrating what I want to achieve is following:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import Data.Monoid
import Data.Text (Text)
import Data.Set (singleton)
type Parser = Parsec MyError Text
data MyError = ExpectKeyword Text deriving (Eq, Ord, Show)
lexeme = L.lexeme sc
sc = L.space (skipSome (oneOf [' ', '\t'])) empty empty
-- | Reserved words
rword :: Text -> Parser Text
rword w = region (fancyExpect (ExpectKeyword w)) $
lexeme (string w *> return w)
fancyExpect f e = FancyError (errorPos e) (singleton . ErrorCustom $ f)
p1 = rword "foo" <|> rword "bar"
p2 = (<>) <$> option "def" (rword "opt") <*> p1
main = do
putStrLn . show $ parse p1 "" ("xyz" :: Text) -- shows "foo" and "bar" in errors
putStrLn . show $ parse p2 "" ("xyz" :: Text) -- like above, no optional "opt"
In the first case, parser fails and I get the list of all errors from all alternatives. Ideally, in the second case I would like to see the error of the failed optional parser too.
This example can be simply solved by removing option and making two branches with <|>: one with option and the other without. However in real case the optional part is a permutation parser consisting of several optional parts, so such trick is not feasible.
Related
I am trying to get more familiar with megaparsec, and I am running into some issues with presedences. By 'nested data' in the title I refer to the fact that I am trying to parse types, which in turn could contain other types. If someone could explain why this does not behave as I would expect, please don't hesitate to tell me.
I am trying to parse types similar to those found in Haskell. Types are either base types Int, Bool, Float or type variables a (any lowercase word).
We can also construct algebraic data types from type constructors (Uppercase words) such as Maybe and type parameters (any other type). Examples are Maybe a and Either (Maybe Int) Bool. Functions associate to the right and are constructed with ->, such as Maybe a -> Either Int (b -> c). N-ary tuples are a sequence of types separated by , and enclosed in ( and ), such as (Int, Bool, a). A type can be wrapped in parenthesis to raise its precedence level (Maybe a). A unit type () is also defined.
I am using this ADT to describe this.
newtype Ident = Ident String
newtype UIdent = UIdent String
data Type a
= TLam a (Type a) (Type a)
| TVar a Ident
| TNil a
| TAdt a UIdent [Type a]
| TTup a [Type a]
| TBool a
| TInt a
| TFloat a
I have tried to write a megaparsec parser to parse such types, but I get unexpected results. I attach the relevant code below after which I will try to describe what I experience.
{-# LANGUAGE OverloadedStrings #-}
module Parser where
import AbsTinyCamiot
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Text.Megaparsec.Debug
import Control.Applicative hiding (many, some, Const)
import Control.Monad.Combinators.Expr
import Control.Monad.Identity
import Data.Void
import Data.Text (Text, unpack)
type Parser a = ParsecT Void Text Identity a
-- parse types
pBaseType :: Parser (Type ())
pBaseType = choice [
TInt () <$ label "parse int" (pSymbol "Int"),
TBool () <$ label "parse bool" (pSymbol "Bool"),
TFloat () <$ label "parse float" (pSymbol "Float"),
TNil () <$ label "parse void" (pSymbol "()"),
TVar () <$> label "parse type variable" pIdent]
pAdt :: Parser (Type ())
pAdt = label "parse ADT" $ do
con <- pUIdent
variables <- many $ try $ many spaceChar >> pType
return $ TAdt () con variables
pType :: Parser (Type ())
pType = label "parse a type" $
makeExprParser
(choice [ try pFunctionType
, try $ parens pType
, try pTupleType
, try pBaseType
, try pAdt
])
[]--[[InfixR (TLam () <$ pSymbol "->")]]
pTupleType :: Parser (Type ())
pTupleType = label "parse a tuple type" $ do
pSymbol "("
fst <- pType
rest <- some (pSymbol "," >> pType)
pSymbol ")"
return $ TTup () (fst : rest)
pFunctionType :: Parser (Type ())
pFunctionType = label "parse a function type" $ do
domain <- pType
some spaceChar
pSymbol "->"
some spaceChar
codomain <- pType
return $ TLam () domain codomain
parens :: Parser a -> Parser a
parens p = label "parse a type wrapped in parentheses" $ do
pSymbol "("
a <- p
pSymbol ")"
return a
pUIdent :: Parser UIdent
pUIdent = label "parse a UIdent" $ do
a <- upperChar
rest <- many $ choice [letterChar, digitChar, char '_']
return $ UIdent (a:rest)
pIdent :: Parser Ident
pIdent = label "parse an Ident" $ do
a <- lowerChar
rest <- many $ choice [letterChar, digitChar, char '_']
return $ Ident (a:rest)
pSymbol :: Text -> Parser Text
pSymbol = Lexer.symbol pSpace
pSpace :: Parser ()
pSpace = Lexer.space
(void spaceChar)
(Lexer.skipLineComment "--")
(Lexer.skipBlockComment "{-" "-}")
This might be overwhelming, so let me explain some key points. I understand that I have a lot of different constructions that could match on an opening parenthesis, so I've wrapped those parsers in try, such that if they fail I can try the next parser that might consume an opening parenthesis. Perhaps I am using try too much? Does it affect performance to potentially backtrack so much?
I've also tried to make an expression parser by defining some terms and an operator table. You can see now that I've commented out the operator (function arrow), however. As the code looks right now I loop infinitely when I try to parse a function type. I think this might be due to the fact that when I try to parse a function type (invoked from pType) I immediately try to parse a type representing the domain of the function, which again call pType. How would I do this correctly?
If I decide to use the operator table instead, and not use my custom parser for function types, I parse things using wrong precedences. E.g Maybe a -> b gets parsed as Maybe (a -> b), while I would want it to be parsed as (Maybe a) -> b. Is there a way where I could use the operator table and still have type constructors bind more tightly than the function arrow?
Lastly, as I am learning megaparsec as I go, if anyone sees any misunderstandings or things that are wierd/unexpected, please tell me. I've read most of this tutorial to get my this far.
Please let me know of any edits I can make to increase the quality of my question!
Your code does not handle precedences at all, and also as a result of this it uses looping left-recursion.
To give an example of left-recursion in your code, pFunctionType calls pType as the first action, which calls pFunctionType as the first action. This is clearly a loop.
For precedences, I recommend to look at tutorials on "recursive descent operator parsing", a quick Google search reveals that there are several of them. Nevertheless I can summarize here the key points. I write some code.
{-# language OverloadedStrings #-}
import Control.Monad.Identity
import Data.Text (Text)
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as Lexer
type Parser a = ParsecT Void Text Identity a
newtype Ident = Ident String deriving Show
newtype UIdent = UIdent String deriving Show
data Type
= TVar Ident
| TFun Type Type -- instead of "TLam"
| TAdt UIdent [Type]
| TTup [Type]
| TUnit -- instead of "TNil"
| TBool
| TInt
| TFloat
deriving Show
pSymbol :: Text -> Parser Text
pSymbol = Lexer.symbol pSpace
pChar :: Char -> Parser ()
pChar c = void (char c <* pSpace)
pSpace :: Parser ()
pSpace = Lexer.space
(void spaceChar)
(Lexer.skipLineComment "--")
(Lexer.skipBlockComment "{-" "-}")
keywords :: [String]
keywords = ["Bool", "Int", "Float"]
pUIdent :: Parser UIdent
pUIdent = try $ do
a <- upperChar
rest <- many $ choice [letterChar, digitChar, char '_']
pSpace
let x = a:rest
if elem x keywords
then fail "expected an ADT name"
else pure $ UIdent x
pIdent :: Parser Ident
pIdent = try $ do
a <- lowerChar
rest <- many $ choice [letterChar, digitChar, char '_']
pSpace
return $ Ident (a:rest)
Let's stop here.
I changed the names of constructors in Type to conform to how they are called in Haskell. I also removed the parameter on Type, to have less noise in my example, but you can add it back of course.
Note the changed pUIdent and the addition of keywords. In general, if you want to parse identifiers, you have to disambiguate them from keywords. In this case, Int could parse both as Int and as an upper case identifier, so we have to specify that Int is not an identifier.
Continuing:
pClosed :: Parser Type
pClosed =
(TInt <$ pSymbol "Int")
<|> (TBool <$ pSymbol "Bool")
<|> (TFloat <$ pSymbol "Float")
<|> (TVar <$> pIdent)
<|> (do pChar '('
ts <- sepBy1 pFun (pChar ',') <* pChar ')'
case ts of
[] -> pure TUnit
[t] -> pure t
_ -> pure (TTup ts))
pApp :: Parser Type
pApp = (TAdt <$> pUIdent <*> many pClosed)
<|> pClosed
pFun :: Parser Type
pFun = foldr1 TFun <$> sepBy1 pApp (pSymbol "->")
pExpr :: Parser Type
pExpr = pSpace *> pFun <* eof
We have to group operators according to binding strength. For each strength, we need to have a separate parsing function which parses all operators of that strength. In this case we have pFun, pApp and pClosed in increasing order of binding strength. pExpr is just a wrapper which handles top-level expressions, and takes care of leading whitespace and matches the end of the input.
When writing an operator parser, the first thing we should pin down is the group of closed expressions. Closed expressions are delimited by a keyword or symbol both on the left and the right. This is conceptually "infinite" binding strength, since text before and after such expressions don't change their parsing at all.
Keywords and variables are clearly closed, since they consist of a single token. We also have three more closed cases: the unit type, tuples and parenthesized expressions. Since all of these start with a (, I factor this out. After that, we have one or more types separated by , and we have to branch on the number of parsed types.
The rule in precedence parsing is that when parsing an operator expression of given strength, we always call the next stronger expression parser when reading the expressions between operator symbols.
, is the weakest operator, so we call the function for the second weakest operator, pFun.
pFun in turn calls pApp, which reads ADT applications, or falls back to pClosed. In pFun you can also see the handling of right associativity, as we use foldr1 TFun to combine expressions. In a left-associative infix operator, we would instead use foldl1.
Note that parser functions always parse all stronger expressions as well. So pFun falls back on pApp when there is no -> (because sepBy1 accepts the case with no separators), and pApp falls back on pClosed when there's no ADT application.
I'm a Haskell beginner, using Attoparsec to find some color expressions in a text. I want to be able to match, for example, "light blue-green" and "light blue green" in a text. But of course I need a generalized solution for any string like that. So I've been thinking that it would be something like
"light" >> sep >> "blue" >> sep >> "green"
where sep = inClass "\n\r- "
In other words, I think I need a way to intercalate >> sep >> to a list of words. Something like:
import qualified Data.Text as T
import Data.Attoparsec.Text
-- | Makes a parser from a list of words, accepting
-- spaces, newlines, and hyphens as separators.
wordListParser :: [T.Text] -> Parser
wordListParser wordList = -- Some magic here
Or maybe I'm thinking about this the wrong way entirely, and there's an easier way?
Edit: this minimal non-working example feels like it's almost there:
{-# LANGUAGE OverloadedStrings #-}
import Replace.Attoparsec.Text
import Data.Attoparsec.Text as AT
import qualified Data.Text as T
import Control.Applicative (empty)
wordListParser :: [T.Text] -> Parser T.Text
wordListParser (w:ws) = string w >> satisfy (inClass " -") >> wordListParser ws
wordListParser [w] = string w
wordListParser [] = empty -- or whatever the empty parser is
main :: IO ()
main = parseTest (wordListParser (T.words "light green blue")) "light green-blue"
which I think can be run with something like
stack runhaskell ThisFile.hs --package attoparsec replace-attoparsec text
Here is what I would do, assuming that you have a data type for your colours; if you don't, just substitute it for what you're using. The function parseColourGen takes any Text that is space-separated, and generates a parser that accepts a colour where each word is separated by one or more legal separators.
import Prelude hiding (concat, words)
import Control.Applicative ((<|>))
import Data.Attoparsec.Text
import Data.List (intersperse)
import Data.Text (concat, pack, singleton, Text, words)
data Colour = LightBlue | DarkBlue | VibrantRed deriving Show
parseColourGen :: Text -> Parser [Text]
parseColourGen = sequence . intersperse (mempty <$ many1 legalSep) .
fmap string . words
parseColour :: [(Text, Colour)] -> Parser Colour
parseColour = foldl1 (<|>) . fmap (\(text, colour) ->
colour <$ parseColourGen text)
legalSep :: Parser Text
legalSep = singleton <$> satisfy (inClass "\n\r- ")
You can then feed your wordList to the parser; however, it needs to be an association list:
wordList :: [(Text, Colour)]
wordList = [("light blue", LightBlue), ("dark blue", DarkBlue), ("vibrant red", VibrantRed)]
This way, you can configure all of your colours and their corresponding colour names in one place, and you can then run the parser like so:
> parse (parseColour wordList) $ pack "vibrant-red"
Done "" VibrantRed
EDIT
After the edit in your question, I think I understand what you want a little bit better. FWIW, I would still prefer the solution above, but here is how to fix your last block of code:
As the compiler should tell you, patterns (w:ws) and [w] overlap, so if you want the runtime to catch the single-element pattern, you have to place it on top.
a >> b means "run action a, discard its result, then run action b and use that result". Which is why your parser (with the fix above) will output Done "" "blue". A simple way to fix this is to use do notation to bind the result of all three computations, and return their concatenation.
Here is what your code now looks like:
wordListParser :: [Text] -> Parser Text
wordListParser [w] = string w
wordListParser (w:ws) = do
a <- string w
b <- satisfy (inClass " -")
c <- wordListParser ws
return (a `append` (singleton b) `append` c) -- singleton :: Char -> Text
wordListParser [] = empty
One last thing: your current implementation will not parse Windows line breaks (\n\r). I don't know if you dropped \n and \r from your separator characters, but if you haven't and Windows files are a possibility for you, it's something to keep in mind.
I’m not familiar with attoparsec, but you could possibly use a recursive solution:
wordListParser :: [T.Text] -> Parser
wordListParser [] = empty
wordListParser [w] = text w
wordListParser (w:ws) = text w >> inClass "\n\r- " >> wordListParser ws
I am fairly new to Haskell and I'm just starting to learn how to work with attoparsec for parsing huge chunks of english text from a .txt file. I know how to get the number of words in a .txt file without using attoparsec, but I'm kinda stuck with attoparsec. When I run my code below, on let's say
"Hello World, I am Elliot Anderson. \nAnd I'm Mr.Robot.\n"
I only get back:
World, I am Elliot Anderson. \nAnd I'm Mr.Robot.\n" (Prose {word =
"Hello"})
This is my current code:
{-# LANGUAGE OverloadedStrings #-}
import Control.Exception (catch, SomeException)
import System.Environment (getArgs)
import Data.Attoparsec.Text
import qualified Data.Text.IO as Txt
import Data.Char
import Control.Applicative ((<*>), (*>), (<$>), (<|>), pure)
{-
This is how I would usually get the length of the list of words in a .txt file normally.
countWords :: String -> Int
countWords input = sum $ map (length.words) (lines input)
-}
data Prose = Prose {
word :: String
} deriving Show
prose :: Parser Prose
prose = do
word <- many' $ letter
return $ Prose word
main :: IO()
main = do
input <- Txt.readFile "small.txt"
print $ parse prose input
Also how can I get the integer count of words, later on? Furthermore any suggestions on how to get started with attoparsec?
You have a pretty good start already - you can parse a word.
What you need next is a Parser [Prose], which can be expressed by combining your prose parser with another one which consumes the "not prose" parts, using sepBy or sepBy1, which you can look up in the Data.Attoparsec.Text documentation.
From there, the easiest way to get the word count would be to simply get the length of your obtained [Prose].
EDIT:
Here is a minimal working example. The Parser runner has been swapped for parseOnly to allow for residual input to be ignored, meaning that a trailing non-word won't make the parser go cray-cray.
{-# LANGUAGE OverloadedStrings #-}
module Atto where
--import qualified Data.Text.IO as Txt
import Data.Attoparsec.Text
import Control.Applicative ((*>), (<$>), (<|>), pure)
import qualified Data.Text as T
data Prose = Prose {
word :: String
} deriving Show
optional :: Parser a -> Parser ()
optional p = option () (try p *> pure ())
-- Modified to disallow empty words, switched to applicative style
prose :: Parser Prose
prose = Prose <$> many1' letter
separator :: Parser ()
separator = many1 (space <|> satisfy (inClass ",.'")) >> pure ()
wordParser :: String -> [Prose]
wordParser str = case parseOnly wp (T.pack str) of
Left err -> error err
Right x -> x
where
wp = optional separator *> prose `sepBy1` separator
main :: IO ()
main = do
let input = "Hello World, I am Elliot Anderson. \nAnd I'm Mr.Robot.\n"
let words = wordParser input
print words
print $ length words
The provided parser does not give the exact same result as concatMap words . lines since it also breaks words on .,'. Modifying this behaviour is left as a simple exercise.
Hope it helps! :)
You're on the right track! You've written a parser (prose) which reads a single word: many' letter recognises a sequence of letters.
So now that you've figured out how to parse a single word, your job is to scale this up to parse a sequence of words separated by spaces. That's what sepBy does: p `sepBy` q runs the p parser repeatedly with the q parser interspersed.
So a parser for a sequence of words looks something like this (I've taken the liberty of renaming your prose to word):
word = many letter
phrase = word `sepBy` some space -- "some" runs a parser one-or-more times
ghci> parseOnly phrase "wibble wobble wubble" -- with -XOverloadedStrings
Right ["wibble","wobble","wubble"]
Now, phrase, being composed out of letter and space, will die on non-letter non-space characters such as ' and .. I'll leave it to you to figure out how to fix that. (As a hint, you'll probably need to change many letter to many (letter <|> ...), depending on how exactly you want it to behave on the various punctuation marks.)
I'm currently writing my simple programming language parser in Haskell with megaparsec library.
I found this megaparsec tutorial, and I wrote following parser code:
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void String
lexeme :: Parser a -> Parser a
lexeme = L.lexeme space
rws :: [String] -- list of reserved words
rws = ["if", "then"]
identifier :: Parser String
identifier = (lexeme . try) (p >>= check)
where
p = (:) <$> letterChar <*> many alphaNumChar
check x =
if x `elem` rws
then fail $ "keyword " ++ show x ++ " cannot be an identifier"
else return x
A simple identifier parser with reserved name error handling. It successfully parses valid identifier such as foo, bar123.
But when an invalid input(a.k.a. reserved name) goes in to the parser, it outputs error:
>> parseTest identifier "if"
1:3:
keyword "if" cannot be an identifier
which, error message is alright, but error location(1:3:) is a bit different from what I expected. I expected error location to be 1:1:.
In the following part of definition of identifier,
identifier = (lexeme . try) (p >>= check)
I expected try would behave like there was no input consumed if (p >>= check) fails and go back to source location 1:1:.
Is my expectation wrong? How can I get this code work as I intended?
I have written a following parsing code using attoparsec:
data Test = Test {
a :: Int,
b :: Int
} deriving (Show)
testParser :: Parser Test
testParser = do
a <- decimal
tab
b <- decimal
return $ Test a b
tParser :: Parser [Test]
tParser = many' $ testParser <* endOfLine
This works fine for small sized files, I execute it like this:
main :: IO ()
main = do
text <- TL.readFile "./testFile"
let (Right a) = parseOnly (manyTill anyChar endOfLine *> tParser) text
print a
But when the size of the file is greater than 70MB, it consumes tons of memory. As a solution, I thought I would use attoparsec-conduit. After going through their API, I'm not sure how to make them work together. My parser has the type Parser Test but it's sinkParser actually accepts parser of type Parser a b. I'm interested in how to execute this parser in constant memory ? (A pipes based solution is also acceptable, but I'm not used to the Pipes API.)
The first type parameter to Parser is just the data type of the input (either Text or ByteString). You can provide your testParser function as the argument to sinkParser and it will work fine. Here's a short example:
{-# LANGUAGE OverloadedStrings #-}
import Conduit (liftIO, mapM_C, runResourceT,
sourceFile, ($$), (=$))
import Data.Attoparsec.Text (Parser, decimal, endOfLine, space)
import Data.Conduit.Attoparsec (conduitParser)
data Test = Test {
a :: Int,
b :: Int
} deriving (Show)
testParser :: Parser Test
testParser = do
a <- decimal
space
b <- decimal
endOfLine
return $ Test a b
main :: IO ()
main = runResourceT
$ sourceFile "foo.txt"
$$ conduitParser testParser
=$ mapM_C (liftIO . print)
Here is the pipes solution (assuming that you are using a Text-based parser):
import Pipes
import Pipes.Text.IO (fromHandle)
import Pipes.Attoparsec (parsed)
import qualified System.IO as IO
main = IO.withFile "./testfile" IO.ReadMode $ \handle -> runEffect $
for (parsed (testParser <* endOfLine) (fromHandle handle)) (lift . print)