{- |
Module      :  Text/ParserCombinators/Parsec/Number.hs
Description :  portable number parsers
Copyright   :  (c) C. Maeder 2011-2014
License     :  BSD

Maintainer  :  chr.maeder@web.de
Stability   :  provisional
Portability :  portable

adjusted and portable number parsers stolen from
Text.ParserCombinators.Parsec.Token

The basic top-level number parsers are 'decimal', 'nat', 'int', 'fractional',
'decimalFract', 'natFract', 'floating', 'decimalFloat', 'natFloat'.

`natFloat` parses numeric literals as defined for Haskell. All numbers are
unsigned, i.e. non-negative. Leading zeros are allowed. At least a single
digit is required. A decimal point must be preceded and followed by at least
one digit.

A result type @(Either Integer Double)@ can be converted to a final @Double@
using @(either fromInteger id)@ as is done for the parsers 'fractional2' and
'floating2'.

The parser 'nat', 'natFract' and 'natFloat' parse hexadecimal and octal
 integrals (beginning with @0x@, @0X@, @0o@ or @0O@) that are disallowed when
using 'decimal', 'decimalFract' and 'decimalFloat'.

The parsers 'decimalFract' and 'natFract' only allow a decimal point, whereas
'decimalFloat' and 'natFloat' also allow the exponent notation using @e@ or
@E@.

The parser 'fractional' requires a decimal point between at least two
digits and 'floating' requires either a decimal point or the exponent
notation using @e@ or @E@. (Both parsers do not return integral values and do
not support hexadecimal or octal values).

Signed numbers can be parsed using \"'Control.Monad.ap' 'sign'\" as is done
for the 'int' parser.

A couple of parsers have been added that take a @Bool@ argument, where @False@
does not require any digit following the decimal dot. The parsers
'fractional3' and 'floating3' allow even to start a number with the decimal
dot. Also parsers 'hexFract', 'binFract', 'hexFloat' and 'binFloat' for
hexadecimal or binary fractions and floats have been added.

Note that most top-level parsers succeed on a string like \"@1.0e-100@\", but
only the floating point parsers consume the whole string. The fractional
parsers stop before the exponent and the integral parsers before the decimal
point. You may wish to check for the end of a string using
'Text.ParserCombinators.Parsec.eof', i.e. \"@liftM2 const nat eof@\".

The returned values may be inaccurate. 'Int' may overflow. Fractional numbers
should be accurate as only one division is performed. Floating point numbers
with decimal exponents may be inaccurate due to using '**'. Rational numbers
are needed for correct conversions, but large positive or negative exponents
may be a problem and the class `RealFloat` is needed to check for minimal and
maximal exponents.

-}

module Text.ParserCombinators.Parsec.Number where

import Text.ParserCombinators.Parsec
import Data.Char (digitToInt)
import Control.Monad (liftM, ap)

-- * floats

-- | parse a decimal unsigned floating point number containing a dot, e or E
floating :: Floating f => CharParser st f
floating :: forall f st. Floating f => CharParser st f
floating = do
  Integer
n <- CharParser st Integer
forall i st. Integral i => CharParser st i
decimal
  Integer -> CharParser st f
forall f st. Floating f => Integer -> CharParser st f
fractExponent Integer
n

-- | parse a floating point number possibly containing a decimal dot, e or E
floating2 :: Floating f => Bool -> CharParser st f
floating2 :: forall f st. Floating f => Bool -> CharParser st f
floating2 = (Either Integer f -> f)
-> ParsecT [Char] st Identity (Either Integer f)
-> ParsecT [Char] st Identity f
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Integer -> f) -> (f -> f) -> Either Integer f -> f
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Integer -> f
forall a. Num a => Integer -> a
fromInteger f -> f
forall a. a -> a
id) (ParsecT [Char] st Identity (Either Integer f)
 -> ParsecT [Char] st Identity f)
-> (Bool -> ParsecT [Char] st Identity (Either Integer f))
-> Bool
-> ParsecT [Char] st Identity f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParsecT [Char] st Identity (Either Integer f)
forall i f st.
(Integral i, Floating f) =>
Bool -> CharParser st (Either i f)
decFloat

