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

module ClickHaskell.Reading
  ( ReadableFrom(..)
  , GReadable(..)
  , Deserializable(..)
  ) where


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


-- GHC included
import Data.ByteString         as BS (StrictByteString, drop, take, empty)
import Data.ByteString.Char8   as BS8 (span, readInt, readInteger, break, unpack)
import Data.ByteString.Builder as BS (Builder)
import Data.Kind               (Type)
import GHC.Generics            (K1(..), M1(..), type (:*:)(..), Rec0, D1, C1, S1, Meta(MetaSel), Generic (..))
import Data.Maybe (fromJust)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Time (parseTimeM, defaultTimeLocale)
import qualified Data.UUID as UUID
import Data.Int (Int16, Int8, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64)

-- External
import Data.WideWord

-- * Reading

class
  ( HasColumns hasColumns
  , GReadable (GetColumns hasColumns) (Rep record)
  ) =>
  ReadableFrom hasColumns record
  where

  default fromTsvLine :: (Generic record) => StrictByteString -> record
  fromTsvLine :: StrictByteString -> record
  fromTsvLine = Rep record Any -> record
forall a x. Generic a => Rep a x -> a
forall x. Rep record x -> record
to (Rep record Any -> record)
-> (ByteString -> Rep record Any) -> ByteString -> record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (columns :: [*]) (f :: * -> *) p.
GReadable columns f =>
ByteString -> f p
forall {k} (columns :: [*]) (f :: k -> *) (p :: k).
GReadable columns f =>
ByteString -> f p
gFromTsvBs @(GetColumns hasColumns)

  default readingColumns :: (Generic record) => Builder
  readingColumns :: Builder
  readingColumns = forall (columns :: [*]) (f :: * -> *).
GReadable columns f =>
Builder
forall {k} (columns :: [*]) (f :: k -> *).
GReadable columns f =>
Builder
gReadingColumns @(GetColumns hasColumns) @(Rep record)

class GReadable
  (columns :: [Type])
  f
  where
  gFromTsvBs :: StrictByteString -> f p
  gReadingColumns :: Builder

instance
  GReadable columns f
  =>
  GReadable columns (D1 c (C1 c2 f))
  where
  gFromTsvBs :: forall (p :: k). ByteString -> D1 c (C1 c2 f) p
gFromTsvBs = C1 c2 f p -> M1 D c (C1 c2 f) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (C1 c2 f p -> M1 D c (C1 c2 f) p)
-> (ByteString -> C1 c2 f p) -> ByteString -> M1 D c (C1 c2 f) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f p -> C1 c2 f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> C1 c2 f p)
-> (ByteString -> f p) -> ByteString -> C1 c2 f p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (columns :: [*]) (f :: k -> *) (p :: k).
GReadable columns f =>
ByteString -> f p
forall {k} (columns :: [*]) (f :: k -> *) (p :: k).
GReadable columns f =>
ByteString -> f p
gFromTsvBs @columns
  gReadingColumns :: Builder
gReadingColumns = forall (columns :: [*]) (f :: k -> *).
GReadable columns f =>
Builder
forall {k} (columns :: [*]) (f :: k -> *).
GReadable columns f =>
Builder
gReadingColumns @columns @f


instance
  GReadable columns (left1 :*: (left2 :*: right))
  =>
  GReadable columns ((left1 :*: left2) :*: right)
  where
  gFromTsvBs :: forall (p :: k). ByteString -> (:*:) (left1 :*: left2) right p
gFromTsvBs ByteString
bs =
    let (left1 p
left1 :*: (left2 p
left2 :*: right p
right)) = forall (columns :: [*]) (f :: k -> *) (p :: k).
GReadable columns f =>
ByteString -> f p
forall {k} (columns :: [*]) (f :: k -> *) (p :: k).
GReadable columns f =>
ByteString -> f p
gFromTsvBs @columns ByteString
bs
    in ((left1 p
left1 left1 p -> left2 p -> (:*:) left1 left2 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: left2 p
left2) (:*:) left1 left2 p -> right p -> (:*:) (left1 :*: left2) right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: right p
right)
  gReadingColumns :: Builder
gReadingColumns = forall (columns :: [*]) (f :: k -> *).
GReadable columns f =>
Builder
forall {k} (columns :: [*]) (f :: k -> *).
GReadable columns f =>
Builder
gReadingColumns @columns @(left1 :*: (left2 :*: right))

