{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia    #-}
{-# LANGUAGE TypeFamilies   #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Database.LSMTree.Extras.Orphans (
    byteSwapWord256
  , indexWord8ArrayAsWord256
  , indexWord8ArrayAsWord128
  ) where

import           Control.DeepSeq
import qualified Data.Primitive as P
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import           Data.WideWord.Word128 (Word128 (..), byteSwapWord128)
import           Data.WideWord.Word256 (Word256 (..))
import           Database.LSMTree.Internal.Primitive (indexWord8ArrayAsWord64)
import qualified Database.LSMTree.Internal.RawBytes as RB
import           Database.LSMTree.Internal.Serialise (SerialisedBlob (..),
                     SerialisedKey (..), SerialisedValue (..))
import           Database.LSMTree.Internal.Serialise.Class
import           Database.LSMTree.Internal.Vector
import           GHC.Generics
import           GHC.Word
import qualified System.FS.API as FS
import qualified System.FS.IO.Handle as FS
import           System.Posix.Types (COff (..))
import           System.Random (Uniform)
import           Test.QuickCheck

{-------------------------------------------------------------------------------
  Word256
-------------------------------------------------------------------------------}

deriving anyclass instance Uniform Word256

instance SerialiseKey Word256 where
  serialiseKey :: Word256 -> RawBytes
serialiseKey Word256
w256 =
    Vector Word8 -> RawBytes
RB.RawBytes (Vector Word8 -> RawBytes) -> Vector Word8 -> RawBytes
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Word8
forall a. Prim a => Int -> Int -> ByteArray -> Vector a
mkPrimVector Int
0 Int
32 (ByteArray -> Vector Word8) -> ByteArray -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MutableByteArray s)) -> ByteArray
P.runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newByteArray Int
32
      MutableByteArray (PrimState (ST s)) -> Int -> Word256 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
0 (Word256 -> ST s ()) -> Word256 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word256 -> Word256
byteSwapWord256 Word256
w256
      MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
ba
  deserialiseKey :: RawBytes -> Word256
deserialiseKey (RawBytes (VP.Vector Int
off Int
len ByteArray
ba)) =
    String -> Int -> Int -> Word256 -> Word256
forall a. String -> Int -> Int -> a -> a
requireBytesExactly String
"Word256" Int
32 Int
len (Word256 -> Word256) -> Word256 -> Word256
forall a b. (a -> b) -> a -> b
$
      Word256 -> Word256
byteSwapWord256 (Word256 -> Word256) -> Word256 -> Word256
forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Word256
indexWord8ArrayAsWord256 ByteArray
ba Int
off

instance SerialiseValue Word256 where
  serialiseValue :: Word256 -> RawBytes
serialiseValue Word256
w256 =
    Vector Word8 -> RawBytes
RB.RawBytes (Vector Word8 -> RawBytes) -> Vector Word8 -> RawBytes
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Word8
forall a. Prim a => Int -> Int -> ByteArray -> Vector a
mkPrimVector Int
0 Int
32 (ByteArray -> Vector Word8) -> ByteArray -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MutableByteArray s)) -> ByteArray
P.runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newByteArray Int
32
      MutableByteArray (PrimState (ST s)) -> Int -> Word256 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
0 Word256
w256
      MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
ba
  deserialiseValue :: RawBytes -> Word256
deserialiseValue (RawBytes (VP.Vector Int
off Int
len ByteArray
ba)) =
    String -> Int -> Int -> Word256 -> Word256
forall a. String -> Int -> Int -> a -> a
requireBytesExactly String
"Word256" Int
32 Int
len (Word256 -> Word256) -> Word256 -> Word256
forall a b. (a -> b) -> a -> b
$
      ByteArray -> Int -> Word256
indexWord8ArrayAsWord256 ByteArray
ba Int
off

instance Arbitrary Word256 where
  arbitrary :: Gen Word256