{- | parse a floating point number possibly starting with a decimal dot.
Note, that a single decimal point or a number starting with @.E@ is illegal.
-}
floating3 :: Floating f => Bool -> CharParser st f
floating3 :: forall f st. Floating f => Bool -> CharParser st f
floating3 Bool
b = f -> CharParser st f -> CharParser st (f -> f) -> CharParser st f
forall f st.
Floating f =>
f -> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractAndExp f
0 (Bool -> CharParser st f
forall f st. Fractional f => Bool -> CharParser st f
fraction Bool
True) CharParser st (f -> f)
forall f st. Floating f => CharParser st (f -> f)
exponentFactor CharParser st f -> CharParser st f -> CharParser st f
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> CharParser st f
forall f st. Floating f => Bool -> CharParser st f
floating2 Bool
b

{- | same as 'floating' but returns a non-negative integral wrapped by Left if
a fractional part and exponent is missing -}
decimalFloat :: (Integral i, Floating f) => CharParser st (Either i f)
decimalFloat :: forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
decimalFloat = Bool -> CharParser st (Either i f)
forall i f st.
(Integral i, Floating f) =>
Bool -> CharParser st (Either i f)
decFloat Bool
True

{- | same as 'floating' but returns a non-negative integral wrapped by Left if
a fractional part and exponent is missing -}
decFloat :: (Integral i, Floating f) => Bool -> CharParser st (Either i f)
decFloat :: forall i f st.
(Integral i, Floating f) =>
Bool -> CharParser st (Either i f)
decFloat Bool
b = do
  i
n <- CharParser st i
forall i st. Integral i => CharParser st i
decimal
  Either i f
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (i -> Either i f
forall a b. a -> Either a b
Left i
n) (CharParser st (Either i f) -> CharParser st (Either i f))
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ (f -> Either i f)
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f -> Either i f
forall a b. b -> Either a b
Right (ParsecT [Char] st Identity f -> CharParser st (Either i f))
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ Integer -> Bool -> ParsecT [Char] st Identity f
forall f st. Floating f => Integer -> Bool -> CharParser st f
fractExp (i -> Integer
forall a. Integral a => a -> Integer
toInteger i
n) Bool
b

-- | parse a hexadecimal floating point number
hexFloat :: (Integral i, Floating f) => Bool -> CharParser st (Either i f)
hexFloat :: forall i f st.
(Integral i, Floating f) =>
Bool -> CharParser st (Either i f)
hexFloat Bool
b = do
  i
n <- CharParser st i
forall i st. Integral i => CharParser st i
hexnum
  Either i f
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (i -> Either i f
forall a b. a -> Either a b
Left i
n) (CharParser st (Either i f) -> CharParser st (Either i f))
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ (f -> Either i f)
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f -> Either i f
forall a b. b -> Either a b
Right (ParsecT [Char] st Identity f -> CharParser st (Either i f))
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ Integer -> Bool -> ParsecT [Char] st Identity f
forall f st. Floating f => Integer -> Bool -> CharParser st f
hexFractExp (i -> Integer
forall a. Integral a => a -> Integer
toInteger i
n) Bool
b

-- | parse a binary floating point number
binFloat :: (Integral i, Floating f) => Bool -> CharParser st (Either i f)
binFloat :: forall i f st.
(Integral i, Floating f) =>
Bool -> CharParser st (Either i f)
binFloat Bool
b = do
  i
n <- CharParser st i
forall i st. Integral i => CharParser st i
binary
  Either i f
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (i -> Either i f
forall a b. a -> Either a b
Left i
n) (CharParser st (Either i f) -> CharParser st (Either i f))
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ (f -> Either i f)
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f -> Either i f
forall a b. b -> Either a b
Right (ParsecT [Char] st Identity f -> CharParser st (Either i f))
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ Integer -> Bool -> ParsecT [Char] st Identity f
forall f st. Floating f => Integer -> Bool -> CharParser st f
binFractExp (i -> Integer
forall a. Integral a => a -> Integer
toInteger i
n) Bool
b

-- | parse hexadecimal, octal or decimal integrals or 'floating'
natFloat :: (Integral i, Floating f) => CharParser st (Either i f)
natFloat :: forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
natFloat = (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] st Identity (Either i f)
forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
zeroNumFloat) ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] st Identity (Either i f)
forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
decimalFloat

-- ** float parts

{- | parse any hexadecimal, octal, decimal or floating point number following
a zero -}
zeroNumFloat :: (Integral i, Floating f) => CharParser st (Either i f)
zeroNumFloat :: forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
zeroNumFloat =
  (i -> Either i f)