instance
  ( CompiledColumn column
  , '(column, restColumns) ~ TakeColumn selectorName columns
  , FromChType (GetColumnType column) inputType
  , Deserializable (GetColumnType column)
  , GReadable restColumns right
  ) => GReadable columns (S1 (MetaSel (Just selectorName) a b f) (Rec0 inputType) :*: right)
  where
  gFromTsvBs :: forall (p :: k).
ByteString
-> (:*:)
     (S1 ('MetaSel ('Just selectorName) a b f) (Rec0 inputType)) right p
gFromTsvBs ByteString
bs = 
    let (ByteString
beforeTab, ByteString
afterTab) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t') ByteString
bs 
    in 
    (Rec0 inputType p
-> M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 inputType p
 -> M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p)
-> (ByteString -> Rec0 inputType p)
-> ByteString
-> M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. inputType -> Rec0 inputType p
forall k i c (p :: k). c -> K1 i c p
K1 (inputType -> Rec0 inputType p)
-> (ByteString -> inputType) -> ByteString -> Rec0 inputType p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @(GetColumnType column) (GetColumnType column -> inputType)
-> (ByteString -> GetColumnType column) -> ByteString -> inputType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> GetColumnType column
forall chType. Deserializable chType => ByteString -> chType
deserialize (ByteString
 -> M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p)
-> ByteString
-> M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p
forall a b. (a -> b) -> a -> b
$ ByteString
beforeTab) M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p
-> right p
-> (:*:)
     (S1 ('MetaSel ('Just selectorName) a b f) (Rec0 inputType)) right p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (columns :: [*]) (f :: k -> *) (p :: k).
GReadable columns f =>
ByteString -> f p
forall {k} (columns :: [*]) (f :: k -> *) (p :: k).
GReadable columns f =>
ByteString -> f p
gFromTsvBs @restColumns @right (Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
afterTab)
  gReadingColumns :: Builder
gReadingColumns = 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 -> *).
GReadable columns f =>
Builder
forall {k} (columns :: [*]) (f :: k -> *).
GReadable columns f =>
Builder
gReadingColumns @restColumns @right

instance
  ( CompiledColumn column
  , '(column, restColumns) ~ TakeColumn selectorName columns
  , Deserializable (GetColumnType column)
  , FromChType (GetColumnType column) inputType
  ) => GReadable columns ((S1 (MetaSel (Just selectorName) a b f)) (Rec0 inputType))
  where
  gFromTsvBs :: forall (p :: k).
ByteString
-> S1 ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p
gFromTsvBs = Rec0 inputType p
-> M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 inputType p
 -> M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p)
-> (ByteString -> Rec0 inputType p)
-> ByteString
-> M1 S ('MetaSel ('Just selectorName) a b f) (Rec0 inputType) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. inputType -> Rec0 inputType p
forall k i c (p :: k). c -> K1 i c p
K1 (inputType -> Rec0 inputType p)
-> (ByteString -> inputType) -> ByteString -> Rec0 inputType p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chType outputType.
FromChType chType outputType =>
chType -> outputType
fromChType @(GetColumnType column) (GetColumnType column -> inputType)
-> (ByteString -> GetColumnType column) -> ByteString -> inputType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> GetColumnType column
forall chType. Deserializable chType => ByteString -> chType
deserialize
  gReadingColumns :: Builder
gReadingColumns = forall columnDescription.
CompiledColumn columnDescription =>
Builder
forall {k} (columnDescription :: k).
CompiledColumn columnDescription =>
Builder
renderColumnName @column




-- * Deserialization

class
  Deserializable chType
  where
  deserialize :: StrictByteString -> chType

instance
  Deserializable chType
  =>
  Deserializable (Nullable chType)
  where
  deserialize :: ByteString -> Nullable chType
deserialize ByteString
"\\N" = Nullable chType
forall a. Maybe a
Nothing
  deserialize ByteString
someTypeBs = chType -> Nullable chType
forall a. a -> Maybe a
Just (ByteString -> chType
forall chType. Deserializable chType => ByteString -> chType
deserialize ByteString
someTypeBs)

