module ClickHaskell.Primitive.TUUID where

-- Internal
import ClickHaskell.Primitive.Serialization

-- GHC included
import Control.DeepSeq (NFData)
import Data.Bits
import Data.ByteString.Builder (Builder, word16HexFixed, word64LE)
import Data.Word (Word64)

-- External
import Data.Binary.Get (getWord64le)
import Data.WideWord (Word128(..))


{- | ClickHouse UUID column type -}
newtype UUID = MkUUID Word128
  deriving newtype (Int -> UUID -> ShowS
[UUID] -> ShowS
UUID -> String
(Int -> UUID -> ShowS)
-> (UUID -> String) -> ([UUID] -> ShowS) -> Show UUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UUID -> ShowS
showsPrec :: Int -> UUID -> ShowS
$cshow :: UUID -> String
show :: UUID -> String
$cshowList :: [UUID] -> ShowS
showList :: [UUID] -> ShowS
Show, UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
/= :: UUID -> UUID -> Bool
Eq, UUID -> ()
(UUID -> ()) -> NFData UUID
forall a. (a -> ()) -> NFData a
$crnf :: UUID -> ()
rnf :: UUID -> ()
NFData, UUID
UUID -> UUID -> Bounded UUID
forall a. a -> a -> Bounded a
$cminBound :: UUID
minBound :: UUID
$cmaxBound :: UUID
maxBound :: UUID
Bounded, Int -> UUID
UUID -> Int
UUID -> [UUID]
UUID -> UUID
UUID -> UUID -> [UUID]
UUID -> UUID -> UUID -> [UUID]
(UUID -> UUID)
-> (UUID -> UUID)
-> (Int -> UUID)
-> (UUID -> Int)
-> (UUID -> [UUID])
-> (UUID -> UUID -> [UUID])
-> (UUID -> UUID -> [UUID])
-> (UUID -> UUID -> UUID -> [UUID])
-> Enum UUID
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UUID -> UUID
succ :: UUID -> UUID
$cpred :: UUID -> UUID
pred :: UUID -> UUID
$ctoEnum :: Int -> UUID
toEnum :: Int -> UUID
$cfromEnum :: UUID -> Int
fromEnum :: UUID -> Int
$cenumFrom :: UUID -> [UUID]
enumFrom :: UUID -> [UUID]
$cenumFromThen :: UUID -> UUID -> [UUID]
enumFromThen :: UUID -> UUID -> [UUID]
$cenumFromTo :: UUID -> UUID -> [UUID]
enumFromTo :: UUID -> UUID -> [UUID]
$cenumFromThenTo :: UUID -> UUID -> UUID -> [UUID]
enumFromThenTo :: UUID -> UUID -> UUID -> [UUID]
Enum, Integer -> UUID
UUID -> UUID
UUID -> UUID -> UUID
(UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID)
-> (UUID -> UUID)
-> (UUID -> UUID)
-> (Integer -> UUID)
-> Num UUID
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: UUID -> UUID -> UUID
+ :: UUID -> UUID -> UUID
$c- :: UUID -> UUID -> UUID
- :: UUID -> UUID -> UUID
$c* :: UUID -> UUID -> UUID
* :: UUID -> UUID -> UUID
$cnegate :: UUID -> UUID
negate :: UUID -> UUID
$cabs :: UUID -> UUID
abs :: UUID -> UUID
$csignum :: UUID -> UUID
signum :: UUID -> UUID
$cfromInteger :: Integer -> UUID
fromInteger :: Integer -> UUID
Num)

instance IsChType UUID where
  chTypeName :: String
chTypeName = String
"UUID"
  defaultValueOfTypeName :: UUID
defaultValueOfTypeName = UUID
0

instance Serializable UUID where
  serialize :: ProtocolRevision -> UUID -> Builder
serialize ProtocolRevision
_ = (\(MkUUID (Word128 Word64
hi Word64
lo)) -> Word64 -> Builder
word64LE Word64
lo Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64LE Word64
hi)
  deserialize :: ProtocolRevision -> Get UUID
deserialize ProtocolRevision
_ = do
    low <- Get Word64
getWord64le
    high <- getWord64le
    pure $ MkUUID (Word128 high low)
  {-# INLINE deserialize #-}

instance ToChType UUID (Word64, Word64) where
  toChType :: (Word64, Word64) -> UUID
toChType = Word128 -> UUID
MkUUID (Word128 -> UUID)
-> ((Word64, Word64) -> Word128) -> (Word64, Word64) -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word128) -> (Word64, Word64) -> Word128
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128)
  fromChType :: UUID -> (Word64, Word64)
fromChType (MkUUID (Word128 Word64
w64hi Word64
w64lo)) = (Word64
w64hi, Word64
w64lo)

instance ToQueryPart UUID where
  toQueryPart :: UUID -> Builder
toQueryPart (MkUUID (Word128 Word64
hi Word64
lo)) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [Builder
"'", Int -> Word64 -> Builder
p Int
3 Word64
hi, Int -> Word64 -> Builder
p Int
2 Word64
hi, Builder
"-", Int -> Word64 -> Builder
p Int
1 Word64
hi, Builder
"-", Int -> Word64 -> Builder
p Int
0 Word64
hi, Builder
"-", Int -> Word64 -> Builder
p Int
3 Word64
lo, Builder
"-", Int -> Word64 -> Builder
p Int
2 Word64
lo, Int -> Word64 -> Builder
p Int
1 Word64
lo, Int -> Word64 -> Builder
p Int
0 Word64
lo, Builder
"'"]
    where
    p :: Int -> Word64 -> Builder
    p :: Int -> Word64 -> Builder
p Int
shiftN Word64
word = Word16 -> Builder
word16HexFixed (Word16 -> Builder) -> Word16 -> Builder
forall a b. (a -> b) -> a -> b
$ Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
word Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
shiftNInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
16))