module ClickHaskell.Primitive.TDecimal where

-- Internal
import ClickHaskell.Primitive.Serialization
import ClickHaskell.Primitive.TInt (Int64, Int32)

-- GHC included
import Data.Binary.Get
import Data.ByteString.Builder
import Data.Fixed (Fixed (..))
import Data.Kind (Constraint)
import Data.Type.Bool
import Data.Type.Ord
import Data.Typeable (Proxy (..))
import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (^))

-- External
import Data.WideWord (Int128 (..), Int256)
import Data.ByteString.Char8 as BS8 (pack)


-- ** Decimal32

{- |
>>> chTypeName @(Decimal32 9 1)
"Decimal(9, 1)"
>>> toChType @(Decimal32 1 1) @(Fixed (10^1)) 100000.1
100000.1
>>> toChType @(Decimal32 9 5) @(Fixed (10^5)) (10^4 + 0.1)
10000.10000

Note: there are no overflow checks

>>> toChType @(Decimal32 9 5) @(Fixed (10^5)) (10^5 + 0.1)
14100.75408
-}
newtype Decimal32 (p :: Nat) (s :: Nat) = MkDecimal32 Int32

instance KnownNat (10^s) => Show (Decimal32 p s) where
  show :: Decimal32 p s -> String
show (MkDecimal32 Int32
int32) = Fixed (10 ^ s) -> String
forall a. Show a => a -> String
show (Fixed (10 ^ s) -> String) -> Fixed (10 ^ s) -> String
forall a b. (a -> b) -> a -> b
$ forall k (a :: k). Integer -> Fixed a
MkFixed @_ @(10^s)(Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
int32)
deriving newtype instance KnownNat (10^s) => Eq (Decimal32 p s)
deriving newtype instance KnownNat (10^s) => Ord (Decimal32 p s)

instance
  (ValidRanges 32 1 9 p s, KnownNat p, KnownNat s, KnownNat (10 ^ s))
  =>
  IsChType (Decimal32 p s) where
  chTypeName :: String
chTypeName =
    let p :: String
p = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)
        s :: String
s = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal @s Proxy s
forall {k} (t :: k). Proxy t
Proxy)
    in String
"Decimal(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", "String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  defaultValueOfTypeName :: Decimal32 p s
defaultValueOfTypeName = Int32 -> Decimal32 p s
forall (p :: Natural) (s :: Natural). Int32 -> Decimal32 p s
MkDecimal32 Int32
0

instance KnownNat (10 ^ s) => Serializable (Decimal32 p s) where
  serialize :: ProtocolRevision -> Decimal32 p s -> Builder
serialize ProtocolRevision
_ (MkDecimal32 Int32
int) = Int32 -> Builder
int32LE Int32
int
  deserialize :: ProtocolRevision -> Get (Decimal32 p s)
