
Hello, I copied this example exactly from the page http://www.cs.uu.nl/people/daan/download/parsec/parsec.html -----begin----- module Parser where import Data.Char import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Char import Text.ParserCombinators.Parsec.Token price = lexeme (do{ ds1 <- many1 digit ; char '.' ; ds2 <- count 2 digit ; return (convert 0 (ds1 ++ ds2)) }) <?> "price" where convert n [] = n convert n (d:ds) = convert (10*n + digitToInt d) ds -----end----- However attempting to compile it gives the error message Test.hs:8: Couldn't match `GenParser tok st a' against `CharParser st1 a1 -> CharParser st1 a1' Expected type: GenParser tok st a Inferred type: CharParser st1 a1 -> CharParser st1 a1 Probable cause: `lexeme' is applied to too few arguments in the call (lexeme (do ds1 <- many1 digit char '.' ds2 <- count 2 digit return (convert 0 (ds1 ++ ds2)))) In the first argument of `(<?>)', namely `lexeme (do ds1 <- many1 digit char '.' ds2 <- count 2 digit return (convert 0 (ds1 ++ ds2)))' I wish I knew what that meant. If someone could explain it and tell me what's wrong, I'd appreciate it. Thanks.