{-# LANGUAGE CPP #-}
module Data.Binary.Parser.Numeric where
import Control.Applicative
import Control.Monad
import Data.Binary.Get.Internal
import qualified Data.Binary.Parser.Word8 as W
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Lex.Integral as LexInt
import Data.Int
import Data.Scientific (Scientific (..))
import qualified Data.Scientific as Sci
import Data.Word
#define MINUS 45
#define PLUS 43
#define LITTLE_E 101
#define BIG_E 69
#define DOT 46
hexadecimal :: (Integral a, Bits a) => Get a
hexadecimal = do
bs <- W.takeWhile1 W.isHexDigit
case LexInt.readHexadecimal bs of
Just (x, _) -> return x
Nothing -> fail "hexadecimal: impossible"
{-# SPECIALISE hexadecimal :: Get Int #-}
{-# SPECIALISE hexadecimal :: Get Int8 #-}
{-# SPECIALISE hexadecimal :: Get Int16 #-}
{-# SPECIALISE hexadecimal :: Get Int32 #-}
{-# SPECIALISE hexadecimal :: Get Int64 #-}
{-# SPECIALISE hexadecimal :: Get Integer #-}
{-# SPECIALISE hexadecimal :: Get Word #-}
{-# SPECIALISE hexadecimal :: Get Word8 #-}
{-# SPECIALISE hexadecimal :: Get Word16 #-}
{-# SPECIALISE hexadecimal :: Get Word32 #-}
{-# SPECIALISE hexadecimal :: Get Word64 #-}
decimal :: Integral a => Get a
decimal = do
bs <- W.takeWhile1 W.isDigit
return $! LexInt.readDecimal_ bs
{-# SPECIALISE decimal :: Get Int #-}
{-# SPECIALISE decimal :: Get Int8 #-}
{-# SPECIALISE decimal :: Get Int16 #-}
{-# SPECIALISE decimal :: Get Int32 #-}
{-# SPECIALISE decimal :: Get Int64 #-}
{-# SPECIALISE decimal :: Get Integer #-}
{-# SPECIALISE decimal :: Get Word #-}
{-# SPECIALISE decimal :: Get Word8 #-}
{-# SPECIALISE decimal :: Get Word16 #-}
{-# SPECIALISE decimal :: Get Word32 #-}
{-# SPECIALISE decimal :: Get Word64 #-}
signed :: Num a => Get a -> Get a
signed p = do
w <- W.peek
if w == MINUS
then W.skipN 1 >> negate <$> p
else if w == PLUS then W.skipN 1 >> p else p
{-# SPECIALISE signed :: Get Int -> Get Int #-}
{-# SPECIALISE signed :: Get Int8 -> Get Int8 #-}
{-# SPECIALISE signed :: Get Int16 -> Get Int16 #-}
{-# SPECIALISE signed :: Get Int32 -> Get Int32 #-}
{-# SPECIALISE signed :: Get Int64 -> Get Int64 #-}
{-# SPECIALISE signed :: Get Integer -> Get Integer #-}
rational :: Fractional a => Get a
rational = scientifically realToFrac
{-# SPECIALIZE rational :: Get Double #-}
{-# SPECIALIZE rational :: Get Float #-}
{-# SPECIALIZE rational :: Get Rational #-}
{-# SPECIALIZE rational :: Get Scientific #-}
double :: Get Double
double = scientifically Sci.toRealFloat
scientific :: Get Scientific
scientific = scientifically id
scientifically :: (Scientific -> a) -> Get a
scientifically h = do
sign <- W.peek
when (sign == PLUS || sign == MINUS) (W.skipN 1)
intPart <- decimal
sci <- (do fracDigits <- W.word8 DOT >> W.takeWhile1 W.isDigit
let e' = B.length fracDigits
intPart' = intPart * (10 ^ e')
fracPart = LexInt.readDecimal_ fracDigits
parseE (intPart' + fracPart) e'
) <|> (parseE intPart 0)
if sign /= MINUS then return $! h sci else return $! h (negate sci)
where
parseE c e =
(do _ <- W.satisfy (\w -> w == LITTLE_E || w == BIG_E)
(Sci.scientific c . (subtract e) <$> signed decimal)) <|> return (Sci.scientific c (negate e))
{-# INLINE parseE #-}
{-# INLINE scientifically #-}