{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}

module Argo.Json.Number where

import qualified Argo.Literal as Literal
import qualified Argo.Type.Decimal as Decimal
import qualified Argo.Type.Decoder as Decoder
import qualified Argo.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
import qualified GHC.Generics as Generics

newtype Number
    = Number Decimal.Decimal
    deriving (Number -> Number -> Bool
(Number -> Number -> Bool)
-> (Number -> Number -> Bool) -> Eq Number
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 x. Number -> Rep Number x)
-> (forall x. Rep Number x -> Number) -> Generic Number
forall x. Rep Number x -> Number
forall x. Number -> Rep Number x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Number x -> Number
$cfrom :: forall x. Number -> Rep Number x
Generics.Generic, Number -> Q Exp
Number -> Q (TExp Number)
(Number -> Q Exp) -> (Number -> Q (TExp Number)) -> Lift Number
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Number -> Q (TExp Number)
$cliftTyped :: Number -> Q (TExp Number)
lift :: Number -> Q Exp
$clift :: Number -> Q Exp
TH.Lift, Number -> ()
(Number -> ()) -> NFData Number
forall a. (a -> ()) -> NFData a
rnf :: Number -> ()
$crnf :: Number -> ()
DeepSeq.NFData, Int -> Number -> ShowS
[Number] -> ShowS
Number -> String
(Int -> Number -> ShowS)
-> (Number -> String) -> ([Number] -> ShowS) -> Show Number
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)

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
    WriterT Builder Identity () -> Encoder ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (WriterT Builder Identity () -> Encoder ())
-> (Builder -> WriterT Builder Identity ())
-> Builder
-> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> WriterT Builder Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell (Builder -> Encoder ()) -> Builder -> Encoder ()
forall a b. (a -> b) -> a -> b
$ Integer -> Builder
Builder.integerDec Integer
s
    Bool -> Encoder () -> Encoder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Integer
e Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
        (Encoder () -> Encoder ())
-> (Builder -> Encoder ()) -> Builder -> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT Builder Identity () -> Encoder ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
        (WriterT Builder Identity () -> Encoder ())
-> (Builder -> WriterT Builder Identity ())
-> Builder
-> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> WriterT Builder Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell
        (Builder -> Encoder ()) -> Builder -> Encoder ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
Builder.word8 Word8
Literal.latinSmallLetterE
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Integer -> Builder
Builder.integerDec Integer
e

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

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

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

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