-> ParsecT [Char] st Identity i
-> ParsecT [Char] st Identity (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM i -> Either i f
forall a b. a -> Either a b
Left ParsecT [Char] st Identity i
forall i st. Integral i => CharParser st i
hexOrOct
  ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] st Identity (Either i f)
forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
decimalFloat
  ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (f -> Either i f)
-> ParsecT [Char] st Identity f
-> ParsecT [Char] st Identity (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f -> Either i f
forall a b. b -> Either a b
Right (Integer -> ParsecT [Char] st Identity f
forall f st. Floating f => Integer -> CharParser st f
fractExponent Integer
0)
  ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Either i f -> ParsecT [Char] st Identity (Either i f)
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Either i f
forall a b. a -> Either a b
Left i
0)

-- | parse a floating point number given the number before a dot, e or E
fractExponent :: Floating f => Integer -> CharParser st f
fractExponent :: forall f st. Floating f => Integer -> CharParser st f
fractExponent Integer
i = Integer -> Bool -> CharParser st f
forall f st. Floating f => Integer -> Bool -> CharParser st f
fractExp Integer
i Bool
True

-- | parse a hex floating point number given the number before a dot, p or P
hexFractExp :: Floating f => Integer -> Bool -> CharParser st f
hexFractExp :: forall f st. Floating f => Integer -> Bool -> CharParser st f
hexFractExp Integer
i Bool
b = Integer
-> CharParser st f -> CharParser st (f -> f) -> CharParser st f
forall f st.
Floating f =>
Integer
-> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractExp Integer
i (Bool -> CharParser st f
forall f st. Fractional f => Bool -> CharParser st f
hexFraction Bool
b) CharParser st (f -> f)
forall f st. Floating f => CharParser st (f -> f)
hexExponentFactor

-- | parse a binary floating point number given the number before a dot, p or P
binFractExp :: Floating f => Integer -> Bool -> CharParser st f
binFractExp :: forall f st. Floating f => Integer -> Bool -> CharParser st f
binFractExp Integer
i Bool
b = Integer
-> CharParser st f -> CharParser st (f -> f) -> CharParser st f
forall f st.
Floating f =>
Integer
-> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractExp Integer
i (Bool -> CharParser st f
forall f st. Fractional f => Bool -> CharParser st f
binFraction Bool
b) CharParser st (f -> f)
forall f st. Floating f => CharParser st (f -> f)
hexExponentFactor

-- | parse a floating point number given the number before a dot, e or E
fractExp :: Floating f => Integer -> Bool -> CharParser st f
fractExp :: forall f st. Floating f => Integer -> Bool -> CharParser st f
fractExp Integer
i Bool
b = Integer
-> CharParser st f -> CharParser st (f -> f) -> CharParser st f
forall f st.
Floating f =>
Integer
-> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractExp Integer
i (Bool -> CharParser st f
forall f st. Fractional f => Bool -> CharParser st f
fraction Bool
b) CharParser st (f -> f)
forall f st. Floating f => CharParser st (f -> f)
exponentFactor

{- | parse a floating point number given the number before the fraction and
exponent -}
genFractExp :: Floating f => Integer -> CharParser st f
  -> CharParser st (f -> f) -> CharParser st f
genFractExp :: forall f st.
Floating f =>
Integer
-> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractExp Integer
i CharParser st f
frac CharParser st (f -> f)
expo = case Integer -> f
forall a. Num a => Integer -> a
fromInteger Integer
i of
  f
f -> f -> CharParser st f -> CharParser st (f -> f) -> CharParser st f
forall f st.
Floating f =>
f -> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractAndExp f
f CharParser st f
frac CharParser st (f -> f)
expo CharParser st f -> CharParser st f -> CharParser st f
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((f -> f) -> f) -> CharParser st (f -> f) -> CharParser st f
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((f -> f) -> f -> f
forall a b. (a -> b) -> a -> b
$ f
f) CharParser st (f -> f)
expo

{- | parse a floating point number given the number before the fraction and
exponent that must follow the fraction -}
genFractAndExp :: Floating f => f -> CharParser st f
  -> CharParser st (f -> f) -> CharParser st f
