From Text.Parsec.Token:
lexeme p = do { x <- p; whiteSpace; return x }
It appears that lexeme takes a parser p and delivers a parser that has the same behavior as p, except that it also skips all the trailing whitespace. Correct?
Then how come the following does not work:
constant :: Parser Int
constant = do
digits <- many1 digit
return (read digits)
lexConst :: Parser Int
lexConst = lexeme constant
The last line results in the following error message:
Couldn't match expected type `ParsecT
String () Data.Functor.Identity.Identity Int'
with actual type `ParsecT s0 u0 m0 a0 -> ParsecT s0 u0 m0 a0'
Expected type: Parser Int
Actual type: ParsecT s0 u0 m0 a0 -> ParsecT s0 u0 m0 a0
In the return type of a call of `lexeme'
In the expression: lexeme constant
What am I doing wrong?
You misunderstood the documentation, the lexeme exported from Text.Parsec.Token is a field of a GenTokenParser s u m, so the type is
lexeme :: GenTokenParser s u m -> ParsecT s u m a -> ParsecT s u m a
and you haven't supplied the GenTokenParser argument in lexeme constant.
You need to create a GenTokenParser from a GenLanguageDef (typically with makeTokenParser) first to use its lexeme field.
The lexeme function is an accessor into a GenTokenParser record of parsers generated by makeTokenParser, so you need to apply it to such a record to get at it. One common way of doing this is to use record wildcards, e.g.
{-# LANGUAGE RecordWildCards #-}
import qualified Text.Parsec.Token as Tok
Tok.TokenParser { .. } = Tok.makeTokenParser {- language definition -}
This will bring lexeme and all the other parsers into scope already applied to the record, so you can use it like you were trying to do.
Related
Is it possible to infer the type from many1?
MWE
module Main where
import System.Environment (getArgs)
import Text.ParserCombinators.Parsec
import Data.Either (rights)
type Vertex vertexWeight = (String, vertexWeight)
parseVertex :: Parser (Vertex a)
parseVertex = do
name <- many1 (noneOf "/")
char '/'
weight <- many1 (noneOf "\n")
return $ (name, weight)
main :: IO ()
main = do
putStrLn $ rights $ [parse parseVertex "test" "a/2"]
In the above example, I'd like for the weight parameter to get outputted as an Int, but this does not type-check.
Would it be wiser to represent a vertex as (String, String) and define parsers for the weight?
The type Parser (Vertex a) is shorthand for forall a. Parser (Vertex a), i.e. its type states that for any choice of a, it can have type Parser (Vertex a). This is clearly not what you want: you want to say that parseVertex will always have type Parser (Vertex a) for some choice of a, but this choice is to be made by parseVertex, not at its call site.
What you should do, is use a type T such that Parser (Vertex T) covers all possible return values of parseVertex. For example, if you use Parser (Vertex (Either Int String)), then parseVertex can choose based on the parse results so far if it will return something of the form (s, Left x), or (s, Right t), where s :: String, x :: Int and t :: String.
Of course, that also means that consumers of parseVector now have to be able to handle both cases.
I'm trying to write code that will prompt the user to enter a Float and will continue to do so until a valid float is entered.
I've tried the following approach:
getFloat :: Float
getFloat = do
input <- getLine
case (readMaybe input :: Maybe Float) of Just f -> f
Nothing -> do getFloat
But I'm getting the following error:
Main.hs:41:5:
Couldn't match type `IO b0' with `Float'
Expected type: IO String -> (String -> IO b0) -> Float
Actual type: IO String -> (String -> IO b0) -> IO b0
In a stmt of a 'do' block: input <- getLine
In the expression:
do { input <- getLine;
case (readMaybe input :: Maybe Float) of {
Just f -> f
Nothing -> do { ... } } }
In an equation for `getFloat':
getFloat
= do { input <- getLine;
case (readMaybe input :: Maybe Float) of {
Just f -> f
Nothing -> ... } }
Main.hs:42:56:
Couldn't match expected type `IO b0' with actual type `Float'
In the expression: f
In a case alternative: Just f -> f
Main.hs:43:60:
Couldn't match expected type `IO b0' with actual type `Float'
In a stmt of a 'do' block: getFloat
In the expression: do { getFloat }
I'm a beginner a would very much appreciate if someone could explain what am I missing here.
For the Just case, use -> return f instead of -> f.
And then just remove the type signature for getFloat. After it compiles, have ghci tell you what the type signature for getFloat is.
Complete code:
getFloat = do
input <- getLine
case (readMaybe input :: Maybe Float) of Just f -> return f
Nothing -> do getFloat
Update
You might be interested in this highly-polymorphic version of the loop:
{-# LANGUAGE NoMonomorphismRestriction #-}
import Text.Read
getItem = do
input <- getLine
case readMaybe input of
Nothing -> getItem
Just x -> return x
I have purposely written getItem without a type signature - this is something that GHC can infer and fill in for you. I've also used the NoMonomorphismRestriction pragma so that getItem remains polymorphic.
The idea is that getItem can be used for any type that can be read - Floats, Doubles, Strings, etc. The type used by readMaybe can be controlled by the caller in various ways. Here are some examples:
main = do
f1 <- getItem
f2 <- getItem
let r = f1 + f2 :: Float
print r
By forcing r to be type Float, f1 and f2 must also be Floats, and therefore getItem will try to parse a Float.
Here is another way to influence the type that readMaybe uses:
main = do
f <- getItem :: IO Float
i <- getItem :: IO Int
print $ f^i -- compute f raised to the i-th power
getFloat :: Float
This states that getFloat is a constant of type Float, which is not what you want.
getFloat :: IO Float
This instead states that getFloat is an IO action producing a Float.
Once this is fixed, then you need to add return in front of your f, as #ErikR already explained. The return turns the pure float value f into an IO action which produces it, without actually performing any IO.
Finally, you do not need the do in the last do getFLoat. The do syntax is useful to sequence IO actions: if you only have one, it is redundant.
I want to make a Haskell parser for some mathematical expresions. For that, I would like to use reservedOp to define the operators. I tried to find some info and I found this example:
reservedOp :: String -> CharParser st ()
reservedOp = PT.reservedOp lexer
I searched on google, even on hoogle :) but couldn't find any explanation for that st (). Can anyone explain me in a few words what's the deal with it?
CharParser is just a type synonym. The main parser type used for parsing ParsecT has a lot of type variables and a lot of functionality that is often unused. The full type is
newtype ParsecT s u m a = ...
s is the parser state, u is the user state, m is the underlying monad, and a the return value.
If none of that makes sense, you should read about monad transformers.
But that probably isn't important to understanding CharParser. You can follow the type synonyms
>:i CharParser
type CharParser st = GenParser Char st
>:i GenParser
type GenParser tok st = Parsec [tok] st
>:i GenParser
type GenParser tok st = Parsec [tok] st
>:i Parsec
type Parsec s u = ParsecT s u Identity
to discover that CharParser st () is just ParsecT [Char] st Identity (). That's a parser which operates on a stream of Char (aka a String), whose user state is anything, and which returns nothing. The only way the user state can be anything at all is if it is never used by anyone. So it means pretty much nothing, you could have written any of
reservedOp :: String -> CharParser () ()
reservedOp :: String -> CharParser Int ()
reservedOp :: String -> CharParser Bool ()
etc. If the user state is unused, then it is customary to write CharParser () () to indicate that (some would say that is wrong and it should be CharParser Void () where data Void is an uninhabited type, but that is just pedantry). In fact the author in your link did do that in most of their type signatures (ie, factor :: CharParser () Double)
Since st is in lowercase, it's just a (type) variable name. Look up CharParser to see what it's all about.
can someone help me to understand how to use Applicative style for writing Parsec parsers? This is the code i have:
module Main where
import Control.Applicative hiding (many)
import Text.Parsec
import Data.Functor.Identity
data Cmd = A | B deriving (Show)
main = do
line <- getContents
putStrLn . show $ parseCmd line
parseCmd :: String -> Either ParseError String
parseCmd input = parse cmdParse "(parser)" input
cmdParse :: Parsec String () String
cmdParse = do
slash <- char '/'
whatever <- many alphaNum
return (slash:whatever)
cmdParse2 :: String -> Parsec String () String
cmdParse2 = (:) <$> (char '/') <*> many alphaNum
but when i try to compile it, i get following:
/home/tomasherman/Desktop/funinthesun.hs:21:13:
Couldn't match expected type `Parsec String () String'
with actual type `[a0]'
Expected type: a0 -> [a0] -> Parsec String () String
Actual type: a0 -> [a0] -> [a0]
In the first argument of `(<$>)', namely `(:)'
In the first argument of `(<*>)', namely `(:) <$> (char '/')'
Failed, modules loaded: none.
The idea is that i want cmdParse2 to do same thing that cmdParse does, but using applicative stuff...my approach is probably completely wrong, i'm new to haskell
Your applicative usage is spot on, you just have an incorrect signature. Try:
cmdParse2 :: Parsec String () String
Your approach looks correct to me, the problem is that cmdParse2 has the wrong type. It should have the same type as cmdParse. By the way, you can omit the parens around char '/' in the applicative style parser.
I'm surprised that I could not find any info on this. I must be the only person having any trouble with it.
So, let's say I have a dash counter. I want it to count the number of dashes in the string, and return the string. Pretend I gave an example that won't work using parsec's state handling. So this should work:
dashCounter = do
str <- many1 dash
count <- get
return (count,str)
dash = do
char '-'
modify (+1)
And indeed, this compiles. Okay, so I try to use it:
:t parse dashCounter "" "----"
parse dashCounter "" "----"
:: (Control.Monad.State.Class.MonadState
t Data.Functor.Identity.Identity,
Num t) =>
Either ParseError (t, [Char])
Okay, that makes sense. It should return the state and the string. Cool.
>parse dashCounter "" "----"
<interactive>:1:7:
No instance for (Control.Monad.State.Class.MonadState
t0 Data.Functor.Identity.Identity)
arising from a use of `dashCounter'
Possible fix:
add an instance declaration for
(Control.Monad.State.Class.MonadState
t0 Data.Functor.Identity.Identity)
In the first argument of `parse', namely `dashCounter'
In the expression: parse dashCounter "" "----"
In an equation for `it': it = parse dashCounter "" "----"
Oops. But then how could it have ever hoped to work in the first place? There's no way to input the initial state.
There is also a function:
>runPT dashCounter (0::Int) "" "----"
But it gives a similar error.
<interactive>:1:7:
No instance for (Control.Monad.State.Class.MonadState Int m0)
arising from a use of `dashCounter'
Possible fix:
add an instance declaration for
(Control.Monad.State.Class.MonadState Int m0)
In the first argument of `runPT', namely `dashCounter'
In the expression: runPT dashCounter (0 :: Int) "" "----"
In an equation for `it':
it = runPT dashCounter (0 :: Int) "" "----"
I feel like I should have to runState on it, or there should be a function that already does it internally, but I can't seem to figure out where to go from here.
Edit: I should have specified more clearly, I did not want to use parsec's state handling. The reason is I have a feeling I don't want its backtracking to affect what it collects with the problem I'm preparing to solve it with.
However, Mr. McCann has figured out how this should fit together and the final code would look like this:
dashCounter = do
str <- many1 dash
count <- get
return (count,str)
dash = do
c <- char '-'
modify (+1)
return c
test = runState (runPT dashCounter () "" "----------") 0
Thanks a lot.
You've actually got multiple problems going on here, all of which are relatively non-obvious the first time around.
Starting with the simplest: dash is returning (), which doesn't seem to be what you want given that you're collecting the results. You probably wanted something like dash = char '-' <* modify (+1). (Note that I'm using an operator from Control.Applicative here, because it looks tidier)
Next, clearing up a point of confusion: When you get the reasonable-looking type signature in GHCi, note the context of (Control.Monad.State.Class.MonadState t Data.Functor.Identity.Identity, Num t). That's not saying what things are, it's telling you want they need to be. Nothing guarantees that the instances it's asking for exist and, in fact, they don't. Identity is not a state monad!
On the other hand, you're absolutely correct in thinking that parse doesn't make sense; you can't use it here. Consider its type: Stream s Identity t => Parsec s () a -> SourceName -> s -> Either ParseError a. As is customary with monad transformers, Parsec is an synonym for ParsecT applied to the identity monad. And while ParsecT does provide user state, you apparently don't want to use it, and ParsecT does not give an instance of MonadState anyhow. Here's the only relevant instance: MonadState s m => MonadState s (ParsecT s' u m). In other words, to treat a parser as a state monad you have to apply ParsecT to some other state monad.
This sort of brings us to the next problem: Ambiguity. You're using a lot of type class methods and no type signatures, so you're likely to run into situations where GHC can't know what type you actually want, so you have to tell it.
Now, as a quick solution, let's first define a type synonym to give a name to the monad transformer stack we want:
type StateParse a = ParsecT String () (StateT Int Identity) a
Give dashCounter the relevant type signature:
dashCounter :: StateParse (Int, String)
dashCounter = do str <- many1 dash
count <- get
return (count,str)
And add a special-purpose "run" function:
runStateParse p sn inp count = runIdentity $ runStateT (runPT p () sn inp) count
Now, in GHCi:
Main> runStateParse dashCounter "" "---" 0
(Right (3,"---"),3)
Also, note that it's pretty common to use a newtype around a transformer stack instead of just a type synonym. This can help with the ambiguity issues in some cases, and obviously avoids ending up with gigantic type signatures.
If you want to use the user state component Parsec offers as a built-in feature, then you can use the getState and modifyState monadic functions.
I tried to stay true to your example program, though using the return of dash doesn't seem useful.
import Text.Parsec
dashCounter :: Parsec String Int (Int, [()])
dashCounter = do
str <- many1 dash
count <- getState
return (count,str)
dash :: Parsec String Int ()
dash = do
char '-'
modifyState (+1)
test = runP dashCounter 0 "" "---"
Note that runP is indeed addressing your concern about runState.
Whilst these answers sort out this specific problem, they ignore the more serious underlying issue with an approach like this. I would like to describe it here for anyone else looking at this answer.
There is a difference between the user state and using the StateT transformer. The internal user state is reset on backtracking but StateT is not. Consider the following code. We want to add one to our counter if there is a dash and two if there is a plus. They produce different results.
As can be seen both using the internal state and attaching a StateT transformer provide the correct result. The latter comes at the expense of having to explicitly lift operations and be much more careful with types.
import Text.Parsec hiding (State)
import Control.Monad.State
import Control.Monad.Identity
f :: ParsecT String Int Identity Int
f = do
try dash <|> plus
getState
dash = do
modifyState (+1)
char '-'
plus = do
modifyState (+2)
char '+'
f' :: ParsecT String () (State Int) ()
f' = void (try dash' <|> plus')
dash' = do
modify (+1)
char '-'
plus' = do
modify (+2)
char '+'
f'' :: StateT Int (Parsec String ()) ()
f'' = void (dash'' <|> plus'')
dash'' :: StateT Int (Parsec String ()) Char
dash'' = do
modify (+1)
lift $ char '-'
plus'' :: StateT Int (Parsec String ()) Char
plus'' = do
modify (+2)
lift $ char '+'
This is the result of running f, f' and f''.
*Main> runParser f 0 "" "+"
Right 2
*Main> flip runState 0 $ runPT f' () "" "+"
(Right (),3)
*Main> runParser (runStateT f'' 0) () "" "+"
Right ((),2)