arbitrary = Word64 -> Word64 -> Word64 -> Word64 -> Word256
Word256 (Word64 -> Word64 -> Word64 -> Word64 -> Word256)
-> Gen Word64 -> Gen (Word64 -> Word64 -> Word64 -> Word256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> Word64 -> Word64 -> Word256)
-> Gen Word64 -> Gen (Word64 -> Word64 -> Word256)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> Word64 -> Word256)
-> Gen Word64 -> Gen (Word64 -> Word256)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> Word256) -> Gen Word64 -> Gen Word256
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Word256 -> [Word256]
shrink Word256
w256 = [ Word256
w256'
                | let i256 :: Integer
i256 = Word256 -> Integer
forall a. Integral a => a -> Integer
toInteger Word256
w256
                , Integer
i256' <- Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
i256
                , Word256 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word256
forall a. Bounded a => a
minBound :: Word256) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i256'
                , Word256 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word256
forall a. Bounded a => a
maxBound :: Word256) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
i256'
                , let w256' :: Word256
w256' = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i256'
                ]

{-# INLINE byteSwapWord256 #-}
byteSwapWord256 :: Word256 -> Word256
byteSwapWord256 :: Word256 -> Word256
byteSwapWord256 (Word256 Word64
a3 Word64
a2 Word64
a1 Word64
a0) =
    Word64 -> Word64 -> Word64 -> Word64 -> Word256
Word256 (Word64 -> Word64
byteSwap64 Word64
a0) (Word64 -> Word64
byteSwap64 Word64
a1) (Word64 -> Word64
byteSwap64 Word64
a2) (Word64 -> Word64
byteSwap64 Word64
a3)

{-# INLINE indexWord8ArrayAsWord256 #-}
indexWord8ArrayAsWord256 :: P.ByteArray -> Int -> Word256
indexWord8ArrayAsWord256 :: ByteArray -> Int -> Word256
indexWord8ArrayAsWord256 !ByteArray
ba !Int
off =
    Word64 -> Word64 -> Word64 -> Word64 -> Word256
Word256 (ByteArray -> Int -> Word64
indexWord8ArrayAsWord64 ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
24))
            (ByteArray -> Int -> Word64
indexWord8ArrayAsWord64 ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16))
            (ByteArray -> Int -> Word64
indexWord8ArrayAsWord64 ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8))
            (ByteArray -> Int -> Word64
indexWord8ArrayAsWord64 ByteArray
ba Int
off)

newtype instance VUM.MVector s Word256 = MV_Word256 (VP.MVector s Word256)
newtype instance VU.Vector     Word256 = V_Word256  (VP.Vector    Word256)

deriving via VU.UnboxViaPrim Word256 instance VGM.MVector VU.MVector Word256
deriving via VU.UnboxViaPrim Word256 instance VG.Vector   VU.Vector  Word256

instance VUM.Unbox Word256

{-------------------------------------------------------------------------------
  Word128
-------------------------------------------------------------------------------}

deriving anyclass instance Uniform Word128

instance SerialiseKey Word128 where
  serialiseKey :: Word128 -> RawBytes
serialiseKey Word128
w128 =
    Vector Word8 -> RawBytes
RB.RawBytes (Vector Word8 -> RawBytes) -> Vector Word8 -> RawBytes
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Word8
forall a. Prim a => Int -> Int -> ByteArray -> Vector a
mkPrimVector Int
0 Int
16 (ByteArray -> Vector Word8) -> ByteArray -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MutableByteArray s)) -> ByteArray
P.runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newByteArray Int
16
      MutableByteArray (PrimState (ST s)) -> Int -> Word128 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
0 (Word128 -> ST s ()) -> Word128 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word128 -> Word128
byteSwapWord128 Word128
w128
      MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
ba
  deserialiseKey :: RawBytes -> Word128
deserialiseKey (RawBytes (VP.Vector Int
off Int
len ByteArray
ba)) =
    String -> Int -> Int -> Word128 -> Word128
forall a. String -> Int -> Int -> a -> a
requireBytesExactly String
"Word128" Int
16 Int
len (Word128 -> Word128) -> Word128 -> Word128
forall a b. (a -> b) -> a -> b
$
      Word128 -> Word128
byteSwapWord128 (Word128 -> Word128) -> Word128 -> Word128
forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Word128
indexWord8ArrayAsWord128 ByteArray
ba Int
off

instance SerialiseValue Word128 where
  serialiseValue :: Word128 -> RawBytes
serialiseValue Word128
w128 =
    Vector Word8 -> RawBytes