instance
  ( Deserializable chType
  , ToChType chType chType
  , IsLowCardinalitySupported chType
  ) =>
  Deserializable (LowCardinality chType)
  where
  deserialize :: ByteString -> LowCardinality chType
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @(LowCardinality chType) @chType (chType -> LowCardinality chType)
-> (ByteString -> chType) -> ByteString -> LowCardinality chType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> chType
forall chType. Deserializable chType => ByteString -> chType
deserialize

instance Deserializable ChUUID
  where
  deserialize :: ByteString -> ChUUID
deserialize = UUID -> ChUUID
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (UUID -> ChUUID) -> (ByteString -> UUID) -> ByteString -> ChUUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID)
-> (ByteString -> Maybe UUID) -> ByteString -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe UUID
UUID.fromASCIIBytes

instance Deserializable ChString
  where
  deserialize :: ByteString -> ChString
deserialize = ByteString -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType (ByteString -> ChString)
-> (ByteString -> ByteString) -> ByteString -> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
deescape

-- There are a big trade off between safity and performance
-- Corner case strings with a lot of escaped symbols would reduce deserialization speed
-- ToDo: rewrite (de)serialization to work via binary clickhouse formats
deescape :: StrictByteString -> StrictByteString
deescape :: ByteString -> ByteString
deescape ByteString
bs = case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\\') ByteString
bs of
  (ByteString
beforeEscaping, ByteString
startWithEscaping) ->
    if ByteString
BS.empty ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
startWithEscaping
    then ByteString
bs
    else case Int -> ByteString -> ByteString
BS.take Int
2 ByteString
startWithEscaping of
      ByteString
"\\b" -> ByteString
beforeEscaping ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\b" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
startWithEscaping
      ByteString
"\\t" -> ByteString
beforeEscaping ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\t" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
startWithEscaping
      ByteString
"\\n" -> ByteString
beforeEscaping ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
startWithEscaping
      ByteString
"\\f" -> ByteString
beforeEscaping ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\f" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
startWithEscaping
      ByteString
"\\r" -> ByteString
beforeEscaping ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\r" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
startWithEscaping
      ByteString
"\\'" -> ByteString
beforeEscaping ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
startWithEscaping
      ByteString
"\\\\" -> ByteString
beforeEscaping ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\\" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
startWithEscaping
      ByteString
_ -> ByteString
bs

instance Deserializable ChInt8
  where
  deserialize :: ByteString -> ChInt8
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChInt8 @Int8 (Int8 -> ChInt8) -> (ByteString -> Int8) -> ByteString -> ChInt8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int8) -> (ByteString -> Int) -> ByteString -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int)
-> (ByteString -> (Int, ByteString)) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Int, ByteString) -> (Int, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, ByteString) -> (Int, ByteString))
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> (Int, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
BS8.readInt

instance Deserializable ChInt16
  where
  deserialize :: ByteString -> ChInt16
deserialize  = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChInt16 @Int16 (Int16 -> ChInt16)
-> (ByteString -> Int16) -> ByteString -> ChInt16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int16) -> (ByteString -> Int) -> ByteString -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int)
-> (ByteString -> (Int, ByteString)) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Int, ByteString) -> (Int, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, ByteString) -> (Int, ByteString))
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> (Int, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
BS8.readInt

instance Deserializable ChInt32
  where
  deserialize :: ByteString -> ChInt32
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChInt32 @Int32 (Int32 -> ChInt32)
-> (ByteString -> Int32) -> ByteString -> ChInt32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (ByteString -> Int) -> ByteString -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int)
-> (ByteString -> (Int, ByteString)) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Int, ByteString) -> (Int, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, ByteString) -> (Int, ByteString))
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> (Int, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
BS8.readInt

instance Deserializable ChInt64
  where
  deserialize :: ByteString -> ChInt64
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChInt64 @Int64 (Int64 -> ChInt64)
-> (ByteString -> Int64) -> ByteString -> ChInt64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a. Num a => Integer -> a
fromInteger (Integer -> Int64)
-> (ByteString -> Integer) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, ByteString) -> Integer
forall a b. (a, b) -> a
fst ((Integer, ByteString) -> Integer)
-> (ByteString -> (Integer, ByteString)) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Integer, ByteString) -> (Integer, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Integer, ByteString) -> (Integer, ByteString))
-> (ByteString -> Maybe (Integer, ByteString))
-> ByteString
-> (Integer, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Integer, ByteString)
BS8.readInteger