genFractAndExp :: forall f st.
Floating f =>
f -> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractAndExp f
f CharParser st f
frac = ParsecT [Char] st Identity ((f -> f) -> f)
-> ParsecT [Char] st Identity (f -> f) -> CharParser st f
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap ((f -> (f -> f) -> f)
-> CharParser st f -> ParsecT [Char] st Identity ((f -> f) -> f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((f -> f) -> f -> f) -> f -> (f -> f) -> f
forall a b c. (a -> b -> c) -> b -> a -> c
flip (f -> f) -> f -> f
forall a. a -> a
id (f -> (f -> f) -> f) -> (f -> f) -> f -> (f -> f) -> f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f
f f -> f -> f
forall a. Num a => a -> a -> a
+)) CharParser st f
frac) (ParsecT [Char] st Identity (f -> f) -> CharParser st f)
-> (ParsecT [Char] st Identity (f -> f)
    -> ParsecT [Char] st Identity (f -> f))
-> ParsecT [Char] st Identity (f -> f)
-> CharParser st f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f -> f)
-> ParsecT [Char] st Identity (f -> f)
-> ParsecT [Char] st Identity (f -> f)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option f -> f
forall a. a -> a
id

-- | parse a floating point exponent starting with e or E
exponentFactor :: Floating f => CharParser st (f -> f)
exponentFactor :: forall f st. Floating f => CharParser st (f -> f)
exponentFactor = [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"eE" ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity (f -> f)
-> ParsecT [Char] st Identity (f -> f)
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] st Identity (f -> f)
forall f st. Floating f => Int -> CharParser st (f -> f)
extExponentFactor Int
10 ParsecT [Char] st Identity (f -> f)
-> [Char] -> ParsecT [Char] st Identity (f -> f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"exponent"

-- | parse a hexadecimal floating point starting with p (IEEE 754)
hexExponentFactor :: Floating f => CharParser st (f -> f)
hexExponentFactor :: forall f st. Floating f => CharParser st (f -> f)
hexExponentFactor = [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"pP" ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity (f -> f)
-> ParsecT [Char] st Identity (f -> f)
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] st Identity (f -> f)
forall f st. Floating f => Int -> CharParser st (f -> f)
extExponentFactor Int
2 ParsecT [Char] st Identity (f -> f)
-> [Char] -> ParsecT [Char] st Identity (f -> f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"hex-exponent"

{- | parse a signed decimal and compute the exponent factor given a base.
For hexadecimal exponential notation (IEEE 754) the base is 2 and the
leading character a p. -}
extExponentFactor :: Floating f => Int -> CharParser st (f -> f)
extExponentFactor :: forall f st. Floating f => Int -> CharParser st (f -> f)
extExponentFactor Int
base =
  (Integer -> f -> f)
-> ParsecT [Char] st Identity Integer
-> ParsecT [Char] st Identity (f -> f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((f -> f -> f) -> f -> f -> f
forall a b c. (a -> b -> c) -> b -> a -> c
flip f -> f -> f
forall a. Num a => a -> a -> a
(*) (f -> f -> f) -> (Integer -> f) -> Integer -> f -> f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer -> f
forall f. Floating f => Int -> Integer -> f
exponentValue Int
base) (ParsecT [Char] st Identity (Integer -> Integer)
-> ParsecT [Char] st Identity Integer
-> ParsecT [Char] st Identity Integer
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap ParsecT [Char] st Identity (Integer -> Integer)
forall a st. Num a => CharParser st (a -> a)
sign (ParsecT [Char] st Identity Integer
forall i st. Integral i => CharParser st i
decimal ParsecT [Char] st Identity Integer
-> [Char] -> ParsecT [Char] st Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"exponent"))

{- | compute the factor given by the number following e or E. This
implementation uses @**@ rather than @^@ for more efficiency for large
integers. -}
exponentValue :: Floating f => Int -> Integer -> f
exponentValue :: forall f. Floating f => Int -> Integer -> f
exponentValue Int
base = (Int -> f
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base f -> f -> f
forall a. Floating a => a -> a -> a
**) (f -> f) -> (Integer -> f) -> Integer -> f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> f
forall a. Num a => Integer -> a
fromInteger

-- * fractional numbers (with just a decimal point between digits)

-- | parse a fractional number containing a decimal dot
fractional :: Fractional f => CharParser st f
fractional :: forall f st. Fractional f => CharParser st f
fractional = do
  Integer
n <- CharParser st Integer
forall i st. Integral i => CharParser st i
decimal
  Integer -> Bool -> CharParser st f
forall f st. Fractional f => Integer -> Bool -> CharParser st f
fractFract Integer
n Bool
True

-- | parse a fractional number possibly containing a decimal dot
fractional2 :: Fractional f => Bool -> CharParser st f
fractional2 :: forall f st. Fractional f => Bool -> CharParser st f
fractional2 = (Either Integer f -> f)
-> ParsecT [Char] st Identity (Either Integer f)
-> ParsecT [Char] st Identity f
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Integer -> f) -> (f -> f) -> Either Integer f -> f
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Integer -> f
forall a. Num a => Integer -> a
fromInteger f -> f
forall a. a -> a
id) (ParsecT [Char] st Identity (Either Integer f)
 -> ParsecT [Char] st Identity f)
-> (Bool -> ParsecT [Char] st Identity (Either Integer f))
-> Bool
-> ParsecT [Char] st Identity f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParsecT [Char] st Identity (Either Integer f)
forall i f st.
(Integral i, Fractional f) =>
Bool -> CharParser st (Either i f)
decFract

-- | parse a fractional number possibly starting with a decimal dot
fractional3 :: Fractional f => Bool -> CharParser st f
fractional3 :: forall f st. Fractional f => Bool -> CharParser st f
fractional3 Bool
b = Integer -> Bool -> CharParser st f
forall f st. Fractional f => Integer -> Bool -> CharParser st f
fractFract Integer
0 Bool
True CharParser st f -> CharParser st f -> CharParser st f
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> CharParser st f
forall f st. Fractional f => Bool -> CharParser st f
fractional2 Bool
b

-- | a decimal fractional
decFract :: (Integral i, Fractional f) => Bool -> CharParser st (Either i f)
decFract :: forall i f st.
(Integral i, Fractional f) =>
Bool -> CharParser st (Either i f)
decFract Bool
b = do
  i
n <- CharParser st i
forall i st. Integral i => CharParser st i
decimal
  Either i f
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (i -> Either i f
forall a b. a -> Either a b
Left i
n) (CharParser st (Either i f) -> CharParser st (Either i f))
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ (f -> Either i f)
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f -> Either i f
forall a b. b -> Either a b
Right (ParsecT [Char] st Identity f -> CharParser st (Either i f))
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ Integer -> Bool -> ParsecT [Char] st Identity f
forall f st. Fractional f => Integer -> Bool -> CharParser st f
fractFract (i -> Integer
forall a. Integral a => a -> Integer
toInteger i
n) Bool
b

-- | a hexadecimal fractional
hexFract :: (Integral i, Fractional f) => Bool -> CharParser st (Either i f)
hexFract :: forall i f st.
(Integral i, Fractional f) =>
Bool -> CharParser st (Either i f)
hexFract Bool
b = do
  i
n <- CharParser st i
forall i st. Integral i => CharParser st i
hexnum
  Either i f
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (i -> Either i f
forall a b. a -> Either a b
Left i
n) (CharParser st (Either i f) -> CharParser st (Either i f))
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ (f -> Either i f)
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f -> Either i f
forall a b. b -> Either a b
Right (ParsecT [Char] st Identity f -> CharParser st (Either i f))
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ Integer
-> ParsecT [Char] st Identity f -> ParsecT [Char] st Identity f
forall f st.
Fractional f =>
Integer -> CharParser st f -> CharParser st f
genFractFract (i -> Integer
forall a. Integral a => a -> Integer
toInteger i
n) (ParsecT [Char] st Identity f -> ParsecT [Char] st Identity f)
-> ParsecT [Char] st Identity f -> ParsecT [Char] st Identity f
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT [Char] st Identity f
forall f st. Fractional f => Bool -> CharParser st f
hexFraction Bool
b

-- | a binary fractional
binFract :: (Integral i, Fractional f) => Bool -> CharParser st (Either i f)
binFract :: forall i f st.
(Integral i, Fractional f) =>
Bool -> CharParser st (Either i f)
binFract Bool
b = do
  i
n <- CharParser st i
forall i st. Integral i => CharParser st i
binary
  Either i f
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (i -> Either i f
forall a b. a -> Either a b
Left i
n) (CharParser st (Either i f) -> CharParser st (Either i f))
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ (f -> Either i f)
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f -> Either i f
forall a b. b -> Either a b
Right (ParsecT [Char] st Identity f -> CharParser st (Either i f))
-> ParsecT [Char] st Identity f -> CharParser st (Either i f)
forall a b. (a -> b) -> a -> b
$ Integer
-> ParsecT [Char] st Identity f -> ParsecT [Char] st Identity f
forall f st.
Fractional f =>
Integer -> CharParser st f -> CharParser st f
genFractFract (i -> Integer
forall a. Integral a => a -> Integer
toInteger i
n) (ParsecT [Char] st Identity f -> ParsecT [Char] st Identity f)
-> ParsecT [Char] st Identity f -> ParsecT [Char] st Identity f
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT [Char] st Identity f
forall f st. Fractional f => Bool -> CharParser st f
binFraction Bool
b

{- | same as 'fractional' but returns a non-negative integral wrapped by Left if
a fractional part is missing -}
decimalFract :: (Integral i, Fractional f) => CharParser st (Either i f)
decimalFract :: forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
decimalFract = Bool -> CharParser st (Either i f)
forall i f st.
(Integral i, Fractional f) =>
Bool -> CharParser st (Either i f)
decFract Bool
True

-- | parse hexadecimal, octal or decimal integrals or 'fractional'
natFract :: (Integral i, Fractional f) => CharParser st (Either i f)
natFract :: forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
natFract = (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] st Identity (Either i f)
forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
zeroNumFract) ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] st Identity (Either i f)
forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
decimalFract

