{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE StandaloneDeriving #-}
module Mdbx.Store (
MdbxItemStore(..),
fromMdbxStore,
withMdbxStore
) where
import Data.ByteString.Unsafe (unsafeUseAsCStringLen, unsafePackCStringLen)
import Data.Coerce (coerce)
import Data.Store
import Data.Store.Core
import Data.Word
import Foreign.Ptr
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as BSH
import qualified Data.ByteString.Internal as BSI
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Mdbx.Types
newtype MdbxItemStore a = MdbxItemStore {
MdbxItemStore a -> a
unwrapStore :: a
}
instance Store a => MdbxItem (MdbxItemStore a) where
fromMdbxVal :: MdbxVal -> IO (MdbxItemStore a)
fromMdbxVal MdbxVal
item = a -> MdbxItemStore a
forall a. a -> MdbxItemStore a
MdbxItemStore (a -> MdbxItemStore a) -> IO a -> IO (MdbxItemStore a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MdbxVal -> IO a
forall v. Store v => MdbxVal -> IO v
fromMdbxStore MdbxVal
item
toMdbxVal :: MdbxItemStore a -> (MdbxVal -> IO b) -> IO b
toMdbxVal MdbxItemStore a
item = a -> (MdbxVal -> IO b) -> IO b
forall v a. Store v => v -> (MdbxVal -> IO a) -> IO a
withMdbxStore (MdbxItemStore a -> a
forall a. MdbxItemStore a -> a
unwrapStore MdbxItemStore a
item)
fromMdbxStore :: Store v => MdbxVal -> IO v
fromMdbxStore :: MdbxVal -> IO v
fromMdbxStore (MdbxVal CULong
size Ptr ()
ptr) = do
ByteString
bs <- CStringLen -> IO ByteString
unsafePackCStringLen (Ptr () -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr, CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULong
size)
ByteString -> IO v
forall a. Store a => ByteString -> IO a
decodeIO ByteString
bs
withMdbxStore :: Store v => v -> (MdbxVal -> IO a) -> IO a
withMdbxStore :: v -> (MdbxVal -> IO a) -> IO a
withMdbxStore v
val MdbxVal -> IO a
fn =
ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen (v -> ByteString
forall a. Store a => a -> ByteString
encode v
val) ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptrV, Int
sizeV) -> do
let mval :: MdbxVal
mval = CULong -> Ptr () -> MdbxVal
MdbxVal (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeV) (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptrV)
MdbxVal -> IO a
fn MdbxVal
mval
instance Store NullByteString where
size :: Size NullByteString
size = (NullByteString -> Int) -> Size NullByteString
forall a. (a -> Int) -> Size a
VarSize
((NullByteString -> Int) -> Size NullByteString)
-> (NullByteString -> Int) -> Size NullByteString
forall a b. (a -> b) -> a -> b
$ \NullByteString
bs -> ByteString -> Int
BS.length (ShortByteString -> ByteString
BSH.fromShort (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ NullByteString -> ShortByteString
unNullByteString NullByteString
bs) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
poke :: NullByteString -> Poke ()
poke NullByteString
nbs = do
let bs :: ByteString
bs = ShortByteString -> ByteString
BSH.fromShort (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ NullByteString -> ShortByteString
unNullByteString NullByteString
nbs
let (ForeignPtr Word8
sourceFp, Int
sourceOffset, Int
sourceLength) = ByteString -> (ForeignPtr Word8, Int, Int)
BSI.toForeignPtr ByteString
bs
ForeignPtr Word8 -> Int -> Int -> Poke ()
forall a. ForeignPtr a -> Int -> Int -> Poke ()
pokeFromForeignPtr ForeignPtr Word8
sourceFp Int
sourceOffset Int
sourceLength
Word8 -> Poke ()
forall a. Store a => a -> Poke ()
poke (Word8
0 :: Word8)
peek :: Peek NullByteString
peek = (PeekState -> Ptr Word8 -> IO (PeekResult NullByteString))
-> Peek NullByteString
forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek ((PeekState -> Ptr Word8 -> IO (PeekResult NullByteString))
-> Peek NullByteString)
-> (PeekState -> Ptr Word8 -> IO (PeekResult NullByteString))
-> Peek NullByteString
forall a b. (a -> b) -> a -> b
$ \PeekState
ps Ptr Word8
ptr -> do
ByteString
bs <- Ptr CChar -> IO ByteString
BS.packCString (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
let newPtr :: Ptr b
newPtr = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
let nbs :: NullByteString
nbs = ShortByteString -> NullByteString
NullByteString (ByteString -> ShortByteString
BSH.toShort ByteString
bs)
PeekResult NullByteString -> IO (PeekResult NullByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (PeekResult NullByteString -> IO (PeekResult NullByteString))
-> PeekResult NullByteString -> IO (PeekResult NullByteString)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> NullByteString -> PeekResult NullByteString
forall a. Ptr Word8 -> a -> PeekResult a
PeekResult Ptr Word8
forall b. Ptr b
newPtr NullByteString
nbs
instance Store NullText where
size :: Size NullText
size = (NullText -> Int) -> Size NullText
forall a. (a -> Int) -> Size a
VarSize
((NullText -> Int) -> Size NullText)
-> (NullText -> Int) -> Size NullText
forall a b. (a -> b) -> a -> b
$ \NullText
t -> ByteString -> Int
BS.length (Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ NullText -> Text
unNullText NullText
t) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
poke :: NullText -> Poke ()
poke NullText
nt = do
let bs :: ByteString
bs = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ NullText -> Text
unNullText NullText
nt
let (ForeignPtr Word8
sourceFp, Int
sourceOffset, Int
sourceLength) = ByteString -> (ForeignPtr Word8, Int, Int)
BSI.toForeignPtr ByteString
bs
ForeignPtr Word8 -> Int -> Int -> Poke ()
forall a. ForeignPtr a -> Int -> Int -> Poke ()
pokeFromForeignPtr ForeignPtr Word8
sourceFp Int
sourceOffset Int
sourceLength
Word8 -> Poke ()
forall a. Store a => a -> Poke ()
poke (Word8
0 :: Word8)
peek :: Peek NullText
peek = (PeekState -> Ptr Word8 -> IO (PeekResult NullText))
-> Peek NullText
forall a. (PeekState -> Ptr Word8 -> IO (PeekResult a)) -> Peek a
Peek ((PeekState -> Ptr Word8 -> IO (PeekResult NullText))
-> Peek NullText)
-> (PeekState -> Ptr Word8 -> IO (PeekResult NullText))
-> Peek NullText
forall a b. (a -> b) -> a -> b
$ \PeekState
ps Ptr Word8
ptr -> do
ByteString
bs <- Ptr CChar -> IO ByteString
BS.packCString (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
let newPtr :: Ptr b
newPtr = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
let nt :: NullText
nt = Text -> NullText
NullText (ByteString -> Text
TE.decodeUtf8 ByteString
bs)
PeekResult NullText -> IO (PeekResult NullText)
forall (m :: * -> *) a. Monad m => a -> m a
return (PeekResult NullText -> IO (PeekResult NullText))
-> PeekResult NullText -> IO (PeekResult NullText)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> NullText -> PeekResult NullText
forall a. Ptr Word8 -> a -> PeekResult a
PeekResult Ptr Word8
forall b. Ptr b
newPtr NullText
nt