deserialize ProtocolRevision
_ = Int32 -> Decimal32 p s
forall (p :: Natural) (s :: Natural). Int32 -> Decimal32 p s
MkDecimal32 (Int32 -> Decimal32 p s) -> Get Int32 -> Get (Decimal32 p s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32le
  {-# INLINE deserialize #-}

instance
  ( sPowered ~ 10^s
  , IsChType (Decimal32 p s)
  ) =>
  ToChType (Decimal32 p s) (Fixed sPowered) where
  toChType :: Fixed sPowered -> Decimal32 p s
toChType (MkFixed Integer
fixedRep) = Int32 -> Decimal32 p s
forall (p :: Natural) (s :: Natural). Int32 -> Decimal32 p s
MkDecimal32 (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fixedRep)
  fromChType :: Decimal32 p s -> Fixed sPowered
fromChType (MkDecimal32 Int32
int32) = Integer -> Fixed sPowered
forall k (a :: k). Integer -> Fixed a
MkFixed (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
int32)

instance KnownNat (10^s) => ToQueryPart (Decimal32 p s) where
  toQueryPart :: Decimal32 p s -> Builder
toQueryPart Decimal32 p s
dec = StrictByteString -> Builder
byteString (String -> StrictByteString
BS8.pack (String -> StrictByteString) -> String -> StrictByteString
forall a b. (a -> b) -> a -> b
$ Decimal32 p s -> String
forall a. Show a => a -> String
show Decimal32 p s
dec)


-- ** Decimal64

{- |
>>> chTypeName @(Decimal64 10 1)
"Decimal(10, 1)"
>>> toChType @(Decimal64 10 5) @(Fixed (10^5)) (10^13 + 0.1)
10000000000000.10000

Note: there are no overflow checks

>>> toChType @(Decimal64 10 5) @(Fixed (10^5)) (10^14 + 0.1)
-84467440737095.41616
-}
newtype Decimal64 (p :: Nat) (s :: Nat) = MkDecimal64 Int64

instance KnownNat (10^s) => Show (Decimal64 p s) where
  show :: Decimal64 p s -> String
show (MkDecimal64 Int64
int64) = Fixed (10 ^ s) -> String
forall a. Show a => a -> String
show (Fixed (10 ^ s) -> String) -> Fixed (10 ^ s) -> String
forall a b. (a -> b) -> a -> b
$ forall k (a :: k). Integer -> Fixed a
MkFixed @_ @(10^s)(Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
int64)
deriving newtype instance KnownNat (10^s) => Eq (Decimal64 p s)
deriving newtype instance KnownNat (10^s) => Ord (Decimal64 p s)

instance
  (ValidRanges 64 10 18 p s, KnownNat p, KnownNat s, KnownNat (10 ^ s))
  =>
  IsChType (Decimal64 p s) where
  chTypeName :: String
chTypeName =
    let p :: String
p = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)
        s :: String
s = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal @s Proxy s
forall {k} (t :: k). Proxy t
Proxy)
    in String
"Decimal(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", "String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  defaultValueOfTypeName :: Decimal64 p s
defaultValueOfTypeName = Int64 -> Decimal64 p s
forall (p :: Natural) (s :: Natural). Int64 -> Decimal64 p s
MkDecimal64 Int64
0

instance KnownNat (10 ^ s) => Serializable (Decimal64 p s) where
  serialize :: ProtocolRevision -> Decimal64 p s -> Builder
serialize ProtocolRevision
_ (MkDecimal64 Int64
int) = Int64 -> Builder
int64LE Int64
int
  deserialize :: ProtocolRevision -> Get (Decimal64 p s)
deserialize ProtocolRevision
_ = Int64 -> Decimal64 p s
forall (p :: Natural) (s :: Natural). Int64 -> Decimal64 p s
MkDecimal64 (Int64 -> Decimal64 p s) -> Get Int64 -> Get (Decimal64 p s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
  {-# INLINE deserialize #-}

instance
  ( sPowered ~ 10^s
  , IsChType (Decimal64 p s)
  ) =>
  ToChType (Decimal64 p s) (Fixed sPowered) where
  toChType :: Fixed sPowered -> Decimal64 p s
toChType (MkFixed Integer
fixedRep) = Int64 -> Decimal64 p s
forall (p :: Natural) (s :: Natural). Int64 -> Decimal64 p s
MkDecimal64 (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fixedRep)
  fromChType :: Decimal64 p s -> Fixed sPowered
fromChType (MkDecimal64 Int64
int64) = Integer -> Fixed sPowered
forall k (a :: k). Integer -> Fixed a
MkFixed (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
int64)

instance KnownNat (10^s) => ToQueryPart (Decimal64 p s) where
  toQueryPart :: Decimal64 p s -> Builder
toQueryPart Decimal64 p s
dec = StrictByteString -> Builder
byteString (String -> StrictByteString
BS8.pack (String -> StrictByteString) -> String -> StrictByteString
forall a b. (a -> b) -> a -> b
$ Decimal64 p s -> String
forall a. Show a => a -> String
show Decimal64 p s
dec)


-- ** Decimal128

{- |
>>> chTypeName @(Decimal128 19 1)
"Decimal(19, 1)"
>>> toChType @(Decimal128 19 5) @(Fixed (10^5)) (10^33 + 0.1)
1000000000000000000000000000000000.10000

Note: there are no overflow checks

>>> toChType @(Decimal128 19 5) @(Fixed (10^5)) (10^34 + 0.1)
-208471007628153903901238222953046.24368
-}
newtype Decimal128 (p :: Nat) (s :: Nat) = MkDecimal128 Int128

instance KnownNat (10^s) => Show (Decimal128 p s) where
  show :: Decimal128 p s -> String
show (MkDecimal128 Int128
int128) = Fixed (10 ^ s) -> String
forall a. Show a => a -> String
show (Fixed (10 ^ s) -> String) -> Fixed (10 ^ s) -> String
forall a b. (a -> b) -> a -> b
$ forall k (a :: k). Integer -> Fixed a
MkFixed @_ @(10^s)(Int128 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int128
int128)
deriving newtype instance KnownNat (10^s) => Eq (Decimal128 p s)
deriving newtype instance KnownNat (10^s) => Ord (Decimal128 p s)

instance
  (ValidRanges 128 19 38 p s, KnownNat p, KnownNat s, KnownNat (10 ^ s))
  =>
  IsChType (Decimal128 p s) where
  chTypeName :: String
chTypeName =
    let p :: String
p = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)
        s :: String
s = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal @s Proxy s
forall {k} (t :: k). Proxy t
Proxy)
    in String
