module Text.ParserCombinators.Parsec.Number where
import Text.ParserCombinators.Parsec
import Data.Char (digitToInt)
import Control.Monad (liftM, ap)
floating :: Floating f => CharParser st f
floating :: 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
floating2 :: Floating f => Bool -> CharParser st f
floating2 :: Bool -> CharParser st f
floating2 = (Either Integer f -> f)
-> ParsecT [Char] st Identity (Either Integer f) -> CharParser st 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) -> CharParser st f)
-> (Bool -> ParsecT [Char] st Identity (Either Integer f))
-> Bool
-> CharParser st 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
floating3 :: Floating f => Bool -> CharParser st f
floating3 :: Bool -> CharParser st f
floating3 b :: 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 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
decimalFloat :: (Integral i, Floating f) => CharParser st (Either i f)
decimalFloat :: 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
decFloat :: (Integral i, Floating f) => Bool -> CharParser st (Either i f)
decFloat :: Bool -> CharParser st (Either i f)
decFloat b :: 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
hexFloat :: (Integral i, Floating f) => Bool -> CharParser st (Either i f)
hexFloat :: Bool -> CharParser st (Either i f)
hexFloat b :: 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
binFloat :: (Integral i, Floating f) => Bool -> CharParser st (Either i f)
binFloat :: Bool -> CharParser st (Either i f)
binFloat b :: 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
natFloat :: (Integral i, Floating f) => CharParser st (Either i f)
natFloat :: 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 '0' ParsecT [Char] st Identity Char
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st (Either i f)
forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
zeroNumFloat) CharParser st (Either i f)
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st (Either i f)
forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
decimalFloat
zeroNumFloat :: (Integral i, Floating f) => CharParser st (Either i f)
zeroNumFloat :: CharParser st (Either i f)
zeroNumFloat =
(i -> Either i f)
-> ParsecT [Char] st Identity i -> CharParser st (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
CharParser st (Either i f)
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st (Either i f)
forall i f st.
(Integral i, Floating f) =>
CharParser st (Either i f)
decimalFloat
CharParser st (Either i f)
-> CharParser st (Either i f) -> CharParser st (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 -> 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 (Integer -> ParsecT [Char] st Identity f
forall f st. Floating f => Integer -> CharParser st f
fractExponent 0)
CharParser st (Either i f)
-> CharParser st (Either i f) -> CharParser st (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 -> CharParser st (Either i f)
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Either i f
forall a b. a -> Either a b
Left 0)
fractExponent :: Floating f => Integer -> CharParser st f
fractExponent :: Integer -> CharParser st f
fractExponent i :: Integer
i = Integer -> Bool -> CharParser st f
forall f st. Floating f => Integer -> Bool -> CharParser st f
fractExp Integer
i Bool
True
hexFractExp :: Floating f => Integer -> Bool -> CharParser st f
hexFractExp :: Integer -> Bool -> CharParser st f
hexFractExp i :: Integer
i b :: 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
binFractExp :: Floating f => Integer -> Bool -> CharParser st f
binFractExp :: Integer -> Bool -> CharParser st f
binFractExp i :: Integer
i b :: 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
fractExp :: Floating f => Integer -> Bool -> CharParser st f
fractExp :: Integer -> Bool -> CharParser st f
fractExp i :: Integer
i b :: 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
genFractExp :: Floating f => Integer -> CharParser st f
-> CharParser st (f -> f) -> CharParser st f
genFractExp :: Integer
-> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractExp i :: Integer
i frac :: CharParser st f
frac expo :: CharParser st (f -> f)
expo = case Integer -> f
forall a. Num a => Integer -> a
fromInteger Integer
i of
f :: 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
genFractAndExp :: Floating f => f -> CharParser st f
-> CharParser st (f -> f) -> CharParser st f
genFractAndExp :: f -> CharParser st f -> CharParser st (f -> f) -> CharParser st f
genFractAndExp f :: f
f frac :: CharParser st f
frac = ParsecT [Char] st Identity ((f -> f) -> f)
-> CharParser st (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) (CharParser st (f -> f) -> CharParser st f)
-> (CharParser st (f -> f) -> CharParser st (f -> f))
-> CharParser st (f -> f)
-> CharParser st f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f -> f) -> CharParser st (f -> f) -> CharParser st (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
exponentFactor :: Floating f => CharParser st (f -> f)
exponentFactor :: 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 "eE" ParsecT [Char] st Identity Char
-> CharParser st (f -> f) -> CharParser st (f -> f)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> CharParser st (f -> f)
forall f st. Floating f => Int -> CharParser st (f -> f)
extExponentFactor 10 CharParser st (f -> f) -> [Char] -> CharParser st (f -> f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "exponent"
hexExponentFactor :: Floating f => CharParser st (f -> f)
hexExponentFactor :: 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 "pP" ParsecT [Char] st Identity Char
-> CharParser st (f -> f) -> CharParser st (f -> f)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> CharParser st (f -> f)
forall f st. Floating f => Int -> CharParser st (f -> f)
extExponentFactor 2 CharParser st (f -> f) -> [Char] -> CharParser st (f -> f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "hex-exponent"
extExponentFactor :: Floating f => Int -> CharParser st (f -> f)
extExponentFactor :: Int -> CharParser st (f -> f)
extExponentFactor base :: Int
base =
(Integer -> f -> f)
-> ParsecT [Char] st Identity Integer -> CharParser st (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
<?> "exponent"))
exponentValue :: Floating f => Int -> Integer -> f
exponentValue :: Int -> Integer -> f
exponentValue base :: 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 :: Fractional f => CharParser st f
fractional :: 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
fractional2 :: Fractional f => Bool -> CharParser st f
fractional2 :: Bool -> CharParser st f
fractional2 = (Either Integer f -> f)
-> ParsecT [Char] st Identity (Either Integer f) -> CharParser st 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) -> CharParser st f)
-> (Bool -> ParsecT [Char] st Identity (Either Integer f))
-> Bool
-> CharParser st 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
fractional3 :: Fractional f => Bool -> CharParser st f
fractional3 :: Bool -> CharParser st f
fractional3 b :: Bool
b = Integer -> Bool -> CharParser st f
forall f st. Fractional f => Integer -> Bool -> CharParser st f
fractFract 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
decFract :: (Integral i, Fractional f) => Bool -> CharParser st (Either i f)
decFract :: Bool -> CharParser st (Either i f)
decFract b :: 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
hexFract :: (Integral i, Fractional f) => Bool -> CharParser st (Either i f)
hexFract :: Bool -> CharParser st (Either i f)
hexFract b :: 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
binFract :: (Integral i, Fractional f) => Bool -> CharParser st (Either i f)
binFract :: Bool -> CharParser st (Either i f)
binFract b :: 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
decimalFract :: (Integral i, Fractional f) => CharParser st (Either i f)
decimalFract :: 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
natFract :: (Integral i, Fractional f) => CharParser st (Either i f)
natFract :: 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 '0' ParsecT [Char] st Identity Char
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st (Either i f)
forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
zeroNumFract) CharParser st (Either i f)
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st (Either i f)
forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
decimalFract
zeroNumFract :: (Integral i, Fractional f) => CharParser st (Either i f)
zeroNumFract :: CharParser st (Either i f)
zeroNumFract =
(i -> Either i f)
-> ParsecT [Char] st Identity i -> CharParser st (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
CharParser st (Either i f)
-> CharParser st (Either i f) -> CharParser st (Either i f)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st (Either i f)
forall i f st.
(Integral i, Fractional f) =>
CharParser st (Either i f)
decimalFract
CharParser st (Either i f)
-> CharParser st (Either i f) -> CharParser st (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 -> 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 (Integer -> Bool -> ParsecT [Char] st Identity f
forall f st. Fractional f => Integer -> Bool -> CharParser st f
fractFract 0 Bool
True)
CharParser st (Either i f)
-> CharParser st (Either i f) -> CharParser st (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 -> CharParser st (Either i f)
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Either i f
forall a b. a -> Either a b
Left 0)
fractFract :: Fractional f => Integer -> Bool -> CharParser st f
fractFract :: Integer -> Bool -> CharParser st f
fractFract i :: 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
genFractFract :: Fractional f => Integer -> CharParser st f -> CharParser st f
genFractFract :: Integer -> CharParser st f -> CharParser st f
genFractFract i :: Integer
i = (f -> f) -> CharParser st f -> CharParser st 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
+)
fraction :: Fractional f => Bool -> CharParser st f
fraction :: Bool -> CharParser st f
fraction b :: 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 10 CharParser st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
hexFraction :: Fractional f => Bool -> CharParser st f
hexFraction :: Bool -> CharParser st f
hexFraction b :: 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 16 CharParser st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
binFraction :: Fractional f => Bool -> CharParser st f
binFraction :: Bool -> CharParser st f
binFraction b :: 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 2 CharParser st Char
forall st. CharParser st Char
binDigit
baseFraction :: Fractional f => Bool -> Int -> CharParser st Char
-> CharParser st f
baseFraction :: Bool -> Int -> CharParser st Char -> CharParser st f
baseFraction requireDigit :: Bool
requireDigit base :: Int
base baseDigit :: CharParser st Char
baseDigit = Char -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '.' CharParser st Char -> CharParser st f -> CharParser st f
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
([Char] -> f)
-> ParsecT [Char] st Identity [Char] -> CharParser st 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
<?> "fraction")
CharParser st f -> [Char] -> CharParser st f
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "fraction"
fractionValue :: Fractional f => Int -> String -> f
fractionValue :: Int -> [Char] -> f
fractionValue base :: 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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ (s :: f
s, p :: f
p) d :: 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))
(0, 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
== '0') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse
int :: Integral i => CharParser st i
int :: CharParser st i
int = ParsecT [Char] st Identity (i -> i)
-> CharParser st i -> CharParser st 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 CharParser st i
forall i st. Integral i => CharParser st i
nat
sign :: Num a => CharParser st (a -> a)
sign :: 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 '-' ParsecT [Char] st Identity Char
-> CharParser st (a -> a) -> CharParser st (a -> a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> a) -> CharParser st (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. Num a => a -> a
negate) CharParser st (a -> a)
-> CharParser st (a -> a) -> CharParser st (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 '+') ParsecT [Char] st Identity ()
-> CharParser st (a -> a) -> CharParser st (a -> a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> a) -> CharParser st (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. a -> a
id)
decimal :: Integral i => CharParser st i
decimal :: CharParser st i
decimal = Int -> GenParser Char st Char -> CharParser st i
forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number 10 GenParser Char st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
binDigit :: CharParser st Char
binDigit :: CharParser st Char
binDigit = [Char] -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf "01"
binary :: Integral i => CharParser st i
binary :: CharParser st i
binary = Int -> GenParser Char st Char -> CharParser st i
forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number 2 GenParser Char st Char
forall st. CharParser st Char
binDigit
nat :: Integral i => CharParser st i
nat :: 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
zeroNumber :: Integral i => CharParser st i
zeroNumber :: 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 '0' ParsecT [Char] st Identity Char
-> CharParser st i -> CharParser st i
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (CharParser st i
forall i st. Integral i => CharParser st i
hexOrOct 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 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
<|> i -> CharParser st i
forall (m :: * -> *) a. Monad m => a -> m a
return 0) CharParser st i -> [Char] -> CharParser st i
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> ""
hexOrOct :: Integral i => CharParser st i
hexOrOct :: 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
hexadecimal :: Integral i => CharParser st i
hexadecimal :: 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 "xX" ParsecT [Char] st Identity Char
-> CharParser st i -> CharParser st i
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st i
forall i st. Integral i => CharParser st i
hexnum
hexnum :: Integral i => CharParser st i
hexnum :: CharParser st i
hexnum = Int -> GenParser Char st Char -> CharParser st i
forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number 16 GenParser Char st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
octal :: Integral i => CharParser st i
octal :: 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 "oO" ParsecT [Char] st Identity Char
-> CharParser st i -> CharParser st i
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] st Identity Char -> CharParser st i
forall i tok st.
Integral i =>
Int -> GenParser tok st Char -> GenParser tok st i
number 8 ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit
number :: Integral i => Int -> GenParser tok st Char -> GenParser tok st i
number :: Int -> GenParser tok st Char -> GenParser tok st i
number base :: Int
base baseDigit :: 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 (m :: * -> *) a. Monad m => a -> m a
return i
n)
numberValue :: Integral i => Int -> String -> i
numberValue :: Int -> [Char] -> i
numberValue base :: Int
base =
(i -> Char -> i) -> i -> [Char] -> i
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ x :: 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) 0