{- | parse any hexadecimal, octal, decimal or fractional number following
a zero -}
zeroNumFract :: (Integral i, Fractional f) => CharParser st (Either i f)
zeroNumFract :: forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
zeroNumFract =
  (i -> Either i f)
-> ParsecT [Char] st Identity i
-> ParsecT [Char] st Identity (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM i -> Either i f
forall a b. a -> Either a b
Left ParsecT [Char] st Identity i
forall i st. Integral i => CharParser st i
hexOrOct
  ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] st Identity (Either i f)
forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
decimalFract
  ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (f -> Either i f)
-> ParsecT [Char] st Identity f
-> ParsecT [Char] st Identity (Either i f)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM f -> Either i f
forall a b. b -> Either a b
Right (Integer -> Bool -> ParsecT [Char] st Identity f
forall f st. Fractional f => Integer -> Bool -> CharParser st f
fractFract Integer
0 Bool
True)
  ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
-> ParsecT [Char] st Identity (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Either i f -> ParsecT [Char] st Identity (Either i f)
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Either i f
forall a b. a -> Either a b
Left i
0)

-- ** fractional parts

-- | parse a fractional number given the number before the dot
fractFract :: Fractional f => Integer -> Bool -> CharParser st f
fractFract :: forall f st. Fractional f => Integer -> Bool -> CharParser st f
fractFract Integer
i = Integer -> CharParser st f -> CharParser st f
forall f st.
Fractional f =>
Integer -> CharParser st f -> CharParser st f
genFractFract Integer
i (CharParser st f -> CharParser st f)
-> (Bool -> CharParser st f) -> Bool -> CharParser st f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CharParser st f
forall f st. Fractional f => Bool -> CharParser st f
fraction