"Decimal(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", "String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  defaultValueOfTypeName :: Decimal128 p s
defaultValueOfTypeName = Int128 -> Decimal128 p s
forall (p :: Natural) (s :: Natural). Int128 -> Decimal128 p s
MkDecimal128 Int128
0

instance Serializable (Decimal128 p s) where
  serialize :: ProtocolRevision -> Decimal128 p s -> Builder
serialize ProtocolRevision
rev (MkDecimal128 Int128
int) = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @Int128 ProtocolRevision
rev Int128
int
  deserialize :: ProtocolRevision -> Get (Decimal128 p s)
deserialize ProtocolRevision
rev = Int128 -> Decimal128 p s
forall (p :: Natural) (s :: Natural). Int128 -> Decimal128 p s
MkDecimal128 (Int128 -> Decimal128 p s) -> Get Int128 -> Get (Decimal128 p s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @Int128 ProtocolRevision
rev
  {-# INLINE deserialize #-}

instance
  ( sPowered ~ 10^s
  , IsChType (Decimal128 p s)
  ) =>
  ToChType (Decimal128 p s) (Fixed sPowered) where
  toChType :: Fixed sPowered -> Decimal128 p s
toChType (MkFixed Integer
fixedRep) = Int128 -> Decimal128 p s
forall (p :: Natural) (s :: Natural). Int128 -> Decimal128 p s
MkDecimal128 (Integer -> Int128
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fixedRep)
  fromChType :: Decimal128 p s -> Fixed sPowered
fromChType (MkDecimal128 Int128
int128) = Integer -> Fixed sPowered
forall k (a :: k). Integer -> Fixed a
MkFixed (Int128 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int128
int128)

instance KnownNat (10^s) => ToQueryPart (Decimal128 p s) where
  toQueryPart :: Decimal128 p s -> Builder
toQueryPart Decimal128 p s
dec = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
byteString (String -> StrictByteString
BS8.pack (String -> StrictByteString) -> String -> StrictByteString
forall a b. (a -> b) -> a -> b
$ Decimal128 p s -> String
forall a. Show a => a -> String
show Decimal128 p s
dec) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"


-- ** Decimal256

{- |
>>> chTypeName @(Decimal256 39 1)
"Decimal(39, 1)"
>>> toChType @(Decimal256 39 1) @(Fixed (10^1)) (10^71 + 0.1)
100000000000000000000000000000000000000000000000000000000000000000000000.1

Note: there are no overflow checks

>>> toChType @(Decimal256 39 5) @(Fixed (10^5)) (10^72 + 0.1)
-157920892373161954235709850086879078532699846656405640394575840079131296.29936
-}
newtype Decimal256 (p :: Nat) (s :: Nat) = MkDecimal256 Int256

instance KnownNat (10^s) => Show (Decimal256 p s) where
  show :: Decimal256 p s -> String
show (MkDecimal256 Int256
int256) = Fixed (10 ^ s) -> String
forall a. Show a => a -> String
show (Fixed (10 ^ s) -> String) -> Fixed (10 ^ s) -> String
forall a b. (a -> b) -> a -> b
$ forall k (a :: k). Integer -> Fixed a
MkFixed @_ @(10^s)(Int256 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int256
int256)
deriving newtype instance KnownNat (10^s) => Eq (Decimal256 p s)
deriving newtype instance KnownNat (10^s) => Ord (Decimal256 p s)

instance
  (ValidRanges 256 39 76 p s, KnownNat p, KnownNat s, KnownNat (10 ^ s))
  =>
  IsChType (Decimal256 p s) where
  chTypeName :: String
chTypeName =
    let p :: String
p = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)
        s :: String
s = Integer -> String
forall a. Show a => a -> String
show (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal @s Proxy s
forall {k} (t :: k). Proxy t
Proxy)
    in String
"Decimal(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", "String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  defaultValueOfTypeName :: Decimal256 p s
defaultValueOfTypeName = Int256 -> Decimal256 p s
forall (p :: Natural) (s :: Natural). Int256 -> Decimal256 p s
MkDecimal256 Int256
0

instance Serializable (Decimal256 p s) where
  serialize :: ProtocolRevision -> Decimal256 p s -> Builder
serialize ProtocolRevision
rev (MkDecimal256 Int256
int) = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @Int256 ProtocolRevision
rev Int256
int
  deserialize :: ProtocolRevision -> Get (Decimal256 p s)
deserialize ProtocolRevision
rev = Int256 -> Decimal256 p s
forall (p :: Natural) (s :: Natural). Int256 -> Decimal256 p s
MkDecimal256 (Int256 -> Decimal256 p s) -> Get Int256 -> Get (Decimal256 p s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall chType.
Serializable chType =>
ProtocolRevision -> Get chType
deserialize @Int256 ProtocolRevision
rev
  {-# INLINE deserialize #-}

instance
  ( sPowered ~ 10^s
  , IsChType (Decimal256 p s)
  ) =>
  ToChType (Decimal256 p s) (Fixed sPowered) where
  toChType :: Fixed sPowered -> Decimal256 p s
toChType (MkFixed Integer
fixedRep) = Int256 -> Decimal256 p s
forall (p :: Natural) (s :: Natural). Int256 -> Decimal256 p s
MkDecimal256 (Integer -> Int256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
fixedRep)
  fromChType :: Decimal256 p s -> Fixed sPowered
fromChType (MkDecimal256 Int256
int256) = Integer -> Fixed sPowered
forall k (a :: k). Integer -> Fixed a
MkFixed (Int256 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int256
int256)

instance KnownNat (10^s) => ToQueryPart (Decimal256 p s) where
  toQueryPart :: Decimal256 p s -> Builder
toQueryPart Decimal256 p s
dec = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
byteString (String -> StrictByteString
BS8.pack (String -> StrictByteString) -> String -> StrictByteString
forall a b. (a -> b) -> a -> b
$ Decimal256 p s -> String
forall a. Show a => a -> String
show Decimal256 p s
dec) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"


-- Range validations

type family ValidRanges (size :: Nat) (pMin :: Nat) (pMax :: Nat) (p :: Nat) (s :: Nat) :: Constraint
  where
  ValidRanges size pMin pMax p s =
    If (p >=? 0 && s <=? p)
      (
        If
          (pMin <=? p && p <=? pMax)
          (() :: Constraint)
          (TypeError
            (    'Text "Precision (p=" :<>: ShowType p :<>: 'Text ") should satisfy "
            :<>: ShowType pMin :<>: 'Text " <= p <= " :<>: ShowType pMax
            :<>: 'Text " for " :<>: DecimalType size
            )
          )
      )
      (TypeError
        (    'Text "Scale (s=" :<>: ShowType s :<>: 'Text ") and "
        :<>: 'Text "precision (p=" :<>: ShowType p :<>: 'Text ") "
        :<>: 'Text "should satisfy 0 <= s <= p for "
        :<>: DecimalType size
        )
      )

type DecimalType (size :: Nat) = 'Text "Decimal" :<>: ShowType size :<>: 'Text " type"