{-# LANGUAGE
    AllowAmbiguousTypes
  , DataKinds
  , DefaultSignatures
  , DerivingStrategies
  , GeneralizedNewtypeDeriving
  , InstanceSigs
  , LambdaCase
  , NamedFieldPuns
  , OverloadedStrings
  , PolyKinds
  , RankNTypes
  , UndecidableInstances
  , UndecidableSuperClasses
#-}

module ClickHaskell.Writing
  ( WritableInto(..)
  , GWritable(..)
  , Serializable(..)
  ) where


-- Internal dependencies
import ClickHaskell.DbTypes
  ( Nullable
  , LowCardinality, IsLowCardinalitySupported
  , ChInt8, ChInt16, ChInt32, ChInt64, ChInt128
  , ChUInt8, ChUInt16, ChUInt32, ChUInt64, ChUInt128
  , ChString
  , ChUUID
  , ChDateTime
  , ToChType(..)
  , FromChType(..)
  )
import ClickHaskell.Tables (CompiledColumn(..), HasColumns(..), TakeColumn)


-- GHC included
import Data.ByteString         (StrictByteString)
import Data.ByteString.Builder as BS
  ( Builder, byteString
  , int8Dec, int16Dec, int32Dec, int64Dec
  , word8Dec, word16Dec, word32Dec, word64Dec
  , integerDec
  )
import Data.ByteString.Char8   as BS8 (concatMap, length, pack, replicate, singleton)
import Data.Kind (Constraint, Type)
import Data.Type.Bool (If)
import Data.UUID as UUID (toASCIIBytes)
import Data.Word (Word32)
import GHC.Generics (C1, D1, Generic (..), K1 (..), M1 (..), Meta (MetaSel), Rec0, S1, type (:*:) (..))
import GHC.TypeLits (ErrorMessage (..), TypeError)


-- * Writing

class
  ( HasColumns table
  , GWritable (GetColumns table) (Rep record)
  )
  =>
  WritableInto table record
  where
  default toTsvLine :: (Generic record) => record -> BS.Builder
  toTsvLine :: record -> BS.Builder
  toTsvLine = forall (columns :: [*]) (f :: * -> *) p.
GWritable columns f =>
f p -> Builder
forall {k} (columns :: [*]) (f :: k -> *) (p :: k).
GWritable columns f =>
f p -> Builder
gToTsvBs @(GetColumns table) (Rep record Any -> Builder)
-> (record -> Rep record Any) -> record -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> Rep record Any
forall x. record -> Rep record x
forall a x. Generic a => a -> Rep a x
from

  default writingColumns :: Builder
  writingColumns :: Builder
  writingColumns = forall (columns :: [*]) (f :: * -> *).
GWritable columns f =>
Builder
forall {k} (columns :: [*]) (f :: k -> *).
GWritable columns f =>
Builder
gWritingColumns @(GetColumns table) @(Rep record)


class GWritable
  (columns :: [Type])
  f
  where
  gToTsvBs :: f p -> Builder
  gWritingColumns :: Builder

instance
  GWritable columns f
  =>
  GWritable columns (D1 c (C1 c2 f))
  where
  gToTsvBs :: forall (p :: k). D1 c (C1 c2 f) p -> Builder
gToTsvBs (M1 (M1 f p
re)) = forall (columns :: [*]) (f :: k -> *) (p :: k).
GWritable columns f =>
f p -> Builder
forall {k} (columns :: [*]) (f :: k -> *) (p :: k).
GWritable columns f =>
f p -> Builder
gToTsvBs @columns f p
re Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
  gWritingColumns :: Builder
gWritingColumns = forall (columns :: [*]) (f :: k -> *).
GWritable columns f =>
Builder
forall {k} (columns :: [*]) (f :: k -> *).
GWritable columns f =>
Builder
gWritingColumns @columns @f

instance
  GWritable columns (left1 :*: (left2 :*: right))
  =>
  GWritable columns ((left1 :*: left2) :*: right)
  where
  gToTsvBs :: forall (p :: k). (:*:) (left1 :*: left2) right p -> Builder
gToTsvBs ((left1 p
left1 :*: left2 p
left2) :*: right p
right) = forall (columns :: [*]) (f :: k -> *) (p :: k).
GWritable columns f =>
f p -> Builder
forall {k} (columns :: [*]) (f :: k -> *) (p :: k).
GWritable columns f =>
f p -> Builder
gToTsvBs @columns (left1 p
left1 left1 p -> (:*:) left2 right p -> (:*:) left1 (left2 :*: right) p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (left2 p
left2 left2 p -> right p -> (:*:) left2 right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: right p
right))
  gWritingColumns :: Builder
gWritingColumns = forall (columns :: [*]) (f :: k -> *).
GWritable columns f =>
Builder
forall {k} (columns :: [*]) (f :: k -> *).
GWritable columns f =>
Builder
gWritingColumns @columns @(left1 :*: (left2 :*: right))

instance
  ( Serializable (GetColumnType column)
  , ToChType (GetColumnType column) inputType
  , CompiledColumn column
  , GWritable restColumns right
  , GWritable '[column] ((S1 (MetaSel (Just typeName) a b f)) (Rec0 inputType))
  , '(column, restColumns) ~ TakeColumn typeName columns
  )
  =>
  GWritable columns ((S1 (MetaSel (Just typeName) a b f)) (Rec0 inputType) :*: right)
  where
  gToTsvBs :: forall (p :: k).
(:*:)
  (S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType)) right p