{- | combine the given number before the dot with a parser for the fractional
part -}
genFractFract :: Fractional f => Integer -> CharParser st f -> CharParser st f
genFractFract :: forall f st.
Fractional f =>
Integer -> CharParser st f -> CharParser st f
genFractFract Integer
i = (f -> f)
-> ParsecT [Char] st Identity f -> ParsecT [Char] st Identity f
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Integer -> f
forall a. Num a => Integer -> a
fromInteger Integer
i f -> f -> f
forall a. Num a => a -> a -> a
+)

-- | parse a dot followed by decimal digits as fractional part
fraction :: Fractional f => Bool -> CharParser st f
fraction :: forall f st. Fractional f => Bool -> CharParser st f
fraction Bool
b = Bool -> Int -> CharParser st Char -> CharParser st f
forall f st.
Fractional f =>
Bool -> Int -> CharParser st Char -> CharParser st f
baseFraction Bool
b Int
10 CharParser st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

-- | parse a dot followed by hexadecimal digits as fractional part
hexFraction :: Fractional f => Bool -> CharParser st f
hexFraction :: forall f st. Fractional f => Bool -> CharParser st f
hexFraction Bool
b = Bool -> Int -> CharParser st Char -> CharParser st f
forall f st.
Fractional f =>
Bool -> Int -> CharParser st Char -> CharParser st f
baseFraction Bool
b Int
16 CharParser st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit

