question about parsing integers and floats with Parsec
Arthur Baars
arthurb@cs.uu.nl
Fri, 16 Aug 2002 17:31:52 +0200
Hi,
Here is a solution that does not use "try".
import Parsec
import qualified ParsecToken as P
import ParsecLanguage (emptyDef)
lexer = P.makeTokenParser emptyDef
-- naturalOrFloat parses a float or an integer without sign
naturalOrFloat = P.naturalOrFloat lexer
data Sign = Positive | Negative
applySign :: Num a => Sign -> a -> a
applySign Positive = id
applySign Negative = negate
sign :: Parser Sign
sign = do { char '-'
; return Negative
}
<|> do { char '+'
; return Positive
}
<|> return Positive
genericgrab :: Parser (Either Integer Double)
genericgrab = do { s <- sign
; num <- naturalOrFloat
; return (case num of
Right x -> Right (applySign s x)
Left x -> Left (applySign s x)
)
}
On 16/8/02 7:08, "Harris, Andrew" <Andrew.Harris@jhuapl.edu> wrote:
> Hi -
>
> After a bit of monkeying around, it seems the following parser works
> to detect both integers and floats, both positive and negative. I'm sure
> you wizards have many better ways of doing this. Anyway here it is for your
> amusement:
>
> import Parsec
> import qualified ParsecToken as P
> import ParsecLanguage (emptyDef)
>
> lexer = P.makeTokenParser emptyDef
> integer = P.integer lexer
> float = P.float lexer
>
> genericgrab :: Parser (Either Integer Double)
> genericgrab = try ( do { n <- char '-'
> ; f <- float
> ; return (Right (-f))
> }
> )
> <|> try ( do { f <- float
> ; return (Right f)
> }
> )
> <|> try ( do { f <- integer
> ; return (Left f)
> }
> )
>
> -andrew
>
>> -----Original Message-----
>> From: Harris, Andrew [mailto:Andrew.Harris@jhuapl.edu]
>> Sent: Thursday, August 15, 2002 6:55 PM
>> To: 'haskell-cafe@haskell.org'
>> Subject: question about parsing integers and floats with Parsec
>>
>>
>> Hi -
>>
>> This isn't a pure "Haskell" question, but I'm trying to use the
>> Parsec library to parse out space separated numbers, which
>> could be integers
>> or floats and either positive or negative. I was using the
>> "naturalOrFloat"
>> lexeme parser from the ParsecToken module, until I realized
>> that it doesn't
>> seem to handle negative integers. I've been poking with
>> trying to pair the
>> integer and float lexeme parsers with try() blocks, but I
>> ain't no parsing
>> expert and am not making good progress.
>>
>> Any help/hints would be appreciated!
>>
>> thanks,
>> -andrew
>>
>> ---
>> Andrew Harris andrew.harris@jhuapl.edu
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe@haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>