-> Builder
gToTsvBs (M1 (K1 inputType
dataType) :*: right p
right)
    =  (GetColumnType column -> Builder
forall chType. Serializable chType => chType -> Builder
serialize (GetColumnType column -> Builder)
-> (inputType -> GetColumnType column) -> inputType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @(GetColumnType column)) inputType
dataType
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\t"
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) (f :: k -> *) (p :: k).
GWritable columns f =>
f p -> Builder
forall {k} (columns :: [*]) (f :: k -> *) (p :: k).
GWritable columns f =>
f p -> Builder
gToTsvBs @restColumns right p
right
  gWritingColumns :: Builder
gWritingColumns = forall columnDescription.
CompiledColumn columnDescription =>
Builder
forall {k} (columnDescription :: k).
CompiledColumn columnDescription =>
Builder
renderColumnName @column Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (columns :: [*]) (f :: k -> *).
GWritable columns f =>
Builder
forall {k} (columns :: [*]) (f :: k -> *).
GWritable columns f =>
Builder
gWritingColumns @restColumns @right

instance
  ( ThereIsNoWriteRequiredColumns restColumns
  , Serializable (GetColumnType column)
  , ToChType (GetColumnType column) inputType
  , CompiledColumn column
  , '(column, restColumns) ~ TakeColumn typeName columns
  ) =>
  GWritable columns (S1 (MetaSel (Just typeName) a b f) (Rec0 inputType))
  where
  gToTsvBs :: forall (p :: k).
S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType) p -> Builder
gToTsvBs = GetColumnType column -> Builder
forall chType. Serializable chType => chType -> Builder
serialize (GetColumnType column -> Builder)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType) p
    -> GetColumnType column)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType) p
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @(GetColumnType column) @inputType (inputType -> GetColumnType column)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType) p
    -> inputType)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType) p
-> GetColumnType column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R inputType p -> inputType
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R inputType p -> inputType)
-> (S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType) p
    -> K1 R inputType p)
