{-# LINE 1 "src/Database/EJDB2/KV.hsc" #-}
{-# LANGUAGE CPP #-}

module Database.EJDB2.KV
        ( OpenFlags
        , readonlyOpenFlags
        , truncateOpenFlags
        , noTrimOnCloseOpenFlags
        , Options(..)
        , zero
        , OptionsB
        , build
        , options
        ) where

import           Foreign
import           Foreign.C.String
import           Foreign.C.Types

import qualified Database.EJDB2.WAL as WAL


-- | Database file open modes.
newtype OpenFlags = OpenFlags { OpenFlags -> CUChar
unOpenFlags :: CUChar }

-- | Open storage file in read-only mode.
readonlyOpenFlags :: OpenFlags
readonlyOpenFlags :: OpenFlags
readonlyOpenFlags = CUChar -> OpenFlags
OpenFlags CUChar
2
{-# LINE 28 "src/Database/EJDB2/KV.hsc" #-}

-- | Truncate storage file on open.
truncateOpenFlags :: OpenFlags
truncateOpenFlags :: OpenFlags
truncateOpenFlags         = CUChar -> OpenFlags
OpenFlags CUChar
4
{-# LINE 32 "src/Database/EJDB2/KV.hsc" #-}

noTrimOnCloseOpenFlags :: OpenFlags
noTrimOnCloseOpenFlags :: OpenFlags
noTrimOnCloseOpenFlags    = CUChar -> OpenFlags
OpenFlags CUChar
8
{-# LINE 35 "src/Database/EJDB2/KV.hsc" #-}

allOpenFlags :: [OpenFlags]
allOpenFlags :: [OpenFlags]
allOpenFlags = [OpenFlags
readonlyOpenFlags, OpenFlags
truncateOpenFlags, OpenFlags
noTrimOnCloseOpenFlags]

combineOpenFlags :: [OpenFlags] -> OpenFlags
combineOpenFlags :: [OpenFlags] -> OpenFlags
combineOpenFlags = CUChar -> OpenFlags
OpenFlags (CUChar -> OpenFlags)
-> ([OpenFlags] -> CUChar) -> [OpenFlags] -> OpenFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OpenFlags -> CUChar -> CUChar) -> CUChar -> [OpenFlags] -> CUChar
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CUChar -> CUChar -> CUChar
forall a. Bits a => a -> a -> a
(.|.) (CUChar -> CUChar -> CUChar)
-> (OpenFlags -> CUChar) -> OpenFlags -> CUChar -> CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenFlags -> CUChar
unOpenFlags) CUChar
0

unCombineOpenFlags :: OpenFlags -> [OpenFlags]
unCombineOpenFlags :: OpenFlags -> [OpenFlags]
unCombineOpenFlags (OpenFlags (CUChar Word8
oflags)) = (OpenFlags -> Bool) -> [OpenFlags] -> [OpenFlags]
forall a. (a -> Bool) -> [a] -> [a]
filter OpenFlags -> Bool
f [OpenFlags]
allOpenFlags
          where
            f :: OpenFlags -> Bool
f = \(OpenFlags (CUChar Word8
value)) -> Word8
value Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
oflags Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0

-- | IWKV storage open options
data Options =
    Options { Options -> Maybe String
path :: Maybe String -- ^ Path to database file
            , Options -> Word32
randomSeed :: !Word32 -- ^ Random seed used for iwu random generator
            , Options -> Int32
fmtVersion :: !Int32 -- ^ Database storage format version. Leave it as zero for the latest supported format. Used only for newly created databases
            , Options -> [OpenFlags]
oflags :: ![OpenFlags] -- ^ Database file open modes
            , Options -> Bool
fileLockFailFast :: !Bool -- ^ Do not wait and raise error if database is locked by another process
            , Options -> Options
wal :: !WAL.Options
            }

-- | Create default Options
zero :: Options
zero :: Options
zero = Options :: Maybe String
-> Word32 -> Int32 -> [OpenFlags] -> Bool -> Options -> Options
Options { path :: Maybe String
path = Maybe String
forall a. Maybe a
Nothing
                 , randomSeed :: Word32
randomSeed = Word32
0
                 , fmtVersion :: Int32
fmtVersion = Int32
0
                 , oflags :: [OpenFlags]
oflags = []
                 , fileLockFailFast :: Bool
fileLockFailFast = Bool
False
                 , wal :: Options
wal = Options
WAL.zero
                 }

-- | Storable version of Options
data OptionsB =
    OptionsB { OptionsB -> Options
options :: Options
             , OptionsB -> ForeignPtr CChar
pathPtr :: ForeignPtr CChar
             }

-- | Create Storable version of Options
build :: Options -> IO OptionsB
build :: Options -> IO OptionsB
build Options
options = do
        Ptr CChar
pathPtr <- (String -> IO (Ptr CChar)) -> Maybe String -> IO (Ptr CChar)
forall a b. (a -> IO (Ptr b)) -> Maybe a -> IO (Ptr b)
maybeNew String -> IO (Ptr CChar)
newCString (Options -> Maybe String
path Options
options)
        ForeignPtr CChar
pathFPtr <- FinalizerPtr CChar -> Ptr CChar -> IO (ForeignPtr CChar)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CChar
forall a. FinalizerPtr a
finalizerFree Ptr CChar
pathPtr
        OptionsB -> IO OptionsB
forall (m :: * -> *) a. Monad m => a -> m a
return OptionsB :: Options -> ForeignPtr CChar -> OptionsB
OptionsB { options :: Options
options = Options
options
                        , pathPtr :: ForeignPtr CChar
pathPtr = ForeignPtr CChar
pathFPtr
                        }

instance Storable OptionsB where
        sizeOf :: OptionsB -> Int
sizeOf OptionsB
_ = (Int
72)
{-# LINE 84 "src/Database/EJDB2/KV.hsc" #-}
        alignment :: OptionsB -> Int
alignment OptionsB
_  = Int
8
{-# LINE 85 "src/Database/EJDB2/KV.hsc" #-}
        peek :: Ptr OptionsB -> IO OptionsB
peek Ptr OptionsB
ptr = do
                Ptr CChar
pathPtr <- (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr Int
0) Ptr OptionsB
ptr
{-# LINE 87 "src/Database/EJDB2/KV.hsc" #-}
                ForeignPtr CChar
pathFPtr <- FinalizerPtr CChar -> Ptr CChar -> IO (ForeignPtr CChar)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CChar
forall a. FinalizerPtr a
finalizerFree Ptr CChar
forall a. Ptr a
nullPtr -- I'm just reading the pointer, I'm not responsable to free memory about this pointer.
                Maybe String
path <- (Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO String
peekCString Ptr CChar
pathPtr
                Word32
random_seed <- (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr Int
8) Ptr OptionsB
ptr
{-# LINE 90 "src/Database/EJDB2/KV.hsc" #-}
                Int32
fmt_version <- (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr Int
12) Ptr OptionsB
ptr
{-# LINE 91 "src/Database/EJDB2/KV.hsc" #-}
                CUChar
oflags <- (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr Int
16) Ptr OptionsB
ptr
{-# LINE 92 "src/Database/EJDB2/KV.hsc" #-}
                Bool
file_lock_fail_fast <- (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr Int
17) Ptr OptionsB
ptr
{-# LINE 93 "src/Database/EJDB2/KV.hsc" #-}
                Options
wal <- (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO Options
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr Int
24) Ptr OptionsB
ptr
{-# LINE 94 "src/Database/EJDB2/KV.hsc" #-}
                let options :: Options
options = Maybe String
-> Word32 -> Int32 -> [OpenFlags] -> Bool -> Options -> Options
Options 
                                Maybe String
path
                                Word32
random_seed
                                Int32
fmt_version
                                (OpenFlags -> [OpenFlags]
unCombineOpenFlags (OpenFlags -> [OpenFlags]) -> OpenFlags -> [OpenFlags]
forall a b. (a -> b) -> a -> b
$ CUChar -> OpenFlags
OpenFlags CUChar
oflags)
                                Bool
file_lock_fail_fast
                                Options
wal
                OptionsB -> IO OptionsB
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionsB -> IO OptionsB) -> OptionsB -> IO OptionsB
forall a b. (a -> b) -> a -> b
$ Options -> ForeignPtr CChar -> OptionsB
OptionsB Options
options ForeignPtr CChar
pathFPtr
        poke :: Ptr OptionsB -> OptionsB -> IO ()
poke Ptr OptionsB
ptr (OptionsB (Options Maybe String
path Word32
random_seed Int32
fmt_version [OpenFlags]
oflags Bool
file_lock_fail_fast Options
wal) ForeignPtr CChar
pathPtr) = do
                ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
pathPtr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cPath ->
                  (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr Int
0) Ptr OptionsB
ptr Ptr CChar
cPath
{-# LINE 105 "src/Database/EJDB2/KV.hsc" #-}
                (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr Int
8) Ptr OptionsB
ptr Word32
random_seed
{-# LINE 106 "src/Database/EJDB2/KV.hsc" #-}
                (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr Int
12) Ptr OptionsB
ptr Int32
fmt_version
{-# LINE 107 "src/Database/EJDB2/KV.hsc" #-}
                (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> CUChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr Int
16) Ptr OptionsB
ptr (OpenFlags -> CUChar
unOpenFlags (OpenFlags -> CUChar) -> OpenFlags -> CUChar
forall a b. (a -> b) -> a -> b
$ [OpenFlags] -> OpenFlags
combineOpenFlags [OpenFlags]
oflags)
{-# LINE 108 "src/Database/EJDB2/KV.hsc" #-}
                (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> Bool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr Int
17) Ptr OptionsB
ptr Bool
file_lock_fail_fast
{-# LINE 109 "src/Database/EJDB2/KV.hsc" #-}
                (\Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> Options -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr Int
24) Ptr OptionsB
ptr Options
wal
{-# LINE 110 "src/Database/EJDB2/KV.hsc" #-}