RB.RawBytes (Vector Word8 -> RawBytes) -> Vector Word8 -> RawBytes
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Word8
forall a. Prim a => Int -> Int -> ByteArray -> Vector a
mkPrimVector Int
0 Int
16 (ByteArray -> Vector Word8) -> ByteArray -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MutableByteArray s)) -> ByteArray
P.runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newByteArray Int
16
      MutableByteArray (PrimState (ST s)) -> Int -> Word128 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
0 Word128
w128
      MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
ba
  deserialiseValue :: RawBytes -> Word128
deserialiseValue (RawBytes (VP.Vector Int
off Int
len ByteArray
ba)) =
    String -> Int -> Int -> Word128 -> Word128
forall a. String -> Int -> Int -> a -> a
requireBytesExactly String
"Word128" Int
16 Int
len (Word128 -> Word128) -> Word128 -> Word128
forall a b. (a -> b) -> a -> b
$
      ByteArray -> Int -> Word128
indexWord8ArrayAsWord128 ByteArray
ba Int
off

instance Arbitrary Word128 where
  arbitrary :: Gen Word128
arbitrary = Word64 -> Word64 -> Word128
Word128 (Word64 -> Word64 -> Word128)
-> Gen Word64 -> Gen (Word64 -> Word128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> Word128) -> Gen Word64 -> Gen Word128
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Word128 -> [Word128]
shrink Word128
w128 = [ Word128
w128'
                | let i128 :: Integer
i128 = Word128 -> Integer
forall a. Integral a => a -> Integer
toInteger Word128
w128
                , Integer
i128' <- Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
i128
                , Word128 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word128
forall a. Bounded a => a
minBound :: Word128) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i128'
                , Word128 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word128
forall a. Bounded a => a
maxBound :: Word128) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
i128'
                , let w128' :: Word128
w128' = Integer -> Word128
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i128'
                ]

{-# INLINE indexWord8ArrayAsWord128 #-}
indexWord8ArrayAsWord128 :: P.ByteArray -> Int -> Word128
indexWord8ArrayAsWord128 :: ByteArray -> Int -> Word128
indexWord8ArrayAsWord128 !ByteArray
ba !Int
off =
    Word64 -> Word64 -> Word128
Word128 (ByteArray -> Int -> Word64
indexWord8ArrayAsWord64 ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8))
            (ByteArray -> Int -> Word64
indexWord8ArrayAsWord64 ByteArray
ba Int
off)

newtype instance VUM.MVector s Word128 = MV_Word128 (VP.MVector s Word128)
newtype instance VU.Vector     Word128 = V_Word128  (VP.Vector    Word128)

deriving via VU.UnboxViaPrim Word128 instance VGM.MVector VU.MVector Word128
deriving via VU.UnboxViaPrim Word128 instance VG.Vector   VU.Vector  Word128

instance VUM.Unbox Word128

{-------------------------------------------------------------------------------
  NFData
-------------------------------------------------------------------------------}

deriving stock instance Generic (FS.HandleOS h)
deriving anyclass instance NFData (FS.HandleOS h)
deriving newtype instance NFData FS.BufferOffset
deriving newtype instance NFData COff

{-------------------------------------------------------------------------------
  RawBytes
-------------------------------------------------------------------------------}

instance SerialiseKey RawBytes where
  serialiseKey :: RawBytes -> RawBytes
serialiseKey = RawBytes -> RawBytes
forall a. a -> a
id
  deserialiseKey :: RawBytes -> RawBytes
deserialiseKey = RawBytes -> RawBytes
forall a. a -> a
id

instance SerialiseValue RawBytes where
  serialiseValue :: RawBytes -> RawBytes
serialiseValue = RawBytes -> RawBytes
forall a. a -> a
id
  deserialiseValue :: RawBytes -> RawBytes
deserialiseValue = RawBytes -> RawBytes
forall a. a -> a
id

{-------------------------------------------------------------------------------
  SerialisedKey/Value/Blob
-------------------------------------------------------------------------------}

deriving newtype instance SerialiseKey SerialisedKey

deriving newtype instance SerialiseValue SerialisedValue

deriving newtype instance SerialiseValue SerialisedBlob