-> S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType) p
-> inputType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel ('Just typeName) a b f) (Rec0 inputType) p
-> K1 R inputType p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  gWritingColumns :: Builder
gWritingColumns = forall columnDescription.
CompiledColumn columnDescription =>
Builder
forall {k} (columnDescription :: k).
CompiledColumn columnDescription =>
Builder
renderColumnName @column


type family ThereIsNoWriteRequiredColumns (columns :: [Type]) :: Constraint where
  ThereIsNoWriteRequiredColumns '[] = ()
  ThereIsNoWriteRequiredColumns (column ': columns) =
    If
      (WriteOptionalColumn column)
      (ThereIsNoWriteRequiredColumns columns)
      (TypeError ('Text "Column " :<>: 'Text (GetColumnName column) :<>: 'Text " is required for insert but is missing"))




-- * Serialization

class
  Serializable chType
  where
  serialize :: chType -> Builder

instance
  Serializable chType
  =>
  Serializable (Nullable chType)
  where
  serialize :: Nullable chType -> Builder
serialize = Builder -> (chType -> Builder) -> Nullable chType -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"\\N" chType -> Builder
forall chType. Serializable chType => chType -> Builder
serialize

instance
  ( Serializable chType
  , FromChType chType chType
  , IsLowCardinalitySupported chType
  ) =>
  Serializable (LowCardinality chType)
  where
  serialize :: LowCardinality chType -> Builder
serialize = forall chType. Serializable chType => chType -> Builder
serialize @chType (chType -> Builder)
-> (LowCardinality chType -> chType)
-> LowCardinality chType
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @(LowCardinality chType)

instance Serializable ChUUID
  where
  serialize :: ChUUID -> Builder
serialize = ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ChUUID -> ByteString) -> ChUUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toASCIIBytes (UUID -> ByteString) -> (ChUUID -> UUID) -> ChUUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUUID -> UUID
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance Serializable ChString
  where
  serialize :: ChString -> Builder
serialize = (ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
escape) (ByteString -> Builder)
-> (ChString -> ByteString) -> ChString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChString -> ByteString
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

escape :: StrictByteString -> StrictByteString
escape :: ByteString -> ByteString
escape -- [ClickHaskell.DbTypes.ToDo.2]: Optimize
  = (Char -> ByteString) -> ByteString -> ByteString
BS8.concatMap
    (\case
      Char
'\t' -> ByteString
"\\t"
      Char
'\n' -> ByteString
"\\n"
      Char
'\\' -> ByteString
"\\\\"
      Char
sym -> Char -> ByteString
BS8.singleton Char
sym
    )

instance Serializable ChInt8
  where
  serialize :: ChInt8 -> Builder
serialize = Int8 -> Builder
BS.int8Dec (Int8 -> Builder) -> (ChInt8 -> Int8) -> ChInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt8 -> Int8
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance Serializable ChInt16
  where
  serialize :: ChInt16 -> Builder
serialize = Int16 -> Builder
BS.int16Dec (Int16 -> Builder) -> (ChInt16 -> Int16) -> ChInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt16 -> Int16
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType 

instance Serializable ChInt32
  where
  serialize :: ChInt32 -> Builder
serialize = Int32 -> Builder
BS.int32Dec (Int32 -> Builder) -> (ChInt32 -> Int32) -> ChInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt32 -> Int32
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance Serializable ChInt64
  where
  serialize :: ChInt64 -> Builder
serialize = Int64 -> Builder
BS.int64Dec (Int64 -> Builder) -> (ChInt64 -> Int64) -> ChInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt64 -> Int64
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance Serializable ChInt128
  where
  serialize :: ChInt128 -> Builder
serialize = Integer -> Builder
BS.integerDec (Integer -> Builder)
-> (ChInt128 -> Integer) -> ChInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChInt128 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance Serializable ChUInt8
  where
  serialize :: ChUInt8 -> Builder
serialize = Word8 -> Builder
BS.word8Dec (Word8 -> Builder) -> (ChUInt8 -> Word8) -> ChUInt8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt8 -> Word8
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance Serializable ChUInt16
  where
  serialize :: ChUInt16 -> Builder
serialize = Word16 -> Builder
BS.word16Dec (Word16 -> Builder) -> (ChUInt16 -> Word16) -> ChUInt16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt16 -> Word16
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance Serializable ChUInt32
  where
  serialize :: ChUInt32 -> Builder
serialize = Word32 -> Builder
BS.word32Dec (Word32 -> Builder) -> (ChUInt32 -> Word32) -> ChUInt32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt32 -> Word32
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance Serializable ChUInt64
  where
  serialize :: ChUInt64 -> Builder
serialize = Word64 -> Builder
BS.word64Dec (Word64 -> Builder) -> (ChUInt64 -> Word64) -> ChUInt64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt64 -> Word64
forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType

instance Serializable ChUInt128
  where
  serialize :: ChUInt128 -> Builder
serialize = Integer -> Builder
BS.integerDec (Integer -> Builder)
-> (ChUInt128 -> Integer) -> ChUInt128 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChUInt128 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance Serializable ChDateTime where
  serialize :: ChDateTime -> Builder
serialize ChDateTime
chDateTime
    = let time :: ByteString
time = String -> ByteString
BS8.pack (String -> ByteString)
-> (ChDateTime -> String) -> ChDateTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show (Word32 -> String)
-> (ChDateTime -> Word32) -> ChDateTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @ChDateTime @Word32 (ChDateTime -> ByteString) -> ChDateTime -> ByteString
forall a b. (a -> b) -> a -> b
$ ChDateTime
chDateTime
    in ByteString -> Builder
BS.byteString (Int -> Char -> ByteString
BS8.replicate (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS8.length ByteString
time) Char
'0' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
time)