{-# LANGUAGE OverloadedStrings #-}
module Database.EJDB2
( init
, Database
, KV.readonlyOpenFlags
, KV.truncateOpenFlags
, KV.noTrimOnCloseOpenFlags
, minimalOptions
, open
, close
, getById
, getCount
, getList
, getList'
, putNew
, put
, mergeOrPut
, patch
, delete
, ensureCollection
, removeCollection
, renameCollection
, getMeta
, IndexMode.IndexMode
, IndexMode.uniqueIndexMode
, IndexMode.strIndexMode
, IndexMode.f64IndexMode
, IndexMode.i64IndexMode
, ensureIndex
, removeIndex
, onlineBackup
, fold
, Query(..)
, noBind
, setBool
, setBoolAtIndex
, setI64
, setI64AtIndex
, setF64
, setF64AtIndex
, setString
, setStringAtIndex
, setRegex
, setRegexAtIndex
, setNull
, setNullAtIndex
) where
import Control.Exception
import Control.Monad
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as Map
import Data.IORef
import Data.Int
import Data.Word
import Database.EJDB2.Bindings.EJDB2
import Database.EJDB2.Bindings.JBL
import Database.EJDB2.Bindings.Types.EJDB
import Database.EJDB2.Bindings.Types.EJDBDoc as EJDBDoc
import Database.EJDB2.Bindings.Types.EJDBExec as EJDBExec
import qualified Database.EJDB2.IndexMode as IndexMode
import Database.EJDB2.JBL
import qualified Database.EJDB2.KV as KV
import Database.EJDB2.Options as Options
import Database.EJDB2.Query
import Database.EJDB2.Result
import Foreign
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import Prelude hiding ( init )
data Database = Database (Ptr EJDB) EJDB
minimalOptions :: String
-> [KV.OpenFlags]
-> Options
minimalOptions path openFlags =
Options.zero { kv = KV.zero { KV.path = Just path, KV.oflags = openFlags }
}
init :: IO ()
init = c_ejdb_init >>= checkRC
open :: Options -> IO Database
open opts = do
ejdbPtr <- malloc
optsB <- build opts
with optsB $ \optsPtr -> do
result <- decodeRC <$> c_ejdb_open optsPtr ejdbPtr
if result == Ok
then Database ejdbPtr <$> peek ejdbPtr
else free ejdbPtr >> fail (show result)
close :: Database -> IO ()
close (Database ejdbPtr _) = do
result <- decodeRC <$> c_ejdb_close ejdbPtr
if result == Ok then free ejdbPtr else fail $ show result
getById :: Aeson.FromJSON a
=> Database
-> String
-> Int64
-> IO (Maybe a)
getById (Database _ ejdb) collection id = alloca $ \jblPtr ->
finally (do
rc <- withCString collection $ \cCollection ->
c_ejdb_get ejdb cCollection (CIntMax id) jblPtr
let result = decodeRC rc
case result of
Ok -> peek jblPtr >>= decode
ErrorNotFound -> return Nothing
_ -> fail $ show result)
(c_jbl_destroy jblPtr)
getCount :: Database -> Query q -> IO Int64
getCount (Database _ ejdb) query = withQuery query $ \jql -> alloca $
\countPtr -> c_ejdb_count ejdb jql countPtr 0 >>= checkRC >> peek countPtr
>>= \(CIntMax int) -> return int
exec :: EJDBExecVisitor -> Database -> Query q -> IO ()
exec visitor (Database _ ejdb) query = withQuery query $ \jql -> do
cVisitor <- mkEJDBExecVisitor visitor
let exec =
EJDBExec.zero { db = ejdb, q = jql, EJDBExec.visitor = cVisitor }
finally (with exec c_ejdb_exec >>= checkRC) (freeHaskellFunPtr cVisitor)
fold :: Aeson.FromJSON b
=> Database
-> (a
-> (Int64, Maybe b)
-> a)
-> a
-> Query q
-> IO a
fold database f i query = newIORef (f, i) >>= \ref ->
exec (foldVisitor ref) database query >> snd <$> readIORef ref
foldVisitor :: Aeson.FromJSON b
=> IORef ((a -> (Int64, Maybe b) -> a), a)
-> EJDBExecVisitor
foldVisitor ref _ docPtr _ = do
doc <- peek docPtr
value <- decode (raw doc)
let id = fromIntegral $ EJDBDoc.id doc
modifyIORef' ref $ \(f, partial) -> (f, f partial (id, value))
return 0
getList :: Aeson.FromJSON a => Database -> Query q -> IO [(Int64, Maybe a)]
getList database query = reverse <$> fold database foldList [] query
foldList :: Aeson.FromJSON a
=> [(Int64, Maybe a)]
-> (Int64, Maybe a)
-> [(Int64, Maybe a)]
foldList = flip (:)
getList' :: Aeson.FromJSON a => Database -> Query q -> IO [Maybe a]
getList' database query = reverse <$> fold database foldList' [] query
foldList'
:: Aeson.FromJSON a => [Maybe a] -> (Int64, Maybe Aeson.Value) -> [Maybe a]
foldList' list (id, value) = parse (setId id value) : list
parse :: Aeson.FromJSON a => Maybe Aeson.Value -> Maybe a
parse Nothing = Nothing
parse (Just value) = case Aeson.fromJSON value of
Aeson.Success v -> Just v
Aeson.Error _ -> Nothing
setId :: Int64 -> Maybe Aeson.Value -> Maybe Aeson.Value
setId id (Just (Aeson.Object map)) =
Just (Aeson.Object (Map.insert "id" (Aeson.Number $ fromIntegral id) map))
setId _ Nothing = Nothing
setId _ value = value
putNew :: Aeson.ToJSON a
=> Database
-> String
-> a
-> IO Int64
putNew (Database _ ejdb) collection obj = encode obj $
\doc -> withCString collection $ \cCollection -> alloca $ \idPtr ->
c_ejdb_put_new ejdb cCollection doc idPtr >>= checkRC >> peek idPtr
>>= \(CIntMax int) -> return int
put :: Aeson.ToJSON a
=> Database
-> String
-> a
-> Int64
-> IO ()
put (Database _ ejdb) collection obj id =
encode obj $ \doc -> withCString collection $ \cCollection ->
c_ejdb_put ejdb cCollection doc (CIntMax id) >>= checkRC
mergeOrPut :: Aeson.ToJSON a
=> Database
-> String
-> a
-> Int64
-> IO ()
mergeOrPut (Database _ ejdb) collection obj id = withCString collection $
\cCollection -> BS.useAsCString (encodeToByteString obj) $ \jsonPatch ->
c_ejdb_merge_or_put ejdb cCollection jsonPatch (CIntMax id) >>= checkRC
patch :: Aeson.ToJSON a
=> Database
-> String
-> a
-> Int64
-> IO ()
patch (Database _ ejdb) collection obj id = withCString collection $
\cCollection -> BS.useAsCString (encodeToByteString obj) $ \jsonPatch ->
c_ejdb_patch ejdb cCollection jsonPatch (CIntMax id) >>= checkRC
delete :: Database
-> String
-> Int64
-> IO ()
delete (Database _ ejdb) collection id = withCString collection $
\cCollection -> c_ejdb_del ejdb cCollection (CIntMax id) >>= checkRC
ensureCollection :: Database
-> String
-> IO ()
ensureCollection (Database _ ejdb) collection =
withCString collection (c_ejdb_ensure_collection ejdb >=> checkRC)
removeCollection :: Database
-> String
-> IO ()
removeCollection (Database _ ejdb) collection =
withCString collection (c_ejdb_remove_collection ejdb >=> checkRC)
renameCollection :: Database
-> String
-> String
-> IO ()
renameCollection (Database _ ejdb) collection newCollection =
withCString collection $ \cCollection ->
withCString newCollection
(c_ejdb_rename_collection ejdb cCollection >=> checkRC)
getMeta :: Aeson.FromJSON a
=> Database
-> IO (Maybe a)
getMeta (Database _ ejdb) = alloca $ \jblPtr -> c_ejdb_get_meta ejdb jblPtr
>>= checkRC >> finally (peek jblPtr >>= decode) (c_jbl_destroy jblPtr)
ensureIndex :: Database
-> String
-> String
-> [IndexMode.IndexMode]
-> IO ()
ensureIndex (Database _ ejdb) collection path indexMode =
withCString collection $ \cCollection -> withCString path $
\cPath -> c_ejdb_ensure_index ejdb cCollection cPath mode >>= checkRC
where
mode = IndexMode.unIndexMode $ IndexMode.combineIndexMode indexMode
removeIndex :: Database
-> String
-> String
-> [IndexMode.IndexMode]
-> IO ()
removeIndex (Database _ ejdb) collection path indexMode =
withCString collection $ \cCollection -> withCString path $
\cPath -> c_ejdb_remove_index ejdb cCollection cPath mode >>= checkRC
where
mode = IndexMode.unIndexMode $ IndexMode.combineIndexMode indexMode
onlineBackup :: Database
-> String
-> IO Word64
onlineBackup (Database _ ejdb) filePath = withCString filePath $ \cFilePath ->
alloca $ \timestampPtr -> c_ejdb_online_backup ejdb timestampPtr cFilePath
>>= checkRC >> peek timestampPtr >>= \(CUIntMax t) -> return t