module ClickHaskell.Primitive.TDecimal where

-- Internal
import ClickHaskell.Primitive.Serialization
import ClickHaskell.Primitive.TInt ()

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

{- |
Read the official ClickHouse documentation for the `Decimal(p, s)` type before use.

In Haskell, this type is represented as a newtype over `Fixed (10 ^ s)`,
allowing arbitrarily large integer parts, whereas ClickHouse stores decimals
as scaled `Int32` values, which may discard some of the integer part if `s` is large.

See test №6 for an example of potential truncation due to a large scale.

>>> chTypeName @(Decimal32 9 1)
"Decimal(9, 1)"
>>> 1000.1 :: Decimal32 1 1
1000.1
>>> 1000.1 :: Decimal32 9 5
1000.10000
-}
newtype Decimal32 (p :: Nat) (s :: Nat) = MkDecimal32 (Fixed (10 ^ s))

deriving newtype instance KnownNat (10^s) => Show (Decimal32 p s)
deriving newtype instance KnownNat (10^s) => Eq (Decimal32 p s)
deriving newtype instance KnownNat (10^s) => Ord (Decimal32 p s)
deriving newtype instance KnownNat (10^s) => Num (Decimal32 p s)
deriving newtype instance KnownNat (10^s) => Fractional (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 = Fixed (10 ^ s) -> Decimal32 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal32 p s
MkDecimal32 Fixed (10 ^ s)
0

instance KnownNat (10 ^ s) => Serializable (Decimal32 p s) where
  serialize :: ProtocolRevision -> Decimal32 p s -> Builder
serialize ProtocolRevision
_ (MkDecimal32 (MkFixed Integer
int)) = Int32 -> Builder
int32LE (Int32 -> Builder) -> Int32 -> Builder
forall a b. (a -> b) -> a -> b
$ Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
int
  deserialize :: ProtocolRevision -> Get (Decimal32 p s)
deserialize ProtocolRevision
_ = Fixed (10 ^ s) -> Decimal32 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal32 p s
MkDecimal32 (Fixed (10 ^ s) -> Decimal32 p s)
-> (Int32 -> Fixed (10 ^ s)) -> Int32 -> Decimal32 p s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Fixed (10 ^ s)
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed (10 ^ s))
-> (Int32 -> Integer) -> Int32 -> Fixed (10 ^ s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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
  ) =>
  ToChType (Decimal32 p s) (Fixed sPowered) where
  toChType :: Fixed sPowered -> Decimal32 p s
toChType Fixed sPowered
fixed = Fixed (10 ^ s) -> Decimal32 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal32 p s
MkDecimal32 Fixed sPowered
Fixed (10 ^ s)
fixed
  fromChType :: Decimal32 p s -> Fixed sPowered
fromChType (MkDecimal32 Fixed (10 ^ s)
fixed) = Fixed sPowered
Fixed (10 ^ s)
fixed

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

{- |
Read the official ClickHouse documentation for the `Decimal(p, s)` type before use.

In Haskell, this type is represented as a newtype over `Fixed (10 ^ s)`,
allowing arbitrarily large integer parts, whereas ClickHouse stores decimals
as scaled `Int128` values, which may discard some of the integer part if `s` is large.

See test №6 for an example of potential truncation due to a large scale.

>>> chTypeName @(Decimal64 10 1)
"Decimal(10, 1)"
>>> 1000.1 :: Decimal64 10 1
1000.1
>>> 1000.1 :: Decimal64 10 5
1000.10000
-}
newtype Decimal64 (p :: Nat) (s :: Nat) = MkDecimal64 (Fixed (10 ^ s))

deriving newtype instance KnownNat (10^s) => Show (Decimal64 p s)
deriving newtype instance KnownNat (10^s) => Eq (Decimal64 p s)
deriving newtype instance KnownNat (10^s) => Ord (Decimal64 p s)
deriving newtype instance KnownNat (10^s) => Num (Decimal64 p s)
deriving newtype instance KnownNat (10^s) => Fractional (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 = Fixed (10 ^ s) -> Decimal64 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal64 p s
MkDecimal64 Fixed (10 ^ s)
0

instance KnownNat (10 ^ s) => Serializable (Decimal64 p s) where
  serialize :: ProtocolRevision -> Decimal64 p s -> Builder
serialize ProtocolRevision
_ (MkDecimal64 (MkFixed Integer
int)) = Int64 -> Builder
int64LE (Int64 -> Builder) -> Int64 -> Builder
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
int
  deserialize :: ProtocolRevision -> Get (Decimal64 p s)
deserialize ProtocolRevision
_ = Fixed (10 ^ s) -> Decimal64 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal64 p s
MkDecimal64 (Fixed (10 ^ s) -> Decimal64 p s)
-> (Int64 -> Fixed (10 ^ s)) -> Int64 -> Decimal64 p s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Fixed (10 ^ s)
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed (10 ^ s))
-> (Int64 -> Integer) -> Int64 -> Fixed (10 ^ s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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
  ) =>
  ToChType (Decimal64 p s) (Fixed sPowered) where
  toChType :: Fixed sPowered -> Decimal64 p s
toChType Fixed sPowered
fixed = Fixed (10 ^ s) -> Decimal64 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal64 p s
MkDecimal64 Fixed sPowered
Fixed (10 ^ s)
fixed
  fromChType :: Decimal64 p s -> Fixed sPowered