-- | parse a dot followed by binary digits as fractional part
binFraction :: Fractional f => Bool -> CharParser st f
binFraction :: forall f st. Fractional f => Bool -> CharParser st f
binFraction Bool
b = Bool -> Int -> CharParser st Char -> CharParser st f
forall f st.
Fractional f =>
Bool -> Int -> CharParser st Char -> CharParser st f
baseFraction Bool
b Int
2 CharParser st Char
forall st. CharParser st Char
binDigit

-- | parse a dot followed by base dependent digits as fractional part
baseFraction :: Fractional f => Bool -> Int -> CharParser st Char
  -> CharParser st f
baseFraction :: forall f st.
Fractional f =>
Bool -> Int -> CharParser st Char -> CharParser st f
baseFraction Bool
requireDigit Int
base CharParser st Char
baseDigit = Char -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' CharParser st Char
-> ParsecT [Char] st Identity f -> ParsecT [Char] st Identity f
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  ([Char] -> f)
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity f
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> [Char] -> f
forall f. Fractional f => Int -> [Char] -> f
fractionValue Int
base)
    ((if Bool
requireDigit then CharParser st Char -> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 else CharParser st Char -> ParsecT [Char] st Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many) CharParser st Char
baseDigit ParsecT [Char] st Identity [Char]
-> [Char] -> ParsecT [Char] st Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"fraction")
  ParsecT [Char] st Identity f
-> [Char] -> ParsecT [Char] st Identity f
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"fraction"

{- | compute the fraction given by a sequence of digits following the dot.
Only one division is performed and trailing zeros are ignored. -}
fractionValue :: Fractional f => Int -> String -> f
fractionValue :: forall f. Fractional f => Int -> [Char] -> f
fractionValue Int
base = (f -> f -> f) -> (f, f) -> f
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry f -> f -> f
forall a. Fractional a => a -> a -> a
(/)
  ((f, f) -> f) -> ([Char] -> (f, f)) -> [Char] -> f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f, f) -> Char -> (f, f)) -> (f, f) -> [Char] -> (f, f)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ (f
s, f
p) Char
d ->
           (f
p f -> f -> f
forall a. Num a => a -> a -> a
* Int -> f
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
d) f -> f -> f
forall a. Num a => a -> a -> a
+ f
s, f
p f -> f -> f
forall a. Num a => a -> a -> a
* Int -> f
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base))
    (f
0, f
1) ([Char] -> (f, f)) -> ([Char] -> [Char]) -> [Char] -> (f, f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse

-- * integers and naturals

{- | parse an optional 'sign' immediately followed by a 'nat'. Note, that in
Daan Leijen's code the sign was wrapped as lexeme in order to skip comments
and spaces in between. -}
int :: Integral i => CharParser st i
int :: forall i st. Integral i => CharParser st i
int = ParsecT [Char] st Identity (i -> i)
-> ParsecT [Char] st Identity i -> ParsecT [Char] st Identity i
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap ParsecT [Char] st Identity (i -> i)
forall a st. Num a => CharParser st (a -> a)
sign ParsecT [Char] st Identity i
forall i st. Integral i => CharParser st i
nat

-- | parse an optional plus or minus sign, returning 'negate' or 'id'
sign :: Num a => CharParser st (a -> a)
sign :: forall a st. Num a => CharParser st (a -> a)
sign = (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity (a -> a)
-> ParsecT [Char] st Identity (a -> a)
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> a) -> ParsecT [Char] st Identity (a -> a)
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. Num a => a -> a
negate) ParsecT [Char] st Identity (a -> a)
-> ParsecT [Char] st Identity (a -> a)
-> ParsecT [Char] st Identity (a -> a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+') ParsecT [Char] st Identity ()
-> ParsecT [Char] st Identity (a -> a)
-> ParsecT [Char] st Identity (a -> a)
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> a) -> ParsecT [Char] st Identity (a -> a)
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. a -> a
id)

{- | parse plain non-negative decimal numbers given by a non-empty sequence
of digits -}
decimal :: Integral i => CharParser st i
decimal :: forall i st. Integral i => CharParser st i
decimal = Int -> GenParser Char st Char -> GenParser Char st i
forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number Int
10 GenParser Char st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

