Numeric.hs

{-# 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           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

-- | 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, Bits a) => Get a
hexadecimal = do
    bs <- W.takeWhile1 W.isHexDigit
    case LexInt.readHexadecimal bs of
        Just (x, _) -> return x
        Nothing -> fail "decimal: 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 = 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 #-}

-- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign
-- character.
--
signed :: Num a => Get a -> Get a
signed p = p <|> (negate <$> (W.word8 MINUS *> p)) <|> (W.word8 PLUS *> 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 = scientifically 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', if you feed an empty
-- continuation to the first result:
--
-- >runGetOrFail double "3"     == Right ("",1,3.0)
-- >runGetOrFail double "3.1"   == Right ("",3,3.1)
-- >runGetOrFail double "3e4"   == Right ("",3,30000.0)
-- >runGetOrFail double "3.1e4" == Right ("",5,31000.0)
--
-- Examples with behaviour identical to 'read':
--
-- >runGetOrFail double ".3"    == Left (".3",0,"takeWhile1")
-- >runGetOrFail double "e3"    == Left ("e3",0,"takeWhile1")
--
-- Examples of differences from 'read':
--
-- >runGetOrFail double "3.foo" == Right (".foo",1,3.0)
-- >runGetOrFail double "3e"    == Right ("e",1,3.0)
--
-- This function does not accept string representations of \"NaN\" or
-- \"Infinity\".
--
double :: Get Double
double = scientifically Sci.toRealFloat

-- | Parse a scientific number.
--
-- The syntax accepted by this parser is the same as for 'double'.
--
scientific :: Get Scientific
scientific = scientifically 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 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 ^ B.length fracDigits)
                   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 #-}