{-# LANGUAGE CPP          #-}
-- |
-- Module      :  Data.Binary.Parser.Numeric
-- Copyright   :  Bryan O'Sullivan 2007-2015, Winterland 2016
-- License     :  BSD3
--
-- Maintainer  :  drkoster@qq.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Simple, efficient combinator parsing for numeric values.
--
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 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

-- | Parse and decode an unsigned hexadecimal number.  The hex digits
-- @\'a\'@ through @\'f\'@ may be upper or lower case.
--
-- This parser does not accept a leading @\"0x\"@ string.
--
hexadecimal :: (Integral a) => Get a
hexadecimal :: forall a. Integral a => Get a
hexadecimal = do
    ByteString
bs <- (Word8 -> Bool) -> Get ByteString
W.takeWhile1 Word8 -> Bool
W.isHexDigit
    case forall a. Integral a => ByteString -> Maybe (a, ByteString)
LexInt.readHexadecimal ByteString
bs of
        Just (a
x, ByteString
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Maybe (a, ByteString)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 #-}

-- | Parse and decode an unsigned decimal number.
--
decimal :: Integral a => Get a
decimal :: forall a. Integral a => Get a
decimal = do
    ByteString
bs <- (Word8 -> Bool) -> Get ByteString
W.takeWhile1 Word8 -> Bool
W.isDigit
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Integral a => ByteString -> a
LexInt.readDecimal_ ByteString
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 #-}

-- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign
-- character.
--
signed :: Num a => Get a -> Get a
signed :: forall a. Num a => Get a -> Get a
signed Get a
p = do
    Word8
w <- Get Word8
W.peek
    if Word8
w forall a. Eq a => a -> a -> Bool
== MINUS
        then Int -> Get ()
W.skipN Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
p
        else if Word8
w forall a. Eq a => a -> a -> Bool
== 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 #-}

-- | Parse a rational number.
--
-- The syntax accepted by this parser is the same as for 'double'.
--
-- /Note/: this parser is not safe for use with inputs from untrusted
-- sources.  An input with a suitably large exponent such as
-- @"1e1000000000"@ will cause a huge 'Integer' to be allocated,
-- resulting in what is effectively a denial-of-service attack.
--
-- In most cases, it is better to use 'double' or 'scientific'
-- instead.
--
rational :: Fractional a => Get a
rational :: forall a. Fractional a => Get a
rational = forall a. (Scientific -> a) -> Get a
scientifically forall a b. (Real a, Fractional b) => a -> b
realToFrac
{-# SPECIALIZE rational :: Get Double #-}
{-# SPECIALIZE rational :: Get Float #-}
{-# SPECIALIZE rational :: Get Rational #-}
{-# SPECIALIZE rational :: Get Scientific #-}

-- | Parse a rational number and round to 'Double'.
--
-- This parser accepts an optional leading sign character, followed by
-- at least one decimal digit.  The syntax similar to that accepted by
-- the 'read' function, with the exception that a trailing @\'.\'@ or
-- @\'e\'@ /not/ followed by a number is not consumed.
--
-- Examples with behaviour identical to 'read':
--
-- >parseOnly double "3"     == Right ("",1,3.0)
-- >parseOnly double "3.1"   == Right ("",3,3.1)
-- >parseOnly double "3e4"   == Right ("",3,30000.0)
-- >parseOnly double "3.1e4" == Right ("",5,31000.0)
--
-- >parseOnly double ".3"    == Left (".3",0,"takeWhile1")
-- >parseOnly double "e3"    == Left ("e3",0,"takeWhile1")
--
-- Examples of differences from 'read':
--
-- >parseOnly double "3.foo" == Right (".foo",1,3.0)
-- >parseOnly double "3e"    == Right ("e",1,3.0)
--
-- This function does not accept string representations of \"NaN\" or
-- \"Infinity\".
--
double :: Get Double
double :: Get Double
double = forall a. (Scientific -> a) -> Get a
scientifically forall a. RealFloat a => Scientific -> a
Sci.toRealFloat

-- | Parse a scientific number.
--
-- The syntax accepted by this parser is the same as for 'double'.
--
scientific :: Get Scientific
scientific :: Get Scientific
scientific = forall a. (Scientific -> a) -> Get a
scientifically forall a. a -> a
id

-- | Parse a scientific number and convert to result using a user supply function.
--
-- The syntax accepted by this parser is the same as for 'double'.
--
scientifically :: (Scientific -> a) -> Get a
scientifically :: forall a. (Scientific -> a) -> Get a
scientifically Scientific -> a
h = do
    Word8
sign <- Get Word8
W.peek
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign forall a. Eq a => a -> a -> Bool
== PLUS || sign == MINUS) (W.skipN 1)
    Integer
intPart <- forall a. Integral a => Get a
decimal
    Scientific
sci <- (do ByteString
fracDigits <- Word8 -> Get ()
W.word8 DOT >> W.takeWhile1 W.isDigit
               let e' :: Int
e' = ByteString -> Int
B.length ByteString
fracDigits
                   intPart' :: Integer
intPart' = Integer
intPart forall a. Num a => a -> a -> a
* (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e')
                   fracPart :: Integer
fracPart = forall a. Integral a => ByteString -> a
LexInt.readDecimal_ ByteString
fracDigits
               Integer -> Int -> Get Scientific
parseE (Integer
intPart' forall a. Num a => a -> a -> a
+ Integer
fracPart) Int
e'
           ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Int -> Get Scientific
parseE Integer
intPart Int
0)

    if Word8
sign forall a. Eq a => a -> a -> Bool
/= MINUS then return $! h sci else return $! h (negate sci)
  where
    parseE :: Integer -> Int -> Get Scientific
parseE Integer
c Int
e =
        (do Word8
_ <- (Word8 -> Bool) -> Get Word8
W.satisfy (\Word8
w -> Word8
w forall a. Eq a => a -> a -> Bool
==  LITTLE_E || w == BIG_E)
            (Integer -> Int -> Scientific
Sci.scientific Integer
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
subtract Int
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Get a -> Get a
signed forall a. Integral a => Get a
decimal)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Sci.scientific Integer
c (forall a. Num a => a -> a
negate Int
e))
    {-# INLINE parseE #-}
{-# INLINE scientifically #-}