-- | parse 0 or 1
binDigit :: CharParser st Char
binDigit :: forall st. CharParser st Char
binDigit = [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"01"

-- | parse a binary number
binary :: Integral i => CharParser st i
binary :: forall i st. Integral i => CharParser st i
binary = Int -> GenParser Char st Char -> GenParser Char st i
forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number Int
2 GenParser Char st Char
forall st. CharParser st Char
binDigit

-- | parse non-negative hexadecimal, octal or decimal numbers
nat :: Integral i => CharParser st i
nat :: forall i st. Integral i => CharParser st i
nat = CharParser st i
forall i st. Integral i => CharParser st i
zeroNumber CharParser st i -> CharParser st i -> CharParser st i
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st i
forall i st. Integral i => CharParser st i
decimal

-- ** natural parts

-- | parse a 'nat' syntactically starting with a zero
zeroNumber :: Integral i => CharParser st i
zeroNumber :: forall i st. Integral i => CharParser st i
zeroNumber =
  Char -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity i -> ParsecT [Char] st Identity i
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsecT [Char] st Identity i
forall i st. Integral i => CharParser st i
hexOrOct ParsecT [Char] st Identity i
-> ParsecT [Char] st Identity i -> ParsecT [Char] st Identity i
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] st Identity i
forall i st. Integral i => CharParser st i
decimal ParsecT [Char] st Identity i
-> ParsecT [Char] st Identity i -> ParsecT [Char] st Identity i
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> i -> ParsecT [Char] st Identity i
forall a. a -> ParsecT [Char] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return i
0) ParsecT [Char] st Identity i
-> [Char] -> ParsecT [Char] st Identity i
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
""

-- | hexadecimal or octal number
hexOrOct :: Integral i => CharParser st i
hexOrOct :: forall i st. Integral i => CharParser st i
hexOrOct = CharParser st i
forall i st. Integral i => CharParser st i
hexadecimal CharParser st i -> CharParser st i -> CharParser st i
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st i
forall i st. Integral i => CharParser st i
octal

-- | parse a hexadecimal number preceded by an x or X character
hexadecimal :: Integral i => CharParser st i
hexadecimal :: forall i st. Integral i => CharParser st i
hexadecimal = [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"xX" ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity i -> ParsecT [Char] st Identity i
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] st Identity i
forall i st. Integral i => CharParser st i
hexnum

-- | parse a hexadecimal number
hexnum :: Integral i => CharParser st i
hexnum :: forall i st. Integral i => CharParser st i
hexnum = Int -> GenParser Char st Char -> GenParser Char st i
forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number Int
16 GenParser Char st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit

-- | parse an octal number preceded by an o or O character
octal :: Integral i => CharParser st i
octal :: forall i st. Integral i => CharParser st i
octal = [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"oO" ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity i -> ParsecT [Char] st Identity i
forall a b.
ParsecT [Char] st Identity a
-> ParsecT [Char] st Identity b -> ParsecT [Char] st Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int
-> ParsecT [Char] st Identity Char -> ParsecT [Char] st Identity i
forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number Int
8 ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit

-- | parse a non-negative number given a base and a parser for the digits
number :: Integral i => Int -> GenParser tok st Char -> GenParser tok st i
number :: forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number Int
base GenParser tok st Char
baseDigit = do
  i
n <- ([Char] -> i)
-> ParsecT [tok] st Identity [Char] -> GenParser tok st i
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> [Char] -> i
forall i. Integral i => Int -> [Char] -> i
numberValue Int
base) (GenParser tok st Char -> ParsecT [tok] st Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 GenParser tok st Char
baseDigit)
  i -> GenParser tok st i -> GenParser tok st i
forall a b. a -> b -> b
seq i
n (i -> GenParser tok st i
forall a. a -> ParsecT [tok] st Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return i
n)

-- | compute the value from a string of digits using a base
numberValue :: Integral i => Int -> String -> i
numberValue :: forall i. Integral i => Int -> [Char] -> i
numberValue Int
base =
  (i -> Char -> i) -> i -> [Char] -> i
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ i
x -> ((Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base i -> i -> i
forall a. Num a => a -> a -> a
* i
x) i -> i -> i
forall a. Num a => a -> a -> a
+) (i -> i) -> (Char -> i) -> Char -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> i) -> (Char -> Int) -> Char -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) i
0