{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}

-- Module:      Blaze.Text.Int
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable
--
-- Efficiently serialize an integral value as a lazy 'L.ByteString'.

module Blaze.Text.Int
    (
      digit
    , integral
    , minus
    ) where

import Blaze.ByteString.Builder
import Blaze.ByteString.Builder.Char8
import Data.ByteString.Char8 ()
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Monoid (mappend, mempty)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import GHC.Base (quotInt, remInt)
#if MIN_VERSION_base(4,15,0)
#elif
import GHC.Num (quotRemInteger)
#endif
import GHC.Types (Int(..))

#if defined(INTEGER_GMP)
import GHC.Integer.GMP.Internals
#elif defined(INTEGER_SIMPLE)
import GHC.Integer.Simple.Internals
#endif

#define PAIR(a,b) (# a,b #)

integral :: (Integral a, Show a) => a -> Builder
{-# RULES "integral/Int" integral = bounded :: Int -> Builder #-}
{-# RULES "integral/Int8" integral = bounded :: Int8 -> Builder #-}
{-# RULES "integral/Int16" integral = bounded :: Int16 -> Builder #-}
{-# RULES "integral/Int32" integral = bounded :: Int32 -> Builder #-}
{-# RULES "integral/Int64" integral = bounded :: Int64 -> Builder #-}
{-# RULES "integral/Word" integral = nonNegative :: Word -> Builder #-}
{-# RULES "integral/Word8" integral = nonNegative :: Word8 -> Builder #-}
{-# RULES "integral/Word16" integral = nonNegative :: Word16 -> Builder #-}
{-# RULES "integral/Word32" integral = nonNegative :: Word32 -> Builder #-}
{-# RULES "integral/Word64" integral = nonNegative :: Word64 -> Builder #-}
{-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-}

-- This definition of the function is here PURELY to be used by ghci
-- and those rare cases where GHC is being invoked without
-- optimization, as otherwise the rewrite rules above should fire. The
-- test for "-0" catches an overflow if we render minBound.
integral :: forall a. (Integral a, Show a) => a -> Builder
integral a
i
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0                 = a -> Builder
forall a. Integral a => a -> Builder
nonNegative a
i
    | Builder -> ByteString
toByteString Builder
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"-0" = String -> Builder
fromString (a -> String
forall a. Show a => a -> String
show a
i)
    | Bool
otherwise              = Builder
b
  where b :: Builder
b = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> Builder
forall a. Integral a => a -> Builder
nonNegative (-a
i)
{-# NOINLINE integral #-}

bounded :: (Bounded a, Integral a) => a -> Builder
{-# SPECIALIZE bounded :: Int -> Builder #-}
{-# SPECIALIZE bounded :: Int8 -> Builder #-}
{-# SPECIALIZE bounded :: Int16 -> Builder #-}
{-# SPECIALIZE bounded :: Int32 -> Builder #-}
{-# SPECIALIZE bounded :: Int64 -> Builder #-}
bounded :: forall a. (Bounded a, Integral a) => a -> Builder
bounded a
i
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0        = a -> Builder
forall a. Integral a => a -> Builder
nonNegative a
i
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
forall a. Bounded a => a
minBound  = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> Builder
forall a. Integral a => a -> Builder
nonNegative (-a
i)
    | Bool
otherwise     = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                      a -> Builder
forall a. Integral a => a -> Builder
nonNegative (a -> a
forall a. Num a => a -> a
negate (a
k a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
10)) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                      a -> Builder
forall a. Integral a => a -> Builder
digit (a -> a
forall a. Num a => a -> a
negate (a
k a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
10))
  where k :: a
k = a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
i

nonNegative :: Integral a => a -> Builder
{-# SPECIALIZE nonNegative :: Int -> Builder #-}
{-# SPECIALIZE nonNegative :: Int8 -> Builder #-}
{-# SPECIALIZE nonNegative :: Int16 -> Builder #-}
{-# SPECIALIZE nonNegative :: Int32 -> Builder #-}
{-# SPECIALIZE nonNegative :: Int64 -> Builder #-}
{-# SPECIALIZE nonNegative :: Word -> Builder #-}
{-# SPECIALIZE nonNegative :: Word8 -> Builder #-}
{-# SPECIALIZE nonNegative :: Word16 -> Builder #-}
{-# SPECIALIZE nonNegative :: Word32 -> Builder #-}
{-# SPECIALIZE nonNegative :: Word64 -> Builder #-}
nonNegative :: forall a. Integral a => a -> Builder
nonNegative = a -> Builder
forall a. Integral a => a -> Builder
go
  where
    go :: a -> Builder
go a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10    = a -> Builder
forall a. Integral a => a -> Builder
digit a
n
         | Bool
otherwise = a -> Builder
go (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
10) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> Builder
forall a. Integral a => a -> Builder
digit (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
10)

digit :: Integral a => a -> Builder
digit :: forall a. Integral a => a -> Builder
digit a
n = Word8 -> Builder
fromWord8 (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$! a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
48
{-# INLINE digit #-}

minus :: Builder
minus :: Builder
minus = Word8 -> Builder
fromWord8 Word8
45

int :: Int -> Builder
int :: Int -> Builder
int = Int -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE int #-}

integer :: Integer -> Builder
#if defined(INTEGER_GMP)
integer :: Integer -> Builder
integer (S# Int#
i#) = Int -> Builder
int (Int# -> Int
I# Int#
i#)
#endif
integer Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Integer -> Builder
go (-Integer
i)
    | Bool
otherwise = Integer -> Builder
go Integer
i
  where
    go :: Integer -> Builder
go Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
maxInt = Int -> Builder
int (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
         | Bool
otherwise  = [Integer] -> Builder
putH (Integer -> Integer -> [Integer]
splitf (Integer
maxInt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
maxInt) Integer
n)

    splitf :: Integer -> Integer -> [Integer]
splitf Integer
p Integer
n
      | Integer
p Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
n       = [Integer
n]
      | Bool
otherwise   = Integer -> [Integer] -> [Integer]
splith Integer
p (Integer -> Integer -> [Integer]
splitf (Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
p) Integer
n)

    splith :: Integer -> [Integer] -> [Integer]
splith Integer
p (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
p of
                        PAIR(Integer
q,r) | Integer
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     -> Integer
q Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
splitb Integer
p [Integer]
ns
                                  | Bool
otherwise -> Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
splitb Integer
p [Integer]
ns
    splith Integer
_ [Integer]
_      = String -> [Integer]
forall a. HasCallStack => String -> a
error String
"splith: the impossible happened."

    splitb :: Integer -> [Integer] -> [Integer]
splitb Integer
p (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
p of
                        PAIR(Integer
q,r) -> Integer
q Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
splitb Integer
p [Integer]
ns
    splitb Integer
_ [Integer]
_      = []

data T = T !Integer !Int

fstT :: T -> Integer
fstT :: T -> Integer
fstT (T Integer
a Int
_) = Integer
a

maxInt :: Integer
maxDigits :: Int
T Integer
maxInt Int
maxDigits =
    (T -> Bool) -> (T -> T) -> T -> T
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
mi) (Integer -> Bool) -> (T -> Integer) -> T -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
10) (Integer -> Integer) -> (T -> Integer) -> T -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Integer
fstT) (\(T Integer
n Int
d) -> Integer -> Int -> T
T (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
10) (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) (Integer -> Int -> T
T Integer
10 Int
1)
  where mi :: Integer
mi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)

putH :: [Integer] -> Builder
putH :: [Integer] -> Builder
putH (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
maxInt of
                PAIR(Integer
x,y)
                    | Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     -> Int -> Builder
int Int
q Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
pblock Int
r Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Integer] -> Builder
putB [Integer]
ns
                    | Bool
otherwise -> Int -> Builder
int Int
r Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Integer] -> Builder
putB [Integer]
ns
                    where q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x
                          r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y
putH [Integer]
_ = String -> Builder
forall a. HasCallStack => String -> a
error String
"putH: the impossible happened"

putB :: [Integer] -> Builder
putB :: [Integer] -> Builder
putB (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
maxInt of
                PAIR(Integer
x,y) -> Int -> Builder
pblock Int
q Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
pblock Int
r Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Integer] -> Builder
putB [Integer]
ns
                    where q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x
                          r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y
putB [Integer]
_ = Builder
forall a. Monoid a => a
mempty

pblock :: Int -> Builder
pblock :: Int -> Builder
pblock = Int -> Int -> Builder
forall {t}. (Eq t, Num t) => t -> Int -> Builder
go Int
maxDigits
  where
    go :: t -> Int -> Builder
go !t
d !Int
n
        | t
d t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1    = Int -> Builder
forall a. Integral a => a -> Builder
digit Int
n
        | Bool
otherwise = t -> Int -> Builder
go (t
dt -> t -> t
forall a. Num a => a -> a -> a
-t
1) Int
q Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
forall a. Integral a => a -> Builder
digit Int
r
        where q :: Int
q = Int
n Int -> Int -> Int
`quotInt` Int
10
              r :: Int
r = Int
n Int -> Int -> Int
`remInt` Int
10