module Text.ParserCombinators.Parsec.Numeric where
import Text.Parsec
import Text.Parsec.Char
import Data.Char (digitToInt)
import Control.Monad (liftM, ap)
floating :: (Floating f, Stream s m Char) => ParsecT s u m f
floating = do
n <- decimal
fractExponent n
floating2 :: (Floating f, Stream s m Char) => Bool -> ParsecT s u m f
floating2 = liftM (either fromInteger id) . decFloat
floating3 :: (Floating f, Stream s m Char) => Bool -> ParsecT s u m f
floating3 b = genFractAndExp 0 (fraction True) exponentFactor <|> floating2 b
decimalFloat :: (Integral i, Floating f, Stream s m Char) => ParsecT s u m (Either i f)
decimalFloat = decFloat True
decFloat :: (Integral i, Floating f, Stream s m Char) => Bool -> ParsecT s u m (Either i f)
decFloat b = do
n <- decimal
option (Left n) $ liftM Right $ fractExp (toInteger n) b
hexFloat :: (Integral i, Floating f, Stream s m Char) => Bool -> ParsecT s u m (Either i f)
hexFloat b = do
n <- hexnum
option (Left n) $ liftM Right $ hexFractExp (toInteger n) b
binFloat :: (Integral i, Floating f, Stream s m Char) => Bool -> ParsecT s u m (Either i f)
binFloat b = do
n <- binary
option (Left n) $ liftM Right $ binFractExp (toInteger n) b
natFloat :: (Integral i, Floating f, Stream s m Char) => ParsecT s u m (Either i f)
natFloat = (char '0' >> zeroNumFloat) <|> decimalFloat
zeroNumFloat :: (Integral i, Floating f, Stream s m Char) => ParsecT s u m (Either i f)
zeroNumFloat =
liftM Left hexOrOct
<|> decimalFloat
<|> liftM Right (fractExponent 0)
<|> return (Left 0)
fractExponent :: (Floating f, Stream s m Char) => Integer -> ParsecT s u m f
fractExponent i = fractExp i True
hexFractExp :: (Floating f, Stream s m Char) => Integer -> Bool -> ParsecT s u m f
hexFractExp i b = genFractExp i (hexFraction b) hexExponentFactor
binFractExp :: (Floating f, Stream s m Char) => Integer -> Bool -> ParsecT s u m f
binFractExp i b = genFractExp i (binFraction b) hexExponentFactor
fractExp :: (Floating f, Stream s m Char) => Integer -> Bool -> ParsecT s u m f
fractExp i b = genFractExp i (fraction b) exponentFactor
genFractExp :: (Floating f, Stream s m Char) => Integer -> ParsecT s u m f
-> ParsecT s u m (f -> f) -> ParsecT s u m f
genFractExp i frac expo = case fromInteger i of
f -> genFractAndExp f frac expo <|> liftM ($ f) expo
genFractAndExp :: (Floating f, Stream s m Char) => f -> ParsecT s u m f
-> ParsecT s u m (f -> f) -> ParsecT s u m f
genFractAndExp f frac = ap (liftM (flip id . (f +)) frac) . option id
exponentFactor :: (Floating f, Stream s m Char) => ParsecT s u m (f -> f)
exponentFactor = oneOf "eE" >> extExponentFactor 10 <?> "exponent"
hexExponentFactor :: (Floating f, Stream s m Char) => ParsecT s u m (f -> f)
hexExponentFactor = oneOf "pP" >> extExponentFactor 2 <?> "hex-exponent"
extExponentFactor :: (Floating f, Stream s m Char) => Int -> ParsecT s u m (f -> f)
extExponentFactor base =
liftM (flip (*) . exponentValue base) (ap sign (decimal <?> "exponent"))
exponentValue :: Floating f => Int -> Integer -> f
exponentValue base = (fromIntegral base **) . fromInteger
fractional :: (Fractional f, Stream s m Char) => ParsecT s u m f
fractional = do
n <- decimal
fractFract n True
fractional2 :: (Fractional f, Stream s m Char) => Bool -> ParsecT s u m f
fractional2 = liftM (either fromInteger id) . decFract
fractional3 :: (Fractional f, Stream s m Char) => Bool -> ParsecT s u m f
fractional3 b = fractFract 0 True <|> fractional2 b
decFract :: (Integral i, Fractional f, Stream s m Char) => Bool -> ParsecT s u m (Either i f)
decFract b = do
n <- decimal
option (Left n) $ liftM Right $ fractFract (toInteger n) b
hexFract :: (Integral i, Fractional f, Stream s m Char) => Bool -> ParsecT s u m (Either i f)
hexFract b = do
n <- hexnum
option (Left n) $ liftM Right $ genFractFract (toInteger n) $ hexFraction b
binFract :: (Integral i, Fractional f, Stream s m Char) => Bool -> ParsecT s u m (Either i f)
binFract b = do
n <- binary
option (Left n) $ liftM Right $ genFractFract (toInteger n) $ binFraction b
decimalFract :: (Integral i, Fractional f, Stream s m Char) => ParsecT s u m (Either i f)
decimalFract = decFract True
natFract :: (Integral i, Fractional f, Stream s m Char) => ParsecT s u m (Either i f)
natFract = (char '0' >> zeroNumFract) <|> decimalFract
zeroNumFract :: (Integral i, Fractional f, Stream s m Char) => ParsecT s u m (Either i f)
zeroNumFract =
liftM Left hexOrOct
<|> decimalFract
<|> liftM Right (fractFract 0 True)
<|> return (Left 0)
fractFract :: (Fractional f, Stream s m Char) => Integer -> Bool -> ParsecT s u m f
fractFract i = genFractFract i . fraction
genFractFract :: (Fractional f, Stream s m Char) => Integer -> ParsecT s u m f -> ParsecT s u m f
genFractFract i = liftM (fromInteger i +)
fraction :: (Fractional f, Stream s m Char) => Bool -> ParsecT s u m f
fraction b = baseFraction b 10 digit
hexFraction :: (Fractional f, Stream s m Char) => Bool -> ParsecT s u m f
hexFraction b = baseFraction b 16 hexDigit
binFraction :: (Fractional f, Stream s m Char) => Bool -> ParsecT s u m f
binFraction b = baseFraction b 2 binDigit
baseFraction :: (Fractional f, Stream s m Char) => Bool -> Int -> ParsecT s u m Char
-> ParsecT s u m f
baseFraction requireDigit base baseDigit = char '.' >>
liftM (fractionValue base)
((if requireDigit then many1 else many) baseDigit <?> "fraction")
<?> "fraction"
fractionValue :: Fractional f => Int -> String -> f
fractionValue base = uncurry (/)
. foldl (\ (s, p) d ->
(p * fromIntegral (digitToInt d) + s, p * fromIntegral base))
(0, 1) . dropWhile (== '0') . reverse
int :: (Integral i, Stream s m Char) => ParsecT s u m i
int = ap sign nat
sign :: (Num a, Stream s m Char) => ParsecT s u m (a -> a)
sign = (char '-' >> return negate) <|> (optional (char '+') >> return id)
decimal :: (Integral i, Stream s m Char) => ParsecT s u m i
decimal = number 10 digit
binDigit :: (Stream s m Char) => ParsecT s u m Char
binDigit = oneOf "01"
binary :: (Integral i, Stream s m Char) => ParsecT s u m i
binary = number 2 binDigit
nat :: (Integral i, Stream s m Char) => ParsecT s u m i
nat = zeroNumber <|> decimal
zeroNumber :: (Integral i, Stream s m Char) => ParsecT s u m i
zeroNumber =
char '0' >> (hexOrOct <|> decimal <|> return 0) <?> ""
hexOrOct :: (Integral i, Stream s m Char) => ParsecT s u m i
hexOrOct = hexadecimal <|> octal
hexadecimal :: (Integral i, Stream s m Char) => ParsecT s u m i
hexadecimal = oneOf "xX" >> hexnum
hexnum :: (Integral i, Stream s m Char) => ParsecT s u m i
hexnum = number 16 hexDigit
octal :: (Integral i, Stream s m Char) => ParsecT s u m i
octal = oneOf "oO" >> number 8 octDigit
number :: (Integral i, Stream s m Char) => Int -> ParsecT s u m Char -> ParsecT s u m i
number base baseDigit = do
n <- liftM (numberValue base) (many1 baseDigit)
seq n (return n)
numberValue :: Integral i => Int -> String -> i
numberValue base =
foldl (\ x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0