instance Deserializable ChInt128
  where
  deserialize :: ByteString -> ChInt128
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChInt128 @Int128 (Int128 -> ChInt128)
-> (ByteString -> Int128) -> ByteString -> ChInt128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int128
forall a. Num a => Integer -> a
fromInteger (Integer -> Int128)
-> (ByteString -> Integer) -> ByteString -> Int128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, ByteString) -> Integer
forall a b. (a, b) -> a
fst ((Integer, ByteString) -> Integer)
-> (ByteString -> (Integer, ByteString)) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Integer, ByteString) -> (Integer, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Integer, ByteString) -> (Integer, ByteString))
-> (ByteString -> Maybe (Integer, ByteString))
-> ByteString
-> (Integer, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Integer, ByteString)
BS8.readInteger

instance Deserializable ChUInt8
  where
  deserialize :: ByteString -> ChUInt8
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChUInt8 @Word8 (Word8 -> ChUInt8)
-> (ByteString -> Word8) -> ByteString -> ChUInt8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (ByteString -> Int) -> ByteString -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int)
-> (ByteString -> (Int, ByteString)) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Int, ByteString) -> (Int, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, ByteString) -> (Int, ByteString))
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> (Int, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
BS8.readInt

instance Deserializable ChUInt16
  where
  deserialize :: ByteString -> ChUInt16
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChUInt16 @Word16 (Word16 -> ChUInt16)
-> (ByteString -> Word16) -> ByteString -> ChUInt16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> (ByteString -> Int) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int)
-> (ByteString -> (Int, ByteString)) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Int, ByteString) -> (Int, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, ByteString) -> (Int, ByteString))
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> (Int, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
BS8.readInt

instance Deserializable ChUInt32
  where
  deserialize :: ByteString -> ChUInt32
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChUInt32 @Word32 (Word32 -> ChUInt32)
-> (ByteString -> Word32) -> ByteString -> ChUInt32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (ByteString -> Int) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int)
-> (ByteString -> (Int, ByteString)) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Int, ByteString) -> (Int, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, ByteString) -> (Int, ByteString))
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> (Int, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
BS8.readInt

instance Deserializable ChUInt64
  where
  deserialize :: ByteString -> ChUInt64
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChUInt64 @Word64 (Word64 -> ChUInt64)
-> (ByteString -> Word64) -> ByteString -> ChUInt64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64)
-> (ByteString -> Integer) -> ByteString -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, ByteString) -> Integer
forall a b. (a, b) -> a
fst ((Integer, ByteString) -> Integer)
-> (ByteString -> (Integer, ByteString)) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Integer, ByteString) -> (Integer, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Integer, ByteString) -> (Integer, ByteString))
-> (ByteString -> Maybe (Integer, ByteString))
-> ByteString
-> (Integer, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Integer, ByteString)
BS8.readInteger

instance Deserializable ChUInt128
  where
  deserialize :: ByteString -> ChUInt128
deserialize = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChUInt128 @Word128 (Word128 -> ChUInt128)
-> (ByteString -> Word128) -> ByteString -> ChUInt128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word128
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word128)
-> (ByteString -> Integer) -> ByteString -> Word128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, ByteString) -> Integer
forall a b. (a, b) -> a
fst ((Integer, ByteString) -> Integer)
-> (ByteString -> (Integer, ByteString)) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Integer, ByteString) -> (Integer, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Integer, ByteString) -> (Integer, ByteString))
-> (ByteString -> Maybe (Integer, ByteString))
-> ByteString
-> (Integer, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Integer, ByteString)
BS8.readInteger

instance Deserializable ChDateTime where
  deserialize :: ByteString -> ChDateTime
deserialize
    = forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType @ChDateTime @Word32 (Word32 -> ChDateTime)
-> (ByteString -> Word32) -> ByteString -> ChDateTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a. Num a => Integer -> a
fromInteger
    (Integer -> Word32)
-> (ByteString -> Integer) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> (ByteString -> POSIXTime) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
    (UTCTime -> POSIXTime)
-> (ByteString -> UTCTime) -> ByteString -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UTCTime -> UTCTime
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UTCTime -> UTCTime)
-> (ByteString -> Maybe UTCTime) -> ByteString -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
"%Y-%m-%d %H:%M:%S"
    (String -> Maybe UTCTime)
-> (ByteString -> String) -> ByteString -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS8.unpack