fromChType (MkDecimal64 Fixed (10 ^ s)
fixed) = Fixed sPowered
Fixed (10 ^ s)
fixed

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

{- |
Read the official ClickHouse documentation for the `Decimal(p, s)` type before use.

In Haskell, this type is represented as a newtype over `Fixed (10 ^ s)`,
allowing arbitrarily large integer parts, whereas ClickHouse stores decimals
as scaled `Int128` values, which may discard some of the integer part if `s` is large.

See test №6 for an example of potential truncation due to a large scale.

>>> chTypeName @(Decimal128 19 1)
"Decimal(19, 1)"
>>> 1000.1 :: Decimal128 19 1
1000.1
>>> 1000.1 :: Decimal128 19 5
1000.10000
-}
newtype Decimal128 (p :: Nat) (s :: Nat) = MkDecimal128 (Fixed (10 ^ s))

deriving newtype instance KnownNat (10^s) => Show (Decimal128 p s)
deriving newtype instance KnownNat (10^s) => Eq (Decimal128 p s)
deriving newtype instance KnownNat (10^s) => Ord (Decimal128 p s)
deriving newtype instance KnownNat (10^s) => Num (Decimal128 p s)
deriving newtype instance KnownNat (10^s) => Fractional (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 = Decimal128 p s
0

instance Serializable (Decimal128 p s) where
  serialize :: ProtocolRevision -> Decimal128 p s -> Builder
serialize ProtocolRevision
rev (MkDecimal128 (MkFixed Integer
int)) = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @Int128 ProtocolRevision
rev (Integer -> Int128
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
int)
  deserialize :: ProtocolRevision -> Get (Decimal128 p s)
deserialize ProtocolRevision
rev = Fixed (10 ^ s) -> Decimal128 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal128 p s
MkDecimal128 (Fixed (10 ^ s) -> Decimal128 p s)
-> (Int128 -> Fixed (10 ^ s)) -> Int128 -> Decimal128 p s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Fixed (10 ^ s)
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed (10 ^ s))
-> (Int128 -> Integer) -> Int128 -> Fixed (10 ^ s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int128 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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
  ) =>
  ToChType (Decimal128 p s) (Fixed sPowered) where
  toChType :: Fixed sPowered -> Decimal128 p s
toChType Fixed sPowered
fixed = Fixed (10 ^ s) -> Decimal128 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal128 p s
MkDecimal128 Fixed sPowered
Fixed (10 ^ s)
fixed
  fromChType :: Decimal128 p s -> Fixed sPowered
fromChType (MkDecimal128 Fixed (10 ^ s)
fixed) = Fixed sPowered
Fixed (10 ^ s)
fixed

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

{- |
Read the official ClickHouse documentation for the `Decimal(p, s)` type before use.

In Haskell, this type is represented as a newtype over `Fixed (10 ^ s)`,
allowing arbitrarily large integer parts, whereas ClickHouse stores decimals
as scaled `Int128` values, which may discard some of the integer part if `s` is large.

See test №6 for an example of potential truncation due to a large scale.

>>> chTypeName @(Decimal256 19 1)
"Decimal(19, 1)"
>>> 1000.1 :: Decimal256 19 1
1000.1
>>> 1000.1 :: Decimal256 19 5
1000.10000
-}
newtype Decimal256 (p :: Nat) (s :: Nat) = MkDecimal256 (Fixed (10 ^ s))

deriving newtype instance KnownNat (10^s) => Show (Decimal256 p s)
deriving newtype instance KnownNat (10^s) => Eq (Decimal256 p s)
deriving newtype instance KnownNat (10^s) => Ord (Decimal256 p s)
deriving newtype instance KnownNat (10^s) => Num (Decimal256 p s)
deriving newtype instance KnownNat (10^s) => Fractional (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 = Decimal256 p s
0

instance Serializable (Decimal256 p s) where
  serialize :: ProtocolRevision -> Decimal256 p s -> Builder
serialize ProtocolRevision
rev (MkDecimal256 (MkFixed Integer
int)) = forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize @Int256 ProtocolRevision
rev (Integer -> Int256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
int)
  deserialize :: ProtocolRevision -> Get (Decimal256 p s)
deserialize ProtocolRevision
rev = Fixed (10 ^ s) -> Decimal256 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal256 p s
MkDecimal256 (Fixed (10 ^ s) -> Decimal256 p s)
-> (Int256 -> Fixed (10 ^ s)) -> Int256 -> Decimal256 p s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Fixed (10 ^ s)
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed (10 ^ s))
-> (Int256 -> Integer) -> Int256 -> Fixed (10 ^ s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int256 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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
  ) =>
  ToChType (Decimal256 p s) (Fixed sPowered) where
  toChType :: Fixed sPowered -> Decimal256 p s
toChType Fixed sPowered
fixed = Fixed (10 ^ s) -> Decimal256 p s
forall (p :: Natural) (s :: Natural).
Fixed (10 ^ s) -> Decimal256 p s
MkDecimal256 Fixed sPowered
Fixed (10 ^ s)
fixed
  fromChType :: Decimal256 p s -> Fixed sPowered
fromChType (MkDecimal256 Fixed (10 ^ s)
fixed) = Fixed sPowered
Fixed (10 ^ s)
fixed

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"