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

module Database.EJDB2.Options
        ( Options(..), zero, OptionsB, options, build ) where

import           Data.ByteString.Char8

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

import qualified Database.EJDB2.KV                as KV
import qualified Database.EJDB2.HTTP              as HTTP



-- | EJDB open options
data Options = Options { Options -> Options
kv :: !KV.Options -- ^ IWKV storage options
                       , Options -> Options
http :: !HTTP.Options -- ^ HTTP/Websocket server options
                       , Options -> Bool
noWal :: !Bool -- ^ Do not use write-ahead-log. Default: false
                       , Options -> Word32
sortBufferSz :: !Word32 -- ^ Max sorting buffer size. If exceeded an overflow temp file for sorted data will created. Default 16Mb, min: 1Mb
                       , Options -> Word32
documentBufferSz :: !Word32 -- ^ Initial size of buffer in bytes used to process/store document during query execution. Default 64Kb, min: 16Kb
                       }

-- | Create default Options
zero :: Options
zero :: Options
zero = $WOptions :: Options -> Options -> Bool -> Word32 -> Word32 -> Options
Options { kv :: Options
kv = Options
KV.zero
               , http :: Options
http = Options
HTTP.zero
               , noWal :: Bool
noWal = Bool
False
               , sortBufferSz :: Word32
sortBufferSz = 0
               , documentBufferSz :: Word32
documentBufferSz = 0
               }

-- | Storable version of 'Options'
data OptionsB = OptionsB { OptionsB -> Options
options :: Options
                         , OptionsB -> OptionsB
kvB :: !KV.OptionsB
                         , OptionsB -> OptionsB
httpB :: !HTTP.OptionsB
                         }

-- | Create Storable version of 'Options'
build :: Options -> IO OptionsB
build :: Options -> IO OptionsB
build options :: Options
options = do
        OptionsB
kvB <- Options -> IO OptionsB
KV.build (Options -> Options
kv Options
options)
        OptionsB
httpB <- Options -> IO OptionsB
HTTP.build (Options -> Options
http Options
options)
        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 -> OptionsB -> OptionsB -> OptionsB
OptionsB Options
options OptionsB
kvB OptionsB
httpB

instance Storable OptionsB where
        sizeOf :: OptionsB -> Int
sizeOf _ = (128)
{-# LINE 49 "src/Database/EJDB2/Options.hsc" #-}
        alignment :: OptionsB -> Int
alignment _ = 8
{-# LINE 50 "src/Database/EJDB2/Options.hsc" #-}
        peek :: Ptr OptionsB -> IO OptionsB
peek ptr :: Ptr OptionsB
ptr = do
           OptionsB
kvB <- (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO OptionsB
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr 0) Ptr OptionsB
ptr
{-# LINE 52 "src/Database/EJDB2/Options.hsc" #-}
           let kv :: Options
kv = OptionsB -> Options
KV.options OptionsB
kvB
           OptionsB
httpB <- (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO OptionsB
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr 72) Ptr OptionsB
ptr
{-# LINE 54 "src/Database/EJDB2/Options.hsc" #-}
           let http :: Options
http = OptionsB -> Options
HTTP.options OptionsB
httpB
           (CBool no_wal :: Word8
no_wal) <- (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO CBool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr 112) Ptr OptionsB
ptr
{-# LINE 56 "src/Database/EJDB2/Options.hsc" #-}
           (CUInt sort_buffer_sz :: Word32
sort_buffer_sz) <- (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr 116) Ptr OptionsB
ptr
{-# LINE 57 "src/Database/EJDB2/Options.hsc" #-}
           (CUInt document_buffer_sz :: Word32
document_buffer_sz) <- (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr OptionsB
hsc_ptr 120) Ptr OptionsB
ptr
{-# LINE 58 "src/Database/EJDB2/Options.hsc" #-}
           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 -> OptionsB -> OptionsB -> OptionsB
OptionsB (Options -> Options -> Bool -> Word32 -> Word32 -> Options
Options Options
kv Options
http (Word8 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool Word8
no_wal) Word32
sort_buffer_sz Word32
document_buffer_sz) OptionsB
kvB OptionsB
httpB
        poke :: Ptr OptionsB -> OptionsB -> IO ()
poke ptr :: Ptr OptionsB
ptr (OptionsB (Options _ http :: Options
http noWal :: Bool
noWal sort_buffer_sz :: Word32
sort_buffer_sz document_buffer_sz :: Word32
document_buffer_sz) kvB :: OptionsB
kvB httpB :: OptionsB
httpB) = do
           (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> OptionsB -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr 0) Ptr OptionsB
ptr OptionsB
kvB
{-# LINE 61 "src/Database/EJDB2/Options.hsc" #-}
           (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> OptionsB -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr 72) Ptr OptionsB
ptr OptionsB
httpB
{-# LINE 62 "src/Database/EJDB2/Options.hsc" #-}
           (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> CBool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr 112) Ptr OptionsB
ptr (Word8 -> CBool
CBool (Word8 -> CBool) -> Word8 -> CBool
forall a b. (a -> b) -> a -> b
$ Bool -> Word8
forall a. Num a => Bool -> a
fromBool Bool
noWal)
{-# LINE 63 "src/Database/EJDB2/Options.hsc" #-}
           (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr 116) Ptr OptionsB
ptr (Word32 -> CUInt
CUInt Word32
sort_buffer_sz)
{-# LINE 64 "src/Database/EJDB2/Options.hsc" #-}
           (\hsc_ptr :: Ptr OptionsB
hsc_ptr -> Ptr OptionsB -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr OptionsB
hsc_ptr 120) Ptr OptionsB
ptr (Word32 -> CUInt
CUInt Word32
document_buffer_sz)
{-# LINE 65 "src/Database/EJDB2/Options.hsc" #-}