{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
module Mdbx.Binary (
MdbxItemBinary(..)
) where
import Control.Monad (forM_)
import Data.Binary
import Data.Binary.Get (getLazyByteStringNul)
import Foreign.Ptr (castPtr)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as BSH
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Unsafe as BSU
import qualified Data.Text.Encoding as TE
import Mdbx.Types
newtype MdbxItemBinary a = MdbxItemBinary {
MdbxItemBinary a -> a
unwrapBinary :: a
}
instance Binary a => MdbxItem (MdbxItemBinary a) where
fromMdbxVal :: MdbxVal -> IO (MdbxItemBinary a)
fromMdbxVal MdbxVal
item = a -> MdbxItemBinary a
forall a. a -> MdbxItemBinary a
MdbxItemBinary (a -> MdbxItemBinary a) -> IO a -> IO (MdbxItemBinary a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MdbxVal -> IO a
forall v. Binary v => MdbxVal -> IO v
fromMdbxBinary MdbxVal
item
toMdbxVal :: MdbxItemBinary a -> (MdbxVal -> IO b) -> IO b
toMdbxVal MdbxItemBinary a
item = a -> (MdbxVal -> IO b) -> IO b
forall v a. Binary v => v -> (MdbxVal -> IO a) -> IO a
withMdbxBinary (MdbxItemBinary a -> a
forall a. MdbxItemBinary a -> a
unwrapBinary MdbxItemBinary a
item)
fromMdbxBinary :: Binary v => MdbxVal -> IO v
fromMdbxBinary :: MdbxVal -> IO v
fromMdbxBinary (MdbxVal CULong
size Ptr ()
ptr) = do
ByteString
bs <- CStringLen -> IO ByteString
BSU.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)
v -> IO v
forall (m :: * -> *) a. Monad m => a -> m a
return (v -> IO v) -> v -> IO v
forall a b. (a -> b) -> a -> b
$ ByteString -> v
forall a. Binary a => ByteString -> a
decode (ByteString -> ByteString
BSL.fromStrict ByteString
bs)
withMdbxBinary :: Binary v => v -> (MdbxVal -> IO a) -> IO a
withMdbxBinary :: v -> (MdbxVal -> IO a) -> IO a
withMdbxBinary v
val MdbxVal -> IO a
fn =
ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen (ByteString -> ByteString
BSL.toStrict (v -> ByteString
forall a. Binary 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 Binary NullByteString where
put :: NullByteString -> Put
put NullByteString
nbs = do
[Word8] -> (Word8 -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ShortByteString -> [Word8]
BSH.unpack (ShortByteString -> [Word8]) -> ShortByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ NullByteString -> ShortByteString
unNullByteString NullByteString
nbs) Word8 -> Put
putWord8
Word8 -> Put
putWord8 Word8
0
get :: Get NullByteString
get = ShortByteString -> NullByteString
NullByteString (ShortByteString -> NullByteString)
-> (ByteString -> ShortByteString) -> ByteString -> NullByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
BSH.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> NullByteString)
-> Get ByteString -> Get NullByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLazyByteStringNul
deriving via (MdbxItemBinary NullByteString) instance MdbxItem NullByteString
instance Binary NullText where
put :: NullText -> Put
put NullText
nbs = do
[Word8] -> (Word8 -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> (Text -> ByteString) -> Text -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> [Word8]) -> Text -> [Word8]
forall a b. (a -> b) -> a -> b
$ NullText -> Text
unNullText NullText
nbs) Word8 -> Put
putWord8
Word8 -> Put
putWord8 Word8
0
get :: Get NullText
get = Text -> NullText
NullText (Text -> NullText)
-> (ByteString -> Text) -> ByteString -> NullText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> NullText) -> Get ByteString -> Get NullText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getLazyByteStringNul
deriving via (MdbxItemBinary NullText) instance MdbxItem NullText