{-# LANGUAGE DeriveLift #-}

module Argo.Internal.Json.Number where

import qualified Argo.Internal.Literal as Literal
import qualified Argo.Internal.Type.Decimal as Decimal
import qualified Argo.Internal.Type.Decoder as Decoder
import qualified Argo.Internal.Type.Encoder as Encoder
import qualified Argo.Vendor.Builder as Builder
import qualified Argo.Vendor.ByteString as ByteString
import qualified Argo.Vendor.DeepSeq as DeepSeq
import qualified Argo.Vendor.TemplateHaskell as TH
import qualified Argo.Vendor.Transformers as Trans
import qualified Control.Applicative as Applicative
import qualified Control.Monad as Monad
import qualified Data.Bool as Bool
import qualified Data.Maybe as Maybe
import qualified Data.Word as Word

newtype Number
    = Number Decimal.Decimal
    deriving (Number -> Number -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Number -> Number -> Bool
$c/= :: Number -> Number -> Bool
== :: Number -> Number -> Bool
$c== :: Number -> Number -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Number -> m Exp
forall (m :: * -> *). Quote m => Number -> Code m Number
liftTyped :: forall (m :: * -> *). Quote m => Number -> Code m Number
$cliftTyped :: forall (m :: * -> *). Quote m => Number -> Code m Number
lift :: forall (m :: * -> *). Quote m => Number -> m Exp
$clift :: forall (m :: * -> *). Quote m => Number -> m Exp
TH.Lift, Int -> Number -> ShowS
[Number] -> ShowS
Number -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Number] -> ShowS
$cshowList :: [Number] -> ShowS
show :: Number -> String
$cshow :: Number -> String
showsPrec :: Int -> Number -> ShowS
$cshowsPrec :: Int -> Number -> ShowS
Show)

instance DeepSeq.NFData Number where
    rnf :: Number -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> Decimal
toDecimal

fromDecimal :: Decimal.Decimal -> Number
fromDecimal :: Decimal -> Number
fromDecimal = Decimal -> Number
Number

toDecimal :: Number -> Decimal.Decimal
toDecimal :: Number -> Decimal
toDecimal (Number Decimal
x) = Decimal
x

encode :: Number -> Encoder.Encoder ()
encode :: Number -> Encoder ()
encode Number
x = do
    let Decimal.Decimal Integer
s Integer
e = Number -> Decimal
toDecimal Number
x
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell forall a b. (a -> b) -> a -> b
$ Integer -> Builder
Builder.integerDec Integer
s
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Integer
e forall a. Eq a => a -> a -> Bool
/= Integer
0)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell
        forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
Builder.word8 Word8
Literal.latinSmallLetterE
        forall a. Semigroup a => a -> a -> a
<> Integer -> Builder
Builder.integerDec Integer
e

decode :: Decoder.Decoder Number
decode :: Decoder Number
decode = do
    Bool
ni <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
Maybe.isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Applicative.optional forall a b. (a -> b) -> a -> b
$ Word8 -> Decoder ()
Decoder.word8
        Word8
Literal.hyphenMinus
    ByteString
i <- (Word8 -> Bool) -> Decoder ByteString
Decoder.takeWhile1 Word8 -> Bool
Decoder.isDigit
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when
            (ByteString -> Int
ByteString.length ByteString
i
            forall a. Ord a => a -> a -> Bool
> Int
1
            Bool -> Bool -> Bool
&& Word8 -> ByteString -> Maybe Int
ByteString.elemIndex Word8
Literal.digitZero ByteString
i
            forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0
            )
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
        forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"leading zero"
    ByteString
f <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
Maybe.fromMaybe ByteString
ByteString.empty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Applicative.optional forall a b. (a -> b) -> a -> b
$ do
        Word8 -> Decoder ()
Decoder.word8 Word8
Literal.fullStop
        (Word8 -> Bool) -> Decoder ByteString
Decoder.takeWhile1 Word8 -> Bool
Decoder.isDigit
    (Bool
ne, ByteString
e) <-
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
Maybe.fromMaybe (Bool
False, ByteString
ByteString.empty))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Applicative.optional
        forall a b. (a -> b) -> a -> b
$ do
              forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Decoder Word8
Decoder.satisfy
                  forall a b. (a -> b) -> a -> b
$ \Word8
x ->
                        (Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.latinSmallLetterE)
                            Bool -> Bool -> Bool
|| (Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.latinCapitalLetterE)
              Bool
ne <-
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Word8
Literal.hyphenMinus)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Applicative.optional
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Decoder Word8
Decoder.satisfy
                  forall a b. (a -> b) -> a -> b
$ \Word8
x -> Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.hyphenMinus Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.plusSign
              ByteString
e <- (Word8 -> Bool) -> Decoder ByteString
Decoder.takeWhile1 Word8 -> Bool
Decoder.isDigit
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
ne, ByteString
e)
    Decoder ()
Decoder.spaces
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal -> Number
fromDecimal forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Decimal
Decimal.decimal
        (Bool -> Integer -> Integer
negateIf Bool
ni forall a b. (a -> b) -> a -> b
$ (ByteString -> Integer
fromDigits ByteString
i forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ ByteString -> Int
ByteString.length ByteString
f) forall a. Num a => a -> a -> a
+ ByteString -> Integer
fromDigits ByteString
f
        )
        (Bool -> Integer -> Integer
negateIf Bool
ne (ByteString -> Integer
fromDigits ByteString
e) forall a. Num a => a -> a -> a
- Int -> Integer
intToInteger (ByteString -> Int
ByteString.length ByteString
f))

negateIf :: Bool -> Integer -> Integer
negateIf :: Bool -> Integer -> Integer
negateIf = forall a. a -> a -> Bool -> a
Bool.bool forall a. a -> a
id forall a. Num a => a -> a
negate

fromDigits :: ByteString.ByteString -> Integer
fromDigits :: ByteString -> Integer
fromDigits =
    forall a. (a -> Word8 -> a) -> a -> ByteString -> a
ByteString.foldl' (\Integer
a Word8
e -> (Integer
a forall a. Num a => a -> a -> a
* Integer
10) forall a. Num a => a -> a -> a
+ Word8 -> Integer
word8ToInteger (Word8
e forall a. Num a => a -> a -> a
- Word8
0x30)) Integer
0

intToInteger :: Int -> Integer
intToInteger :: Int -> Integer
intToInteger = forall a b. (Integral a, Num b) => a -> b
fromIntegral

word8ToInteger :: Word.Word8 -> Integer
word8ToInteger :: Word8 -> Integer
word8ToInteger = forall a b. (Integral a, Num b) => a -> b
fromIntegral