packages feed

ejdb2-binding (empty) → 0.1.0.0

raw patch · 36 files changed

+2444/−0 lines, 36 filesdep +aesondep +basedep +bytestringsetup-changedbinary-added

Dependencies added: aeson, base, bytestring, directory, ejdb2-binding, tasty, tasty-hunit, unordered-containers, vector

Files

+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2020 Francesco Burelli++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/finalizer.c view
@@ -0,0 +1,8 @@+#include "finalizer.h"+#include <stdlib.h>++void finalizerJQL(JQL* jql) {+  JQL* jqlCopy = jql;+  jql_destroy(jql);+  free(jqlCopy);+}
+ cbits/finalizer.h view
@@ -0,0 +1,3 @@+#include <ejdb2/ejdb2.h>++void finalizerJQL(JQL* jql);
+ ejdb2-binding.cabal view
@@ -0,0 +1,79 @@+cabal-version:       2.4+name:                ejdb2-binding+category:            Database+description:         Binding to EJDB2 C library, an embedded JSON noSQL database. Package requires libejdb2 to build. Please see the README on GitHub at <https://github.com/cescobaz/ejdb2haskell#readme>+synopsis:            Binding to EJDB2 C library, an embedded JSON noSQL database+version:             0.1.0.0+license:             MIT+license-file:        LICENSE+homepage:            https://github.com/cescobaz/ejdb2haskell#readme+bug-reports:         https://github.com/cescobaz/ejdb2haskell/issues+copyright:           2020 Francesco Burelli+author:              Francesco Burelli+maintainer:          francesco.burelli@protonmail.com+extra-source-files:  CHANGELOG.md+                     cbits/finalizer.h+                     cbits/finalizer.c+                     test/read-only-db++source-repository head+  type: git+  location: https://github.com/cescobaz/ejdb2haskell++library+  exposed-modules:     Database.EJDB2+                     , Database.EJDB2.Query+                     , Database.EJDB2.Meta+                     , Database.EJDB2.CollectionMeta+                     , Database.EJDB2.IndexMeta+                     , Database.EJDB2.Options+                     , Database.EJDB2.HTTP+                     , Database.EJDB2.WAL+                     , Database.EJDB2.KV+  other-modules:+                       Database.EJDB2.JBL+                     , Database.EJDB2.Result+                     , Database.EJDB2.IndexMode+                     , Database.EJDB2.QueryConstructor+                     , Database.EJDB2.Bindings.EJDB2+                     , Database.EJDB2.Bindings.JQL+                     , Database.EJDB2.Bindings.JBL+                     , Database.EJDB2.Bindings.Types.EJDB+                     , Database.EJDB2.Bindings.Types.EJDBExec+                     , Database.EJDB2.Bindings.Types.EJDBDoc+  build-depends:       base ^>=4.12.0.0+                     , bytestring ^>=0.10.10.0+                     , aeson ^>=1.4.6.0+                     , unordered-containers ^>=0.2.10.0+  build-tool-depends:  hsc2hs:hsc2hs+  extra-libraries:     ejdb2+  pkgconfig-depends:   libejdb2+  c-sources:           cbits/finalizer.c+  install-includes:    finalizer.h+  include-dirs:        cbits+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite ejdb2haskell-test+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Main.hs+  other-modules:+                       Asserts+                       Plant+                       GetTests+                       QueryTests+                       PutTests+                       DeleteTests+                       CollectionTests+                       IndexTests+                       OnlineBackupTests+  build-depends:       base ^>=4.12.0.0+                     , tasty ^>=1.2.3+                     , tasty-hunit ^>=0.10.0.2+                     , aeson ^>=1.4.6.0+                     , unordered-containers ^>=0.2.10.0+                     , vector ^>=0.12.1.2+                     , directory ^>=1.3.6.0+                     , ejdb2-binding
+ src/Database/EJDB2.hs view
@@ -0,0 +1,323 @@+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+    ) where++import           Control.Exception+import           Control.Monad++import qualified Data.Aeson                             as Aeson+import qualified Data.ByteString                        as BS+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.QueryConstructor+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 )++-- | Reference to database. You can create it by 'open'.+data Database = Database (Ptr EJDB) EJDB++-- | Create minimal 'Options' for opening a database: just path to file and opening mode.+minimalOptions :: String -- ^ Database file path +               -> [KV.OpenFlags] -- ^ Open mode+               -> Options -- ^ Options to use in 'open'++minimalOptions path openFlags =+    Options.zero { kv = KV.zero { KV.path = Just path, KV.oflags = openFlags }+                 }++{-|+  ejdb2 initialization routine.++  /Must be called before using any of ejdb API function./+-}+init :: IO ()+init = c_ejdb_init >>= checkRC++{-|+  Open storage file.++  Storage can be opened only by one single process at time.++  /Remember to release database by 'close' when database is no longer required./+-}+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)++{-|+  Closes storage and frees up all resources.+-}+close :: Database -> IO ()+close (Database ejdbPtr _) = do+    result <- decodeRC <$> c_ejdb_close ejdbPtr+    if result == Ok then free ejdbPtr else fail $ show result++-- | Retrieve document identified by given id from collection.+getById :: Aeson.FromJSON a+        => Database+        -> String -- ^ Collection name+        -> Int64 -- ^ Document identifier. Not zero+        -> 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)++-- | Executes a given query and returns the number of documents.+getCount :: Database -> Query -> IO Int64+getCount (Database _ ejdb) (Query jql _ _) = alloca $+    \countPtr -> c_ejdb_count ejdb jql countPtr 0 >>= checkRC >> peek countPtr+    >>= \(CIntMax int) -> return int++{-|+  Executes a given query and builds a query result as list of tuple with id and document.+-}+getList :: Aeson.FromJSON a => Database -> Query -> IO [(Int64, Maybe a)]+getList = exec Database.EJDB2.visitor++visitor :: Aeson.FromJSON a => IORef [(Int64, Maybe a)] -> EJDBExecVisitor+visitor ref _ docPtr _ = do+    doc <- peek docPtr+    value <- decode (raw doc)+    modifyIORef' ref $ \list -> (fromIntegral $ EJDBDoc.id doc, value) : list+    return 0++{-|+  Executes a given query and builds a query result as list of documents with id injected as attribute.+-}+getList' :: Aeson.FromJSON a => Database -> Query -> IO [Maybe a]+getList' = exec Database.EJDB2.visitor'++visitor' :: Aeson.FromJSON a => IORef [Maybe a] -> EJDBExecVisitor+visitor' ref _ docPtr _ = do+    doc <- peek docPtr+    value <- decode' (raw doc) (fromIntegral $ EJDBDoc.id doc)+    modifyIORef' ref $ \list -> value : list+    return 0++exec :: (IORef [a] -> EJDBExecVisitor) -> Database -> Query -> IO [a]+exec visitor (Database _ ejdb) (Query jql _ _) = do+    ref <- newIORef []+    visitor <- mkEJDBExecVisitor (visitor ref)+    let exec = EJDBExec.zero { db = ejdb, q = jql, EJDBExec.visitor = visitor }+    finally (with exec $ \execPtr -> do+                 c_ejdb_exec execPtr >>= checkRC+                 reverse <$> readIORef ref)+            (freeHaskellFunPtr visitor)++{-|+  Save new document into collection under new generated identifier.+-}+putNew :: Aeson.ToJSON a+       => Database+       -> String -- ^ Collection name+       -> a -- ^ Document+       -> IO Int64 -- ^ New document identifier. Not zero++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++{-|+  Save a given document under specified id.+-}+put :: Aeson.ToJSON a+    => Database+    -> String -- ^ Collection name+    -> a -- ^ Document+    -> Int64 -- ^ Document identifier. Not zero+    -> IO ()+put (Database _ ejdb) collection obj id =+    encode obj $ \doc -> withCString collection $ \cCollection ->+    c_ejdb_put ejdb cCollection doc (CIntMax id) >>= checkRC++{-|+  Apply JSON merge patch (rfc7396) to the document identified by id or insert new document under specified id.++  /This is an atomic operation./+-}+mergeOrPut :: Aeson.ToJSON a+           => Database+           -> String -- ^ Collection name+           -> a -- ^ JSON merge patch conformed to rfc7396 specification+           -> Int64 -- ^ Document identifier. Not zero+           -> 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++{-|+  Apply rfc6902\/rfc7396 JSON patch to the document identified by id.+-}+patch :: Aeson.ToJSON a+      => Database+      -> String -- ^ Collection name+      -> a -- ^ JSON patch conformed to rfc6902 or rfc7396 specification+      -> Int64 -- ^ Document identifier. Not zero+      -> IO ()+patch (Database _ ejdb) collection obj id = withCString collection $+    \cCollection -> BS.useAsCString (encodeToByteString obj) $ \jsonPatch ->+    c_ejdb_patch ejdb cCollection jsonPatch (CIntMax id) >>= checkRC++{-|+   Remove document identified by given id from collection coll.+-}+delete :: Database+       -> String -- ^ Collection name+       -> Int64 -- ^ Document identifier. Not zero+       -> IO ()+delete (Database _ ejdb) collection id = withCString collection $+    \cCollection -> c_ejdb_del ejdb cCollection (CIntMax id) >>= checkRC++{-|+  Create collection with given name if it has not existed before+-}+ensureCollection :: Database+                 -> String -- ^ Collection name+                 -> IO ()+ensureCollection (Database _ ejdb) collection =+    withCString collection (c_ejdb_ensure_collection ejdb >=> checkRC)++{-|+  Remove collection under the given name.+-}+removeCollection :: Database+                 -> String -- ^ Collection name+                 -> IO ()+removeCollection (Database _ ejdb) collection =+    withCString collection (c_ejdb_remove_collection ejdb >=> checkRC)++{-|+  Rename collection to new name.+-}+renameCollection :: Database+                 -> String -- ^ Old collection name+                 -> String -- ^ New collection name+                 -> IO ()+renameCollection (Database _ ejdb) collection newCollection =+    withCString collection $ \cCollection ->+    withCString newCollection+                (c_ejdb_rename_collection ejdb cCollection >=> checkRC)++{-|+  Returns JSON document describing database structure. You can use the convenient data 'Database.EJDB2.Meta.Meta'+-}+getMeta :: Aeson.FromJSON a+        => Database+        -> IO (Maybe a) -- ^ JSON object describing ejdb storage. See data 'Database.EJDB2.Meta.Meta'++getMeta (Database _ ejdb) = alloca $ \jblPtr -> c_ejdb_get_meta ejdb jblPtr+    >>= checkRC >> finally (peek jblPtr >>= decode) (c_jbl_destroy jblPtr)++{-|+  Create index with specified parameters if it has not existed before.++  /Index path must be fully specified as rfc6901 JSON pointer and must not countain unspecified *\/** element in middle sections./++  > ensureIndex database "mycoll" "/address/street" [uniqueIndexMode | strIndexMode]+-}+ensureIndex :: Database+            -> String -- ^ Collection name+            -> String -- ^ rfc6901 JSON pointer to indexed field+            -> [IndexMode.IndexMode] -- ^ Index mode+            -> 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++{-|+  Remove index if it has existed before.+-}+removeIndex :: Database+            -> String -- ^ Collection name+            -> String -- ^ rfc6901 JSON pointer to indexed field+            -> [IndexMode.IndexMode] -- ^ Index mode+            -> 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++{-|+  Creates an online database backup image and copies it into the specified target file.+  During online backup phase read/write database operations are allowed and not+  blocked for significant amount of time. Backup finish time is placed into result+  as number of milliseconds since epoch.++  Online backup guaranties what all records before timestamp will+  be stored in backup image. Later, online backup image can be+  opened as ordinary database file.++  /In order to avoid deadlocks: close all opened database cursors before calling this method or do call in separate thread./+-}+onlineBackup :: Database+             -> String -- ^ Backup file path+             -> IO Word64 -- ^ Backup completion timestamp++onlineBackup (Database _ ejdb) filePath = withCString filePath $ \cFilePath ->+    alloca $ \timestampPtr -> c_ejdb_online_backup ejdb timestampPtr cFilePath+    >>= checkRC >> peek timestampPtr >>= \(CUIntMax t) -> return t
+ src/Database/EJDB2/Bindings/EJDB2.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Database.EJDB2.Bindings.EJDB2 where++import           Database.EJDB2.Bindings.JBL+import           Database.EJDB2.Bindings.JQL+import           Database.EJDB2.Bindings.Types.EJDB+import           Database.EJDB2.Bindings.Types.EJDBDoc+import           Database.EJDB2.Bindings.Types.EJDBExec+import           Database.EJDB2.Options+import           Database.EJDB2.Result++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_init" c_ejdb_init :: IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_open" c_ejdb_open+    :: Ptr OptionsB -> Ptr EJDB -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_close" c_ejdb_close+    :: Ptr EJDB -> IO RC++foreign import ccall "wrapper" mkEJDBExecVisitor+    :: EJDBExecVisitor -> IO EJDB_EXEC_VISITOR++foreign import ccall "ejdb2/ejdb2.h ejdb_exec" c_ejdb_exec+    :: Ptr EJDBExec -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_get" c_ejdb_get+    :: EJDB -> CString -> CIntMax -> Ptr JBL -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_count" c_ejdb_count+    :: EJDB -> JQL -> Ptr CIntMax -> CIntMax -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_put_new" c_ejdb_put_new+    :: EJDB -> CString -> JBL -> Ptr CIntMax -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_put" c_ejdb_put+    :: EJDB -> CString -> JBL -> CIntMax -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_merge_or_put" c_ejdb_merge_or_put+    :: EJDB -> CString -> CString -> CIntMax -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_patch" c_ejdb_patch+    :: EJDB -> CString -> CString -> CIntMax -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_del" c_ejdb_del+    :: EJDB -> CString -> CIntMax -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_ensure_collection" c_ejdb_ensure_collection+    :: EJDB -> CString -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_remove_collection" c_ejdb_remove_collection+    :: EJDB -> CString -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_rename_collection" c_ejdb_rename_collection+    :: EJDB -> CString -> CString -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_ensure_index" c_ejdb_ensure_index+    :: EJDB -> CString -> CString -> CUChar -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_remove_index" c_ejdb_remove_index+    :: EJDB -> CString -> CString -> CUChar -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_get_meta" c_ejdb_get_meta+    :: EJDB -> Ptr JBL -> IO RC++foreign import ccall unsafe "ejdb2/ejdb2.h ejdb_online_backup" c_ejdb_online_backup+    :: EJDB -> Ptr CUIntMax -> CString -> IO RC
+ src/Database/EJDB2/Bindings/JBL.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE CPP #-}++module Database.EJDB2.Bindings.JBL where++import           Database.EJDB2.Result++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types++type JBL = Ptr ()++type JBLNode = Ptr ()++type JBLPrintFlags = CUChar++type JBLJSONPrinter = Ptr CChar -> CInt -> CChar -> CInt -> Ptr () -> IO RC++foreign import ccall "wrapper" mkJBLJSONPrinter+    :: JBLJSONPrinter -> IO (FunPtr JBLJSONPrinter)++foreign import ccall "ejdb2/jbl.h jbl_as_json" c_jbl_as_json+    :: JBL -> FunPtr JBLJSONPrinter -> Ptr () -> JBLPrintFlags -> IO RC++foreign import ccall unsafe "ejdb2/jbl.h jbl_destroy" c_jbl_destroy+    :: Ptr JBL -> IO ()++foreign import ccall "ejdb2/jbl.h jbl_from_json" c_jbl_from_json+    :: Ptr JBL -> CString -> IO RC+
+ src/Database/EJDB2/Bindings/JQL.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Database.EJDB2.Bindings.JQL where++import           Database.EJDB2.Result++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types++type JQL = Ptr ()++foreign import ccall unsafe "ejdb2/jql.h jql_create" c_jql_create+    :: Ptr JQL -> CString -> CString -> IO RC++foreign import ccall unsafe "ejdb2/jql.h jql_set_bool" c_jql_set_bool+    :: JQL -> CString -> CInt -> CBool -> IO RC++foreign import ccall unsafe "ejdb2/jql.h jql_set_i64" c_jql_set_i64+    :: JQL -> CString -> CInt -> CIntMax -> IO RC++foreign import ccall unsafe "ejdb2/jql.h jql_set_f64" c_jql_set_f64+    :: JQL -> CString -> CInt -> CDouble -> IO RC++foreign import ccall unsafe "ejdb2/jql.h jql_set_str" c_jql_set_str+    :: JQL -> CString -> CInt -> CString -> IO RC++foreign import ccall unsafe "ejdb2/jql.h jql_set_regexp" c_jql_set_regexp+    :: JQL -> CString -> CInt -> CString -> IO RC++foreign import ccall unsafe "ejdb2/jql.h jql_set_null" c_jql_set_null+    :: JQL -> CString -> CInt -> IO RC++foreign import ccall unsafe "ejdb2/jql.h jql_destroy" c_jql_destroy+    :: Ptr JQL -> IO ()++foreign import ccall "finalizer.h &finalizerJQL" p_finalizerJQL+    :: FunPtr (Ptr JQL -> IO ())
+ src/Database/EJDB2/Bindings/Types/EJDB.hs view
@@ -0,0 +1,5 @@+module Database.EJDB2.Bindings.Types.EJDB where++import           Foreign++type EJDB = Ptr ()
+ src/Database/EJDB2/Bindings/Types/EJDBDoc.hsc view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}++module Database.EJDB2.Bindings.Types.EJDBDoc where++import           Foreign+import           Foreign.C.Types++import           Database.EJDB2.Bindings.JBL++#include <ejdb2/ejdb2.h>++data EJDBDoc = EJDBDoc { id :: !CIntMax+                       , raw :: !JBL+                       , node :: !JBLNode+                       , next :: !(Ptr EJDBDoc)+                       , prev :: !(Ptr EJDBDoc) }++instance Storable EJDBDoc where+        sizeOf _ = #{size struct _EJDB_DOC}+        alignment _ = #{alignment struct _EJDB_DOC}+        peek ptr = do+           id <- #{peek struct _EJDB_DOC, id} ptr+           raw <- #{peek struct _EJDB_DOC, raw} ptr+           node <- #{peek struct _EJDB_DOC, node} ptr+           next <- #{peek struct _EJDB_DOC, next} ptr+           prev <- #{peek struct _EJDB_DOC, prev} ptr+           return $ EJDBDoc id raw node next prev+        poke ptr (EJDBDoc id raw node next prev) = do+           #{poke struct _EJDB_DOC, id} ptr id+           #{poke struct _EJDB_DOC, raw} ptr raw+           #{poke struct _EJDB_DOC, node} ptr node+           #{poke struct _EJDB_DOC, next} ptr next+           #{poke struct _EJDB_DOC, prev} ptr prev
+ src/Database/EJDB2/Bindings/Types/EJDBExec.hsc view
@@ -0,0 +1,80 @@+{-# LANGUAGE CPP #-}++module Database.EJDB2.Bindings.Types.EJDBExec where+++import           Prelude           hiding ( log )++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types++import           Database.EJDB2.Bindings.Types.EJDB+import           Database.EJDB2.Bindings.JQL+import           Database.EJDB2.Bindings.Types.EJDBDoc+import           Database.EJDB2.Result++#include <ejdb2/ejdb2.h>++type EJDBExecVisitor = Ptr EJDBExec -> Ptr EJDBDoc -> Ptr CIntMax -> IO RC+type EJDB_EXEC_VISITOR = FunPtr EJDBExecVisitor++type IWXSTR = Ptr ()+type IWPOOL = Ptr ()++data EJDBExec = EJDBExec { db :: !EJDB+                         , q :: !JQL+                         , visitor :: !EJDB_EXEC_VISITOR+                         , opaque :: !(Ptr ())+                         , skip :: !CIntMax+                         , limit :: !CIntMax+                         , cnt :: !CIntMax+                         , log :: !IWXSTR+                         , pool :: !IWPOOL }++minimal :: EJDB -> JQL -> EJDB_EXEC_VISITOR -> EJDBExec+minimal db q visitor = EJDBExec { db = db+                                , q = q+                                , visitor = visitor+                                , opaque = nullPtr+                                , skip = 0+                                , limit = 0+                                , cnt = 0+                                , log = nullPtr+                                , pool = nullPtr }++zero :: EJDBExec+zero = EJDBExec { db = nullPtr+                , q = nullPtr+                , visitor = nullFunPtr+                , opaque = nullPtr+                , skip = 0+                , limit = 0+                , cnt = 0+                , log = nullPtr+                , pool = nullPtr }++instance Storable EJDBExec where+        sizeOf _ = #{size EJDB_EXEC}+        alignment _ = #{alignment EJDB_EXEC}+        peek ptr = do+           db <- #{peek EJDB_EXEC, db} ptr+           q <- #{peek EJDB_EXEC, q} ptr+           visitor <- #{peek EJDB_EXEC, visitor} ptr+           opaque <- #{peek EJDB_EXEC, opaque} ptr+           skip <- #{peek EJDB_EXEC, skip} ptr+           limit <- #{peek EJDB_EXEC, limit} ptr+           cnt <- #{peek EJDB_EXEC, cnt} ptr+           log <- #{peek EJDB_EXEC, log} ptr+           pool <- #{peek EJDB_EXEC, pool} ptr+           return $ EJDBExec db q visitor opaque skip limit cnt log pool+        poke ptr (EJDBExec db q visitor opaque skip limit cnt log pool) = do+           #{poke EJDB_EXEC, db} ptr db+           #{poke EJDB_EXEC, q} ptr q+           #{poke EJDB_EXEC, visitor} ptr visitor+           #{poke EJDB_EXEC, opaque} ptr opaque+           #{poke EJDB_EXEC, skip} ptr skip+           #{poke EJDB_EXEC, limit} ptr limit+           #{poke EJDB_EXEC, cnt} ptr cnt+           #{poke EJDB_EXEC, log} ptr log+           #{poke EJDB_EXEC, pool} ptr pool
+ src/Database/EJDB2/CollectionMeta.hs view
@@ -0,0 +1,23 @@++{-# LANGUAGE DeriveGeneric #-}++module Database.EJDB2.CollectionMeta where++import           Data.Aeson               ( FromJSON )+import           Data.Int++import           Database.EJDB2.IndexMeta++import           GHC.Generics++-- | Metadata about collection.+data CollectionMeta =+    CollectionMeta { name    :: String        -- ^ Collection name+                   , dbid    :: Int64         -- ^ Collection database ID+                   , rnum    :: Int64         -- ^ Number of documents in collection+                   , indexes :: [IndexMeta]   -- ^ List of collections indexes+                   }+    deriving ( Eq, Generic, Show )++instance FromJSON CollectionMeta+
+ src/Database/EJDB2/HTTP.hsc view
@@ -0,0 +1,105 @@+{-# LANGUAGE CPP #-}++module Database.EJDB2.HTTP+        ( Options(..)+        , zero+        , OptionsB+        , options+        , build+        ) where++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types+import           Foreign.Marshal.Utils+import           Data.Int++#include <ejdb2/ejdb2.h>++-- | EJDB HTTP\/Websocket Server options.+data Options = Options { enabled :: !Bool -- ^ If HTTP\/Websocket endpoint enabled. Default: false+                       , port :: !Int32 -- ^ Listen port number, required+                       , bind :: Maybe String -- ^ Listen IP\/host. Default: /localhost/+                       , accessToken :: Maybe String -- ^ Server access token passed in /X-Access-Token/ header. Default: zero+                       , blocking :: !Bool -- ^ Block 'open' thread until http service finished.+-- Otherwise HTTP servee started in background.++                       , readAnon :: !Bool -- ^ Allow anonymous read-only database access+                       , maxBodySize :: !Word64 -- ^ Maximum WS\/HTTP API body size. Default: 64Mb, Min: 512K+                       }++-- | Create default 'Options'+zero :: Options+zero = Options { enabled = False+               , port = 0+               , bind = Nothing+               , accessToken = Nothing+               , blocking = False+               , readAnon = False+               , maxBodySize = 0+               }++-- | Storable version of Options+data OptionsB = OptionsB { options :: Options+                         , bindPtr :: ForeignPtr CChar+                         , accessTokenPtr :: ForeignPtr CChar+                         , accessTokenLen :: CSize+                         }++-- | Create Storable version of Options+build :: Options -> IO OptionsB+build options = do+        bindPtr <-  maybeNew newCString (bind options)+          >>= newForeignPtr finalizerFree+        (accessTokenPtr, accessTokenLen) <- case (accessToken options) of+                                              Nothing -> return (nullPtr, 0)+                                              Just value -> newCStringLen value+        accessTokenFPtr <- newForeignPtr finalizerFree accessTokenPtr+        return OptionsB { options = options+                            , bindPtr = bindPtr+                            , accessTokenPtr = accessTokenFPtr+                            , accessTokenLen = CSize $ fromIntegral accessTokenLen+                            }+++instance Storable OptionsB where+        sizeOf _ = #{size EJDB_HTTP}+        alignment _ = #{alignment EJDB_HTTP}+        peek ptr = do+           enabled <- #{peek EJDB_HTTP, enabled} ptr :: IO CInt+           port <- #{peek EJDB_HTTP, port} ptr+           bindPtr <- #{peek EJDB_HTTP, bind} ptr+           bindFPtr <- newForeignPtr finalizerFree nullPtr+           bind <- maybePeek peekCString bindPtr+           access_token <- #{peek EJDB_HTTP, access_token} ptr+           access_token_len <- #{peek EJDB_HTTP, access_token_len} ptr+           accessTokenFPtr <- newForeignPtr finalizerFree nullPtr+           accessToken <- maybePeek (\ptr -> peekCStringLen (ptr, access_token_len)) access_token+           blocking <- #{peek EJDB_HTTP, blocking} ptr :: IO CInt+           read_anon <- #{peek EJDB_HTTP, read_anon} ptr :: IO CInt+           max_body_size <- #{peek EJDB_HTTP, max_body_size} ptr+           return $ OptionsB+                      (Options+                        (toBool enabled)+                        port+                        bind+                        accessToken+                        (toBool blocking)+                        (toBool read_anon)+                         max_body_size)+                      bindFPtr accessTokenFPtr (CSize $ fromIntegral access_token_len)+        poke ptr (OptionsB+                   (Options enabled port _ _ blocking read_anon max_body_size)+                    bindPtr accessTokenPtr accessTokenLen) = do+           #{poke EJDB_HTTP, enabled} ptr (fromBool enabled :: CInt)+           #{poke EJDB_HTTP, port} ptr port+           withForeignPtr bindPtr $ \cBind ->+             #{poke EJDB_HTTP, bind} ptr cBind+           withForeignPtr accessTokenPtr $ \access_token ->+             #{poke EJDB_HTTP, access_token} ptr access_token+           #{poke EJDB_HTTP, access_token_len} ptr accessTokenLen+           #{poke EJDB_HTTP, blocking} ptr (fromBool blocking :: CInt)+           #{poke EJDB_HTTP, read_anon} ptr (fromBool read_anon :: CInt)+           #{poke EJDB_HTTP, max_body_size} ptr max_body_size++
+ src/Database/EJDB2/IndexMeta.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveGeneric #-}++module Database.EJDB2.IndexMeta where++import           Data.Aeson   ( FromJSON )+import           Data.Int++import           GHC.Generics++-- | Metadata abount collection index.+data IndexMeta =+    IndexMeta { ptr  :: String     -- ^ rfc6901 JSON pointer to indexed field+              , mode :: Int64      -- ^ Index mode+              , idbf :: Int64      -- ^ Index flags+              , dbid :: Int64      -- ^ Index database ID+              , rnum :: Int64      -- ^ Number records stored in index database+              }+    deriving ( Eq, Generic, Show )++instance FromJSON IndexMeta+
+ src/Database/EJDB2/IndexMode.hsc view
@@ -0,0 +1,38 @@+{-# LANGUAGE CPP #-}++module Database.EJDB2.IndexMode where+++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types+++#include <ejdb2/ejdb2.h>+-- | Index creation mode.+newtype IndexMode = IndexMode { unIndexMode :: CUChar }++-- | Marks index is unique, no duplicated values allowed.+uniqueIndexMode    = IndexMode #{const EJDB_IDX_UNIQUE}+-- | Index values have string type.+--+-- Type conversion will be performed on atempt to save value with other type.+strIndexMode    = IndexMode #{const EJDB_IDX_STR}+-- | Index values have signed integer 64 bit wide type.+--+-- Type conversion will be performed on atempt to save value with other type.+i64IndexMode    = IndexMode #{const EJDB_IDX_I64}+-- | Index value have floating point type.+--  /Internally floating point numbers are converted to string with precision of 6 digits after decimal point./+f64IndexMode    = IndexMode #{const EJDB_IDX_F64}++allIndexMode :: [IndexMode]+allIndexMode = [uniqueIndexMode, strIndexMode, i64IndexMode , f64IndexMode]++combineIndexMode :: [IndexMode] -> IndexMode+combineIndexMode = IndexMode . foldr ((.|.) . unIndexMode) 0++unCombineIndexMode :: IndexMode -> [IndexMode]+unCombineIndexMode (IndexMode (CUChar oflags)) = filter f allIndexMode+          where+            f = \(IndexMode (CUChar value)) -> value .&. oflags /= 0
+ src/Database/EJDB2/JBL.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.EJDB2.JBL ( decode, decode', encode, encodeToByteString ) where++import           Control.Exception++import qualified Data.Aeson                  as Aeson+import qualified Data.ByteString             as BS+import qualified Data.ByteString.Lazy        as BSL+import qualified Data.HashMap.Strict         as Map+import           Data.IORef+import           Data.Int++import           Database.EJDB2.Bindings.JBL+import qualified Database.EJDB2.Result       as Result++import           Foreign+import           Foreign.C.Types+import           Foreign.Marshal.Array++decode :: Aeson.FromJSON a => JBL -> IO (Maybe a)+decode jbl = Aeson.decode <$> decodeToByteString jbl++decode' :: Aeson.FromJSON a => JBL -> Int64 -> IO (Maybe a)+decode' jbl id = parse . setId id <$> decode jbl++decodeToByteString :: JBL -> IO BSL.ByteString+decodeToByteString jbl = do+    ref <- newIORef BSL.empty+    thePrinter <- mkJBLJSONPrinter (printer ref)+    c_jbl_as_json jbl thePrinter nullPtr 0+        >>= Result.checkRCFinally (freeHaskellFunPtr thePrinter)+    BSL.reverse <$> readIORef ref++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++printer :: IORef BSL.ByteString -> JBLJSONPrinter+printer ref _ 0 (CChar ch) _ _ = do+    modifyIORef' ref $ \string -> BSL.cons word string+    return 0+  where+    word = fromIntegral ch+printer ref buffer size _ _ _+    | size > 0 = do+        array <- peekArray (fromIntegral size) buffer+        printerArray ref array+    | otherwise = do+        array <- peekArray0 (CChar 0) buffer+        printerArray ref array++printerArray :: IORef BSL.ByteString -> [CChar] -> IO Result.RC+printerArray ref array = do+    modifyIORef' ref $ \string ->+        foldl (\result (CChar ch) -> BSL.cons (fromIntegral ch) result)+              string+              array+    return 0++encode :: Aeson.ToJSON a => a -> (JBL -> IO b) -> IO b+encode obj f = do+    let byteString = encodeToByteString obj+    BS.useAsCString byteString $ \string -> alloca $ \jblPtr ->+        finally (c_jbl_from_json jblPtr string >>= Result.checkRC >> peek jblPtr+                 >>= f)+                (c_jbl_destroy jblPtr)++encodeToByteString :: Aeson.ToJSON a => a -> BS.ByteString+encodeToByteString obj = BSL.toStrict $ Aeson.encode obj
+ src/Database/EJDB2/KV.hsc view
@@ -0,0 +1,110 @@+{-# 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++#include <ejdb2/ejdb2.h>+-- | Database file open modes.+newtype OpenFlags = OpenFlags { unOpenFlags :: CUChar }++-- | Open storage file in read-only mode.+readonlyOpenFlags :: OpenFlags+readonlyOpenFlags = OpenFlags #{const IWKV_RDONLY}++-- | Truncate storage file on open.+truncateOpenFlags :: OpenFlags+truncateOpenFlags         = OpenFlags #{const IWKV_TRUNC}++noTrimOnCloseOpenFlags :: OpenFlags+noTrimOnCloseOpenFlags    = OpenFlags #{const IWKV_NO_TRIM_ON_CLOSE}++allOpenFlags :: [OpenFlags]+allOpenFlags = [readonlyOpenFlags, truncateOpenFlags, noTrimOnCloseOpenFlags]++combineOpenFlags :: [OpenFlags] -> OpenFlags+combineOpenFlags = OpenFlags . foldr ((.|.) . unOpenFlags) 0++unCombineOpenFlags :: OpenFlags -> [OpenFlags]+unCombineOpenFlags (OpenFlags (CUChar oflags)) = filter f allOpenFlags+          where+            f = \(OpenFlags (CUChar value)) -> value .&. oflags /= 0++-- | IWKV storage open options+data Options =+    Options { path :: Maybe String -- ^ Path to database file+            , randomSeed :: !Word32 -- ^ Random seed used for iwu random generator+            , fmtVersion :: !Int32 -- ^ Database storage format version. Leave it as zero for the latest supported format. Used only for newly created databases+            , oflags :: ![OpenFlags] -- ^ Database file open modes+            , fileLockFailFast :: !Bool -- ^ Do not wait and raise error if database is locked by another process+            , wal :: !WAL.Options+            }++-- | Create default Options+zero :: Options+zero = Options { path = Nothing+                 , randomSeed = 0+                 , fmtVersion = 0+                 , oflags = []+                 , fileLockFailFast = False+                 , wal = WAL.zero+                 }++-- | Storable version of Options+data OptionsB =+    OptionsB { options :: Options+             , pathPtr :: ForeignPtr CChar+             }++-- | Create Storable version of Options+build :: Options -> IO OptionsB+build options = do+        pathPtr <- maybeNew newCString (path options)+        pathFPtr <- newForeignPtr finalizerFree pathPtr+        return OptionsB { options = options+                        , pathPtr = pathFPtr+                        }++instance Storable OptionsB where+        sizeOf _ = #{size IWKV_OPTS}+        alignment _  = #{alignment IWKV_OPTS}+        peek ptr = do+                pathPtr <- #{peek IWKV_OPTS, path} ptr+                pathFPtr <- newForeignPtr finalizerFree nullPtr -- I'm just reading the pointer, I'm not responsable to free memory about this pointer.+                path <- maybePeek peekCString pathPtr+                random_seed <- #{peek IWKV_OPTS, random_seed} ptr+                fmt_version <- #{peek IWKV_OPTS, fmt_version} ptr+                oflags <- #{peek IWKV_OPTS, oflags} ptr+                file_lock_fail_fast <- #{peek IWKV_OPTS, file_lock_fail_fast} ptr+                wal <- #{peek IWKV_OPTS, wal} ptr+                let options = Options +                                path+                                random_seed+                                fmt_version+                                (unCombineOpenFlags $ OpenFlags oflags)+                                file_lock_fail_fast+                                wal+                return $ OptionsB options pathFPtr+        poke ptr (OptionsB (Options path random_seed fmt_version oflags file_lock_fail_fast wal) pathPtr) = do+                withForeignPtr pathPtr $ \cPath ->+                  #{poke IWKV_OPTS, path} ptr cPath+                #{poke IWKV_OPTS, random_seed} ptr random_seed+                #{poke IWKV_OPTS, fmt_version} ptr fmt_version+                #{poke IWKV_OPTS, oflags} ptr (unOpenFlags $ combineOpenFlags oflags)+                #{poke IWKV_OPTS, file_lock_fail_fast} ptr file_lock_fail_fast+                #{poke IWKV_OPTS, wal} ptr wal+
+ src/Database/EJDB2/Meta.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveGeneric #-}++module Database.EJDB2.Meta where++import           Data.Aeson                    ( FromJSON )+import           Data.Int++import           Database.EJDB2.CollectionMeta++import           GHC.Generics                  hiding ( Meta )++-- | Metadata about database.+data Meta =+    Meta { version     :: String            -- ^ EJDB engine version+         , file        :: String            -- ^ Path to storage file+         , size        :: Int64             -- ^ Storage file size in bytes+         , collections :: [CollectionMeta]  -- ^ List of collections+         }+    deriving ( Eq, Generic, Show )++instance FromJSON Meta+
+ src/Database/EJDB2/Options.hsc view
@@ -0,0 +1,65 @@+{-# 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++#include <ejdb2/ejdb2.h>++-- | EJDB open options+data Options = Options { kv :: !KV.Options -- ^ IWKV storage options+                       , http :: !HTTP.Options -- ^ HTTP/Websocket server options+                       , noWal :: !Bool -- ^ Do not use write-ahead-log. Default: false+                       , sortBufferSz :: !Word32 -- ^ Max sorting buffer size. If exceeded an overflow temp file for sorted data will created. Default 16Mb, min: 1Mb+                       , 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 { kv = KV.zero+               , http = HTTP.zero+               , noWal = False+               , sortBufferSz = 0+               , documentBufferSz = 0+               }++-- | Storable version of 'Options'+data OptionsB = OptionsB { options :: Options+                         , kvB :: !KV.OptionsB+                         , httpB :: !HTTP.OptionsB+                         }++-- | Create Storable version of 'Options'+build :: Options -> IO OptionsB+build options = do+        kvB <- KV.build (kv options)+        httpB <- HTTP.build (http options)+        return $ OptionsB options kvB httpB++instance Storable OptionsB where+        sizeOf _ = #{size EJDB_OPTS}+        alignment _ = #{alignment EJDB_OPTS}+        peek ptr = do+           kvB <- #{peek EJDB_OPTS, kv} ptr+           let kv = KV.options kvB+           httpB <- #{peek EJDB_OPTS, http} ptr+           let http = HTTP.options httpB+           (CBool no_wal) <- #{peek EJDB_OPTS, no_wal} ptr+           (CUInt sort_buffer_sz) <- #{peek EJDB_OPTS, sort_buffer_sz} ptr+           (CUInt document_buffer_sz) <- #{peek EJDB_OPTS, document_buffer_sz} ptr+           return $ OptionsB (Options kv http (toBool no_wal) sort_buffer_sz document_buffer_sz) kvB httpB+        poke ptr (OptionsB (Options _ http noWal sort_buffer_sz document_buffer_sz) kvB httpB) = do+           #{poke EJDB_OPTS, kv} ptr kvB+           #{poke EJDB_OPTS, http} ptr httpB+           #{poke EJDB_OPTS, no_wal} ptr (CBool $ fromBool noWal)+           #{poke EJDB_OPTS, sort_buffer_sz} ptr (CUInt sort_buffer_sz)+           #{poke EJDB_OPTS, document_buffer_sz} ptr (CUInt document_buffer_sz)+
+ src/Database/EJDB2/Query.hs view
@@ -0,0 +1,156 @@+module Database.EJDB2.Query+    ( Query+    , fromString+    , setBool+    , setBoolAtIndex+    , setI64+    , setI64AtIndex+    , setF64+    , setF64AtIndex+    , setString+    , setStringAtIndex+    , setRegex+    , setRegexAtIndex+    , setNull+    , setNullAtIndex+    ) where++import qualified Data.Bool                       as Bool+import           Data.IORef+import           Data.Int++import           Database.EJDB2.Bindings.JQL+import           Database.EJDB2.QueryConstructor+import           Database.EJDB2.Result++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types+import           Foreign.Marshal.Alloc++-- | Create query object from specified text query. Collection must be specified in query.+fromString :: String -- ^ Query text+           -> IO Query+fromString string = do+    jqlPtr <- malloc+    withCString string $ \cString -> do+        c_jql_create jqlPtr nullPtr cString >>= checkRC+        jql <- peek jqlPtr+        jqlFPtr <- newForeignPtr p_finalizerJQL jqlPtr+        ioRef <- newIORef []+        return $ Query jql jqlFPtr ioRef++-- | Bind bool to query placeholder+setBool :: Bool+        -> String -- ^ Placeholder+        -> Query+        -> IO ()+setBool bool placeholder (Query jql _ _) =+    withCString placeholder $ \cPlaceholder ->+    c_jql_set_bool jql cPlaceholder 0 (CBool (Bool.bool 0 1 bool)) >>= checkRC++-- | Bind bool to query at specified index+setBoolAtIndex :: Bool+               -> Int -- ^ Index+               -> Query+               -> IO ()+setBoolAtIndex bool index (Query jql _ _) =+    c_jql_set_bool jql+                   nullPtr+                   (CInt $ fromIntegral index)+                   (CBool (Bool.bool 0 1 bool)) >>= checkRC++-- | Bind number to query placeholder+setI64 :: Int64+       -> String -- ^ Placeholder+       -> Query+       -> IO ()+setI64 number placeholder (Query jql _ _) = withCString placeholder $+    \cPlaceholder -> c_jql_set_i64 jql cPlaceholder 0 (CIntMax number)+    >>= checkRC++-- | Bind number to query at specified index+setI64AtIndex :: Int64+              -> Int -- ^ Index+              -> Query+              -> IO ()+setI64AtIndex number index (Query jql _ _) =+    c_jql_set_i64 jql nullPtr (CInt $ fromIntegral index) (CIntMax number)+    >>= checkRC++-- | Bind 'Double' to query placeholder+setF64 :: Double+       -> String -- ^ Placeholder+       -> Query+       -> IO ()+setF64 number placeholder (Query jql _ _) = withCString placeholder $+    \cPlaceholder -> c_jql_set_f64 jql cPlaceholder 0 (CDouble number)+    >>= checkRC++-- | Bind 'Double' to query at specified index+setF64AtIndex :: Double+              -> Int -- ^ Index+              -> Query+              -> IO ()+setF64AtIndex number index (Query jql _ _) =+    c_jql_set_f64 jql nullPtr (CInt $ fromIntegral index) (CDouble number)+    >>= checkRC++newCStringInIORef :: String -> IORef [ForeignPtr CChar] -> IO CString+newCStringInIORef string ioRef = do+    cString <- newCString string+    cStringPtr <- newForeignPtr finalizerFree cString+    modifyIORef' ioRef ((:) cStringPtr)+    return cString++-- | Bind string to query placeholder+setString :: String+          -> String -- ^ Placeholder+          -> Query+          -> IO ()+setString string placeholder (Query jql _ ioRef) = do+    cString <- newCStringInIORef string ioRef+    withCString placeholder $+        \cPlaceholder -> c_jql_set_str jql cPlaceholder 0 cString >>= checkRC++-- | Bind string to query at specified index+setStringAtIndex :: String+                 -> Int -- ^ Index+                 -> Query+                 -> IO ()+setStringAtIndex string index (Query jql _ ioRef) = do+    cString <- newCStringInIORef string ioRef+    c_jql_set_str jql nullPtr (CInt $ fromIntegral index) cString >>= checkRC++-- | Bind regex to query placeholder+setRegex :: String -- ^ Regex+         -> String -- ^ Placeholder+         -> Query+         -> IO ()+setRegex string placeholder (Query jql _ ioRef) = do+    cString <- newCStringInIORef string ioRef+    withCString placeholder $+        \cPlaceholder -> c_jql_set_regexp jql cPlaceholder 0 cString >>= checkRC++-- | Bind regex to query at specified index+setRegexAtIndex :: String -- ^ Regex+                -> Int -- ^ Index+                -> Query+                -> IO ()+setRegexAtIndex string index (Query jql _ ioRef) = do+    cString <- newCStringInIORef string ioRef+    c_jql_set_regexp jql nullPtr (CInt $ fromIntegral index) cString >>= checkRC++-- | Bind /null/ value to query placeholder+setNull :: String -- ^ Placeholder+        -> Query+        -> IO ()+setNull placeholder (Query jql _ _) = withCString placeholder $+    \cPlaceholder -> c_jql_set_null jql cPlaceholder 0 >>= checkRC++-- | Bind /null/ value to query at specified index+setNullAtIndex :: Int -- ^ Index+               -> Query+               -> IO ()+setNullAtIndex index (Query jql _ _) =+    c_jql_set_null jql nullPtr (CInt $ fromIntegral index) >>= checkRC
+ src/Database/EJDB2/QueryConstructor.hs view
@@ -0,0 +1,14 @@+module Database.EJDB2.QueryConstructor ( Query(..) ) where++import           Data.IORef++import           Database.EJDB2.Bindings.JQL++import           Foreign+import           Foreign.C.Types++-- | Query handle+data Query = Query { jql     :: JQL+                   , jqlPtr  :: ForeignPtr JQL+                   , strings :: IORef [ForeignPtr CChar]+                   }
+ src/Database/EJDB2/Result.hsc view
@@ -0,0 +1,172 @@+{-# LANGUAGE CPP #-}+module Database.EJDB2.Result where++import           Foreign+import           Foreign.C.Types++#include <ejdb2/ejdb2.h>++type RC = CUIntMax++checkRC :: RC -> IO ()+checkRC rc = do+    let result = decodeRC rc+    if result == Ok then return () else fail $ show result++checkRCFinally :: IO a -> RC -> IO a+checkRCFinally computation rc = do+    let result = decodeRC rc+    if result == Ok+        then computation+        else do+            computation+            fail $ show result++data Result =+      Ok                          -- ^ No error.+    | ErrorFail                   -- ^ Unspecified error.+    | ErrorErrno                  -- ^ Error with expected errno status set.+    | ErrorIoErrno                -- ^ IO error with expected errno status set.+    | ErrorNotExists              -- ^ Resource is not exists.+    | ErrorReadonly               -- ^ Resource is readonly.+    | ErrorAlreadyOpened          -- ^ Resource is already opened.+    | ErrorThreading              -- ^ Threading error.+    | ErrorThreadingErrno         -- ^ Threading error with errno status set.+    | ErrorAssertion              -- ^ Generic assertion error.+    | ErrorInvalidHandle          -- ^ Invalid HANDLE value.+    | ErrorOutOfBounds            -- ^ Invalid bounds specified.+    | ErrorNotImplemented         -- ^ Method is not implemented.+    | ErrorAlloc                  -- ^ Memory allocation failed.+    | ErrorInvalidState           -- ^ Illegal state error.+    | ErrorNotAligned             -- ^ Argument is not aligned properly.+    | ErrorFalse                  -- ^ Request rejection/false response.+    | ErrorInvalidArgs            -- ^ Invalid function arguments.+    | ErrorOverflow               -- ^ Overflow.+    | ErrorInvalidValue           -- ^ Invalid value.+    | ErrorNotFound                  -- ^ Key not found (IWKV_ERROR_NOTFOUND)+    | ErrorKeyExists                 -- ^ Key already exists (IWKV_ERROR_KEY_EXISTS)+    | ErrorMaxkvsz                   -- ^ Size of Key+value must be not greater than 0xfffffff bytes (IWKV_ERROR_MAXKVSZ)+    | ErrorCorrupted                 -- ^ Database file invalid or corrupted (IWKV_ERROR_CORRUPTED)+    | ErrorDupValueSize              -- ^ Value size is not compatible for insertion into sorted values array (IWKV_ERROR_DUP_VALUE_SIZE)+    | ErrorKeyNumValueSize           -- ^ Given key is not compatible to storage as number (IWKV_ERROR_KEY_NUM_VALUE_SIZE)+    | ErrorIncompatibleDbMode        -- ^ Incorpatible database open mode (IWKV_ERROR_INCOMPATIBLE_DB_MODE)+    | ErrorIncompatibleDbFormat      -- ^ Incompatible database format version, please migrate database data (IWKV_ERROR_INCOMPATIBLE_DB_FORMAT)+    | ErrorCorruptedWalFile          -- ^ Corrupted WAL file (IWKV_ERROR_CORRUPTED_WAL_FILE)+    | ErrorValueCannotBeIncremented  -- ^ Stored value cannot be incremented/descremented (IWKV_ERROR_VALUE_CANNOT_BE_INCREMENTED)+    | ErrorWalModeRequired           -- ^ Operation requires WAL enabled database. (IWKV_ERROR_WAL_MODE_REQUIRED)+    | ErrorBackupInProgress          -- ^ Backup operation in progress. (IWKV_ERROR_BACKUP_IN_PROGRESS)+    | ErrorInvalidBuffer             -- ^ Invalid JBL buffer (JBLERRORINVALIDBUFFER)+    | ErrorCreation                   -- ^ Cannot create JBL object (JBLERRORCREATION)+    | ErrorInvalid                    -- ^ Invalid JBL object (JBLERRORINVALID)+    | ErrorParseJson                 -- ^ Failed to parse JSON string (JBLERRORPARSEJSON)+    | ErrorParseUnquotedString      -- ^ Unquoted JSON string (JBLERRORPARSEUNQUOTEDSTRING)+    | ErrorParseInvalidCodepoint    -- ^ Invalid unicode codepoint/escape sequence (JBLERRORPARSEINVALIDCODEPOINT)+    | ErrorParseInvalidUtf8         -- ^ Invalid utf8 string (JBLERRORPARSEINVALIDUTF8)+    | ErrorJsonPointer               -- ^ Invalid JSON pointer (rfc6901) path (JBLERRORJSONPOINTER)+    | ErrorPathNotFound              -- ^ JSON object not matched the path specified (JBLERRORPATHNOTFOUND)+    | ErrorPatchInvalid              -- ^ Invalid JSON patch specified (JBLERRORPATCHINVALID)+    | ErrorPatchInvalidOp           -- ^ Invalid JSON patch operation specified (JBLERRORPATCHINVALIDOP)+    | ErrorPatchNovalue              -- ^ No value specified in JSON patch (JBLERRORPATCHNOVALUE)+    | ErrorPatchTargetInvalid       -- ^ Could not find target object to set value (JBLERRORPATCHTARGETINVALID)+    | ErrorPatchInvalidValue        -- ^ Invalid value specified by patch (JBLERRORPATCHINVALIDVALUE)+    | ErrorPatchInvalidArrayIndex  -- ^ Invalid array index in JSON patch path (JBLERRORPATCHINVALIDARRAYINDEX)+    | ErrorNotAnObject              -- ^ JBL is not an object (JBLERRORNOTANOBJECT)+    | ErrorPatchTestFailed          -- ^ JSON patch test operation failed (JBLERRORPATCHTESTFAILED)+    | ErrorInvalidCollectionName               -- ^ Invalid collection name+    | ErrorInvalidCollectionMeta               -- ^ Invalid collection metadata+    | ErrorInvalidCollectionIndexMeta               -- ^ Invalid collection index metadata+    | ErrorInvalidIndexMode               -- ^ Invalid index mode specified+    | ErrorMismatchedIndexUniquenessMode               -- ^ Index exists but mismatched uniqueness constraint+    | ErrorUniqueIndexConstraintViolated               -- ^ Unique index constraint violated+    | ErrorCollectionNotFound               -- ^ Collection not found+    | ErrorTargetCollectionExists               -- ^ Target collection exists+    | ErrorPatchJsonNotObject               -- ^ Patch JSON must be an object (map)+    | ErrorQueryParse                   -- ^ Query parsing error (JQL_ERROR_QUERY_PARSE)+    | ErrorInvalidPlaceholder           -- ^ Invalid placeholder position (JQL_ERROR_INVALID_PLACEHOLDER)+    | ErrorUnsetPlaceholder             -- ^ Found unset placeholder (JQL_ERROR_UNSET_PLACEHOLDER)+    | ErrorRegexpInvalid                -- ^ Invalid regular expression (JQL_ERROR_REGEXP_INVALID)+    | ErrorRegexpCharset                -- ^ Invalid regular expression: expected ']' at end of character set (JQL_ERROR_REGEXP_CHARSET)+    | ErrorRegexpSubexp                 -- ^ Invalid regular expression: expected ')' at end of subexpression (JQL_ERROR_REGEXP_SUBEXP)+    | ErrorRegexpSubmatch               -- ^ Invalid regular expression: expected '}' at end of submatch (JQL_ERROR_REGEXP_SUBMATCH)+    | ErrorRegexpEngine                 -- ^ Illegal instruction in compiled regular expression (please report this bug) (JQL_ERROR_REGEXP_ENGINE)+    | ErrorSkipAlreadySet               -- ^ Skip clause already specified (JQL_ERROR_SKIP_ALREADY_SET)+    | ErrorLimitAlreadySet              -- ^ Limit clause already specified (JQL_ERROR_SKIP_ALREADY_SET)+    | ErrorOrderbyMaxLimit              -- ^ Reached max number of asc/desc order clauses: 64 (JQL_ERROR_ORDERBY_MAX_LIMIT)+    | ErrorNoCollection                 -- ^ No collection specified in query (JQL_ERROR_NO_COLLECTION)+    | ErrorInvalidPlaceholderValueType  -- ^ Invalid type of placeholder value (JQL_ERROR_INVALID_PLACEHOLDER_VALUE_TYPE)+    deriving ( Eq, Show )++decodeRC :: RC -> Result+decodeRC rc = case rc of+  #{const IW_OK}   ->                    Ok+  #{const IW_ERROR_FAIL}   ->            ErrorFail+  #{const IW_ERROR_ERRNO}   ->           ErrorErrno+  #{const IW_ERROR_IO_ERRNO}   ->        ErrorIoErrno+  #{const IW_ERROR_NOT_EXISTS}   ->      ErrorNotExists+  #{const IW_ERROR_READONLY}   ->        ErrorReadonly+  #{const IW_ERROR_ALREADY_OPENED}   ->  ErrorAlreadyOpened+  #{const IW_ERROR_THREADING}   ->       ErrorThreading+  #{const IW_ERROR_THREADING_ERRNO}   -> ErrorThreadingErrno+  #{const IW_ERROR_ASSERTION}   ->       ErrorAssertion+  #{const IW_ERROR_INVALID_HANDLE}   ->  ErrorInvalidHandle+  #{const IW_ERROR_OUT_OF_BOUNDS}   ->   ErrorOutOfBounds+  #{const IW_ERROR_NOT_IMPLEMENTED}   -> ErrorNotImplemented+  #{const IW_ERROR_ALLOC}   ->           ErrorAlloc+  #{const IW_ERROR_INVALID_STATE}   ->   ErrorInvalidState+  #{const IW_ERROR_NOT_ALIGNED}   ->     ErrorNotAligned+  #{const IW_ERROR_FALSE}   ->           ErrorFalse+  #{const IW_ERROR_INVALID_ARGS}   ->    ErrorInvalidArgs+  #{const IW_ERROR_OVERFLOW}   ->        ErrorOverflow+  #{const IW_ERROR_INVALID_VALUE}   ->   ErrorInvalidValue+  #{const IWKV_ERROR_NOTFOUND}                     ->  ErrorNotFound+  #{const IWKV_ERROR_KEY_EXISTS}                   ->  ErrorKeyExists+  #{const IWKV_ERROR_MAXKVSZ}                      ->  ErrorMaxkvsz+  #{const IWKV_ERROR_CORRUPTED}                    ->  ErrorCorrupted+  #{const IWKV_ERROR_DUP_VALUE_SIZE}               ->  ErrorDupValueSize+  #{const IWKV_ERROR_KEY_NUM_VALUE_SIZE}           ->  ErrorKeyNumValueSize+  #{const IWKV_ERROR_INCOMPATIBLE_DB_MODE}         ->  ErrorIncompatibleDbMode+  #{const IWKV_ERROR_INCOMPATIBLE_DB_FORMAT}       ->  ErrorIncompatibleDbFormat+  #{const IWKV_ERROR_CORRUPTED_WAL_FILE}           ->  ErrorCorruptedWalFile+  #{const IWKV_ERROR_VALUE_CANNOT_BE_INCREMENTED}  ->  ErrorValueCannotBeIncremented+  #{const IWKV_ERROR_WAL_MODE_REQUIRED}            ->  ErrorWalModeRequired+  #{const IWKV_ERROR_BACKUP_IN_PROGRESS}           ->  ErrorBackupInProgress+  #{const JBL_ERROR_INVALID_BUFFER}             ->  ErrorInvalidBuffer+  #{const JBL_ERROR_CREATION}                   ->  ErrorCreation+  #{const JBL_ERROR_INVALID}                    ->  ErrorInvalid+  #{const JBL_ERROR_PARSE_JSON}                 ->  ErrorParseJson+  #{const JBL_ERROR_PARSE_UNQUOTED_STRING}      ->  ErrorParseUnquotedString+  #{const JBL_ERROR_PARSE_INVALID_CODEPOINT}    ->  ErrorParseInvalidCodepoint+  #{const JBL_ERROR_PARSE_INVALID_UTF8}         ->  ErrorParseInvalidUtf8+  #{const JBL_ERROR_JSON_POINTER}               ->  ErrorJsonPointer+  #{const JBL_ERROR_PATH_NOTFOUND}              ->  ErrorPathNotFound+  #{const JBL_ERROR_PATCH_INVALID}              ->  ErrorPatchInvalid+  #{const JBL_ERROR_PATCH_INVALID_OP}           ->  ErrorPatchInvalidOp+  #{const JBL_ERROR_PATCH_NOVALUE}              ->  ErrorPatchNovalue+  #{const JBL_ERROR_PATCH_TARGET_INVALID}       ->  ErrorPatchTargetInvalid+  #{const JBL_ERROR_PATCH_INVALID_VALUE}        ->  ErrorPatchInvalidValue+  #{const JBL_ERROR_PATCH_INVALID_ARRAY_INDEX}  ->  ErrorPatchInvalidArrayIndex+  #{const JBL_ERROR_NOT_AN_OBJECT}              ->  ErrorNotAnObject+  #{const JBL_ERROR_PATCH_TEST_FAILED}          ->  ErrorPatchTestFailed+  #{const EJDB_ERROR_INVALID_COLLECTION_NAME}             ->  ErrorInvalidCollectionName+  #{const EJDB_ERROR_INVALID_COLLECTION_META}             ->  ErrorInvalidCollectionMeta+  #{const EJDB_ERROR_INVALID_COLLECTION_INDEX_META}       ->  ErrorInvalidCollectionIndexMeta+  #{const EJDB_ERROR_INVALID_INDEX_MODE}                  ->  ErrorInvalidIndexMode+  #{const EJDB_ERROR_MISMATCHED_INDEX_UNIQUENESS_MODE}    ->  ErrorMismatchedIndexUniquenessMode+  #{const EJDB_ERROR_UNIQUE_INDEX_CONSTRAINT_VIOLATED}    ->  ErrorUniqueIndexConstraintViolated+  #{const EJDB_ERROR_COLLECTION_NOT_FOUND}                ->  ErrorCollectionNotFound+  #{const EJDB_ERROR_TARGET_COLLECTION_EXISTS}            ->  ErrorTargetCollectionExists+  #{const EJDB_ERROR_PATCH_JSON_NOT_OBJECT}               ->  ErrorPatchJsonNotObject+  #{const JQL_ERROR_QUERY_PARSE}                          ->  ErrorQueryParse+  #{const JQL_ERROR_INVALID_PLACEHOLDER}                  ->  ErrorInvalidPlaceholder+  #{const JQL_ERROR_UNSET_PLACEHOLDER}                    ->  ErrorUnsetPlaceholder+  #{const JQL_ERROR_REGEXP_INVALID}                       ->  ErrorRegexpInvalid+  #{const JQL_ERROR_REGEXP_CHARSET}                       ->  ErrorRegexpCharset+  #{const JQL_ERROR_REGEXP_SUBEXP}                        ->  ErrorRegexpSubexp+  #{const JQL_ERROR_REGEXP_SUBMATCH}                      ->  ErrorRegexpSubmatch+  #{const JQL_ERROR_REGEXP_ENGINE}                        ->  ErrorRegexpEngine+  #{const JQL_ERROR_SKIP_ALREADY_SET}                     ->  ErrorSkipAlreadySet+  #{const JQL_ERROR_LIMIT_ALREADY_SET}                    ->  ErrorLimitAlreadySet+  #{const JQL_ERROR_ORDERBY_MAX_LIMIT}                    ->  ErrorOrderbyMaxLimit+  #{const JQL_ERROR_NO_COLLECTION}                        ->  ErrorNoCollection+  #{const JQL_ERROR_INVALID_PLACEHOLDER_VALUE_TYPE}       ->  ErrorInvalidPlaceholderValueType+  _                                                ->  error $ "Database.EJDB2.Bindings.IW.decodeRC " ++ show rc
+ src/Database/EJDB2/WAL.hsc view
@@ -0,0 +1,60 @@+{-# LANGUAGE CPP #-}++module Database.EJDB2.WAL (Options(..), zero) where+++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types++import Database.EJDB2.Result++#include <ejdb2/ejdb2.h>++-- | Write ahead log (WAL) options.+data Options = Options { enabled :: !Bool -- ^ WAL enabled+                             , checkCRCOnCheckpoint :: !Bool -- ^ Check CRC32 sum of data blocks during checkpoint. Default: false+                             , savepointTimeoutSec :: !Word32 -- ^ Savepoint timeout seconds. Default: 10 sec+                             , checkpointTimeoutSec :: !Word32 -- ^ Checkpoint timeout seconds. Default: 300 sec (5 min);+                             , walBufferSz :: !Word64 -- ^ WAL file intermediate buffer size. Default: 8Mb+                             , checkpointBufferSz :: !Word8 -- ^ Checkpoint buffer size in bytes. Default: 1Gb+                             , walLockInterceptor :: !(FunPtr (CBool -> Ptr () -> IO RC)) -- ^ Optional function called before acquiring and after releasing.+-- exclusive database lock byAL checkpoint thread.+-- In the case of 'before loc first argument will be set to true+                             , walLockInterceptorOpaque :: !(Ptr ()) -- ^ Opaque data for 'walLockInterceptor'+                             }++-- | Create default Options+zero :: Options+zero = Options { enabled = False+                   , checkCRCOnCheckpoint = False+                   , savepointTimeoutSec = 0+                   , checkpointTimeoutSec = 0+                   , walBufferSz = 0+                   , checkpointBufferSz = 0+                   , walLockInterceptor = nullFunPtr+                   , walLockInterceptorOpaque = nullPtr+                   }++instance Storable Options where+        sizeOf _ = #{size IWKV_WAL_OPTS}+        alignment _  = #{alignment IWKV_WAL_OPTS}+        peek ptr = do+          enabled <- #{peek IWKV_WAL_OPTS, enabled} ptr+          check_crc_on_checkpoint <- #{peek IWKV_WAL_OPTS, check_crc_on_checkpoint} ptr+          savepoint_timeout_sec <- #{peek IWKV_WAL_OPTS, savepoint_timeout_sec} ptr+          checkpoint_timeout_sec <- #{peek IWKV_WAL_OPTS, checkpoint_timeout_sec} ptr+          wal_buffer_sz <- #{peek IWKV_WAL_OPTS, wal_buffer_sz} ptr+          checkpoint_buffer_sz <- #{peek IWKV_WAL_OPTS, checkpoint_buffer_sz} ptr+          wal_lock_interceptor <- #{peek IWKV_WAL_OPTS, wal_lock_interceptor} ptr+          wal_lock_interceptor_opaque <- #{peek IWKV_WAL_OPTS, wal_lock_interceptor_opaque} ptr+          return $ Options enabled check_crc_on_checkpoint savepoint_timeout_sec checkpoint_timeout_sec wal_buffer_sz checkpoint_buffer_sz wal_lock_interceptor wal_lock_interceptor_opaque+        poke ptr (Options enabled check_crc_on_checkpoint savepoint_timeout_sec checkpoint_timeout_sec wal_buffer_sz checkpoint_buffer_sz wal_lock_interceptor wal_lock_interceptor_opaque) = do+          #{poke IWKV_WAL_OPTS, enabled} ptr enabled+          #{poke IWKV_WAL_OPTS, check_crc_on_checkpoint} ptr check_crc_on_checkpoint+          #{poke IWKV_WAL_OPTS, savepoint_timeout_sec} ptr savepoint_timeout_sec+          #{poke IWKV_WAL_OPTS, checkpoint_timeout_sec} ptr checkpoint_timeout_sec+          #{poke IWKV_WAL_OPTS, wal_buffer_sz} ptr wal_buffer_sz+          #{poke IWKV_WAL_OPTS, checkpoint_buffer_sz} ptr checkpoint_buffer_sz+          #{poke IWKV_WAL_OPTS, wal_lock_interceptor} ptr wal_lock_interceptor+          #{poke IWKV_WAL_OPTS, wal_lock_interceptor_opaque} ptr wal_lock_interceptor_opaque
+ test/Asserts.hs view
@@ -0,0 +1,16 @@+module Asserts ( assertException ) where++import           Control.Exception+import           Control.Monad++import           Test.Tasty.HUnit++-- https://stackoverflow.com/questions/6147435/is-there-an-assertexception-in-any-of-the-haskell-test-frameworks+assertException :: (Exception e, Eq e, Show a) => e -> IO a -> IO ()+assertException ex action = handleJust isWanted (const $ return ()) $ do+    a <- action+    assertFailure $ "Expected exception: " ++ show ex+        ++ ", but got execution success: " ++ show a+  where+    isWanted = guard . (== ex)+
+ test/CollectionTests.hs view
@@ -0,0 +1,72 @@+module CollectionTests ( tests ) where++import           Asserts++import           Database.EJDB2+import           Database.EJDB2.Options+import qualified Database.EJDB2.Query   as Query++import           Plant++import           Prelude                hiding ( id )++import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = withResource (open testDatabaseOpts) close $ \databaseIO ->+    testGroup "collection"+              [ removeTest databaseIO+              , renameTest databaseIO+              , ensureTest databaseIO+              ]++testDatabaseOpts :: Options+testDatabaseOpts = minimalOptions "./test/collection-db" [ truncateOpenFlags ]++removeTest :: IO Database -> TestTree+removeTest databaseIO = testCase "removeTest" $ do+    database <- databaseIO+    id <- putNew database "plants" plant+    removeCollection database "plants"+    count <- Query.fromString "@plants/*" >>= getCount database+    count @?= 0+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++renameTest :: IO Database -> TestTree+renameTest databaseIO = testCase "renameTest" $ do+    database <- databaseIO+    id <- putNew database "plants" plant+    renameCollection database "plants" "vegetables"+    count <- Query.fromString "@plants/*" >>= getCount database+    count @?= 0+    storedPlant <- getById database "vegetables" id+    storedPlant @?= Just plant+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++ensureTest :: IO Database -> TestTree+ensureTest databaseIO = testCase "ensureTest" $ do+    database <- databaseIO+    _ <- putNew database "plants" plant+    ensureCollection database "vegetables"+    assertException (userError "ErrorTargetCollectionExists")+                    (renameCollection database "plants" "vegetables")+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }
+ test/DeleteTests.hs view
@@ -0,0 +1,41 @@+module DeleteTests ( tests ) where++import           Asserts++import           Database.EJDB2+import           Database.EJDB2.Options++import           Plant++import           Prelude                hiding ( id )++import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = withResource (open testDatabaseOpts) close $ \databaseIO ->+    testGroup "delete"+              [ deleteTest databaseIO, deleteNotExistingTest databaseIO ]++testDatabaseOpts :: Options+testDatabaseOpts = minimalOptions "./test/delete-db" [ truncateOpenFlags ]++deleteTest :: IO Database -> TestTree+deleteTest databaseIO = testCase "deleteTest" $ do+    database <- databaseIO+    id <- putNew database "plants" plant+    delete database "plants" id+    storedPlant <- getById database "plants" id :: IO (Maybe Plant)+    storedPlant @?= Nothing+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++deleteNotExistingTest :: IO Database -> TestTree+deleteNotExistingTest databaseIO = testCase "deleteNotExistingTest" $ do+    database <- databaseIO+    assertException (userError "ErrorNotFound") (delete database "plants" 42)
+ test/GetTests.hs view
@@ -0,0 +1,143 @@+module GetTests ( tests ) where++import           Asserts++import           Control.Exception+import           Control.Monad++import           Data.Aeson             ( Value )+import           Data.Int++import           Database.EJDB2+import           Database.EJDB2.Options+import qualified Database.EJDB2.Query   as Query++import           Plant++import           Prelude                hiding ( id )++import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = withResource (open testReadOnlyDatabaseOpts) close $ \databaseIO ->+    testGroup "get"+              [ getByIdTest databaseIO+              , getByIdNotFoundTest databaseIO+              , getCountTest databaseIO+              , getListTest databaseIO+              , getListTest' databaseIO+              , getByIdFromNotExistingCollectionTest databaseIO+              , getListFromNotExistingCollectionTest databaseIO+              ]++testReadOnlyDatabaseOpts :: Options+testReadOnlyDatabaseOpts =+    minimalOptions "./test/read-only-db" [ readonlyOpenFlags ]++getByIdTest :: IO Database -> TestTree+getByIdTest databaseIO = testCase "getById" $ do+    database <- databaseIO+    plant <- getById database "plants" 1+    plant @?= Just nothingPlant { id          = Nothing+                                , name        = Just "pinus"+                                , isTree      = Just True+                                , year        = Just 1753+                                , description = Just "wow 🌲"+                                }++getByIdNotFoundTest :: IO Database -> TestTree+getByIdNotFoundTest databaseIO = testCase "getById - not found" $ do+    database <- databaseIO+    plant <- getById database "plants" 42+    plant @?= (Nothing :: Maybe Plant)++getCountTest :: IO Database -> TestTree+getCountTest databaseIO = testCase "getCount" $ do+    database <- databaseIO+    count <- Query.fromString "@plants/*" >>= getCount database+    count @?= 4++getListTestQuery :: IO Query.Query+getListTestQuery = do+    query <- Query.fromString "@plants/[isTree=:tree] | asc /name"+    Query.setBool False "tree" query+    return query++getListTest :: IO Database -> TestTree+getListTest databaseIO = testCase "getList" $ do+    database <- databaseIO+    plants <- getListTestQuery >>= getList database+    plants+        @?= [ ( 2+                  , Just nothingPlant { id          = Nothing+                                      , name        = Just "gentiana brentae"+                                      , isTree      = Just False+                                      , year        = Just 2008+                                      , description = Just "violet 🌺flower"+                                      }+                  )+            , ( 3+                  , Just nothingPlant { id          = Nothing+                                      , name        = Just "leontopodium"+                                      , isTree      = Just False+                                      , year        = Just 1817+                                      , description =+                                            Just "tipical alpine flower"+                                      }+                  )+            , ( 4+                  , Just nothingPlant { id          = Nothing+                                      , name        =+                                            Just "leucanthemum vulgare"+                                      , isTree      = Just False+                                      , year        = Just 1778+                                      , description = Just "very common flower in Italy 🍕"+                                      , ratio       = Just 1.618+                                      }+                  )+            ]++getListTest' :: IO Database -> TestTree+getListTest' databaseIO = testCase "getList'" $ do+    database <- databaseIO+    plants <- getListTestQuery >>= getList' database+    plants @?= [ Just nothingPlant { id          = Just 2+                                   , name        = Just "gentiana brentae"+                                   , isTree      = Just False+                                   , year        = Just 2008+                                   , description = Just "violet 🌺flower"+                                   }+               , Just nothingPlant { id          = Just 3+                                   , name        = Just "leontopodium"+                                   , isTree      = Just False+                                   , year        = Just 1817+                                   , description = Just "tipical alpine flower"+                                   }+               , Just nothingPlant { id          = Just 4+                                   , name        = Just "leucanthemum vulgare"+                                   , isTree      = Just False+                                   , year        = Just 1778+                                   , description =+                                         Just "very common flower in Italy 🍕"+                                   , ratio       = Just 1.618+                                   }+               ]++getByIdFromNotExistingCollectionTest :: IO Database -> TestTree+getByIdFromNotExistingCollectionTest databaseIO =+    testCase "getByIdFromNotExistingCollection" $ do+        database <- databaseIO+        assertException (userError "ErrorNotExists") -- this happens only with readonlyOpenFlags+                        (getById database "noexisting" 1 :: IO (Maybe Value))++-- on ejdb_exec there is no error if collection doesn't exists+-- https://github.com/Softmotions/ejdb/blob/40fb43a30e410b4f1bce68f79f397ce44c272c78/src/ejdb2.c#L821+getListFromNotExistingCollectionTest :: IO Database -> TestTree+getListFromNotExistingCollectionTest databaseIO =+    testCase "getListFromNotExistingCollectionTest" $ do+        database <- databaseIO+        query <- Query.fromString "@noexisting/[isTree=:tree] | asc /name"+        Query.setBool False "tree" query+        list <- getList database query :: IO [(Int64, Maybe Value)]+        list @?= []
+ test/IndexTests.hs view
@@ -0,0 +1,52 @@+module IndexTests ( tests ) where++import           Asserts++import qualified Data.Aeson                    as Aeson++import           Database.EJDB2+import qualified Database.EJDB2.CollectionMeta as CollectionMeta+import qualified Database.EJDB2.Meta           as Meta+import           Database.EJDB2.Options++import           Plant++import           Prelude                       hiding ( id )++import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = withResource (open testDatabaseOpts) close $ \databaseIO ->+    testGroup "index"+              [ getMetaTest databaseIO, createAndRemoveIndexTest databaseIO ]++testDatabaseOpts :: Options+testDatabaseOpts = minimalOptions "./test/index-db" [ truncateOpenFlags ]++getMetaTest :: IO Database -> TestTree+getMetaTest databaseIO = testCase "getMetaTest" $ do+    database <- databaseIO+    Just meta <- getMeta database+    let (major : '.' : minor : '.' : _) = Meta.version meta+    [ major, '.', minor ] @?= "2.0"++createAndRemoveIndexTest :: IO Database -> TestTree+createAndRemoveIndexTest databaseIO = testCase "createAndRemoveIndexTest" $ do+    database <- databaseIO+    ensureCollection database "plants"+    ensureIndex database "plants" "/name" mode+    indexesCount <- getIndexesCount database+    indexesCount @?= 1+    removeIndex database "plants" "/name" mode+    indexesCountLast <- getIndexesCount database+    indexesCountLast @?= 0+  where+    mode = [ uniqueIndexMode, strIndexMode ]++getIndexesCount :: Database -> IO Int+getIndexesCount database = do+    Just meta <- getMeta database+    let indexes = CollectionMeta.indexes $ head $ Meta.collections meta+    return $ length indexes+
+ test/Main.hs view
@@ -0,0 +1,35 @@+module Main ( main ) where++import           CollectionTests++import           Database.EJDB2++import           DeleteTests++import           GetTests++import           IndexTests++import           OnlineBackupTests++import           Prelude           hiding ( init )++import           PutTests++import           QueryTests++import           Test.Tasty++main :: IO ()+main = init >> defaultMain Main.tests++tests :: TestTree+tests = testGroup "ejdb2"+                  [ GetTests.tests+                  , QueryTests.tests+                  , PutTests.tests+                  , DeleteTests.tests+                  , CollectionTests.tests+                  , IndexTests.tests+                  , OnlineBackupTests.tests+                  ]
+ test/OnlineBackupTests.hs view
@@ -0,0 +1,53 @@+module OnlineBackupTests ( tests ) where++import           Control.Exception+import           Control.Monad++import           Database.EJDB2+import           Database.EJDB2.Options++import           Plant++import           Prelude                hiding ( id )++import           System.Directory++import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = withResource (open testDatabaseOpts) close $+    \databaseIO -> testGroup "onlineBackup" [ onlineBackupTest databaseIO ]++testDatabaseOpts :: Options+testDatabaseOpts =+    minimalOptions "./test/onlinebackup-db" [ truncateOpenFlags ]++backupFilePath :: String+backupFilePath = "./test/onlinebackup-backup-db"++onlineBackupTest :: IO Database -> TestTree+onlineBackupTest databaseIO = testCase "onlineBackupTest" $ do+    doesFileExist backupFilePath+        >>= \exists -> when exists $ removeFile backupFilePath+    database <- databaseIO+    id <- putNew database "plants" plant+    _ <- onlineBackup database backupFilePath+    backupFileExists <- doesFileExist backupFilePath+    backupFileExists @? "backup file exists"+    databaseLast <- open $ minimalOptions backupFilePath [ readonlyOpenFlags ]+    catch (do+               backupPlant <- getById databaseLast "plants" id+               backupPlant @?= Just plant+               close databaseLast)+          (\e -> do+               close databaseLast+               throw (e :: IOException))+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }+
+ test/Plant.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DeriveGeneric #-}++module Plant where++import           Data.Aeson   ( FromJSON, ToJSON )++import           GHC.Generics++import           Prelude      hiding ( id )++data Plant = Plant { id          :: Maybe Int+                   , name        :: Maybe String+                   , isTree      :: Maybe Bool+                   , year        :: Maybe Int+                   , description :: Maybe String+                   , ratio       :: Maybe Double+                   }+    deriving ( Eq, Generic, Show )++instance FromJSON Plant++instance ToJSON Plant++nothingPlant :: Plant+nothingPlant = Plant Nothing Nothing Nothing Nothing Nothing Nothing
+ test/PutTests.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings #-}++module PutTests ( tests ) where++import qualified Data.Aeson             as Aeson+import qualified Data.HashMap.Strict    as Map+import qualified Data.Vector            as Vector++import           Database.EJDB2+import           Database.EJDB2.Options++import           Plant++import           Prelude                hiding ( id )++import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = withResource (open testDatabaseOpts) close $ \databaseIO ->+    testGroup "put"+              [ putNewTest databaseIO+              , putOnNewIdTest databaseIO+              , putOnExistingIdTest databaseIO+              , mergeOrPutNewTest databaseIO+              , mergeOrPutExistingTest databaseIO+              , patchTest databaseIO+              ]++testDatabaseOpts :: Options+testDatabaseOpts = minimalOptions "./test/put-db" [ truncateOpenFlags ]++putNewTest :: IO Database -> TestTree+putNewTest databaseIO = testCase "putNewTest" $ do+    database <- databaseIO+    id <- putNew database "plants" plant+    storedPlant <- getById database "plants" id+    storedPlant @?= Just plant+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++putOnNewIdTest :: IO Database -> TestTree+putOnNewIdTest databaseIO = testCase "putOnNewIdTest" $ do+    database <- databaseIO+    put database "plants" plant 42+    storedPlant <- getById database "plants" 42+    storedPlant @?= Just plant+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++putOnExistingIdTest :: IO Database -> TestTree+putOnExistingIdTest databaseIO = testCase "putOnExistingIdTest" $ do+    database <- databaseIO+    id <- putNew database "plants" plant+    put database "plants" lastPlant id+    storedPlant <- getById database "plants" id+    storedPlant @?= Just lastPlant+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++    lastPlant = plant { description = Just "a tipical christmas tree" }++mergeOrPutNewTest :: IO Database -> TestTree+mergeOrPutNewTest databaseIO = testCase "mergeOrPutNewTest" $ do+    database <- databaseIO+    mergeOrPut database "plants" plant 4242+    storedPlant <- getById database "plants" 4242+    storedPlant @?= Just plant+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++mergeOrPutExistingTest :: IO Database -> TestTree+mergeOrPutExistingTest databaseIO = testCase "mergeOrPutExistingTest" $ do+    database <- databaseIO+    id <- putNew database "plants" plant+    mergeOrPut database "plants" jsonPatch id+    storedPlant <- getById database "plants" id+    storedPlant @?= Just lastPlant+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++    jsonPatch = Aeson.Object $+        Map.fromList [ ("year", Aeson.Null)+                     , ("description", "a tipical christmas tree")+                     ]++    lastPlant =+        plant { year = Nothing, description = Just "a tipical christmas tree" }++patchTest :: IO Database -> TestTree+patchTest databaseIO = testCase "patchTest" $ do+    database <- databaseIO+    id <- putNew database "plants" plant+    patch database "plants" jsonPatch id+    storedPlant <- getById database "plants" id+    storedPlant @?= Just lastPlant+  where+    plant = nothingPlant { id          = Nothing+                         , name        = Just "pinus"+                         , isTree      = Just True+                         , year        = Just 1753+                         , description = Just "wow 🌲"+                         }++    jsonPatch = Aeson.Array $+        Vector.fromList [ Aeson.Object $ Map.fromList [ ("op", "remove")+                                                      , ("path", "/year")+                                                      ]+                        , Aeson.Object $+                              Map.fromList [ ("op", "replace")+                                           , ("path", "/description")+                                           , ( "value"+                                                 , "a tipical christmas tree"+                                                 )+                                           ]+                        ]++    lastPlant =+        plant { year = Nothing, description = Just "a tipical christmas tree" }
+ test/QueryTests.hs view
@@ -0,0 +1,306 @@+module QueryTests ( tests ) where++import           Asserts++import           Data.Aeson             ( Value )+import           Data.Int++import           Database.EJDB2+import           Database.EJDB2.Options+import qualified Database.EJDB2.Query   as Query++import           Plant++import           Prelude                hiding ( id )++import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = withResource (open testReadOnlyDatabaseOpts) close $ \databaseIO ->+    testGroup "get"+              [ getListWithBoolQueryTest databaseIO+              , getListWithI64QueryTest databaseIO+              , getListWithI64AtIndexQueryTest databaseIO+              , getListWithF64QueryTest databaseIO+              , getListWithF64AtIndexQueryTest databaseIO+              , getListWithStringQueryTest databaseIO+              , getListWithStringAtIndexQueryTest databaseIO+              , getListWithRegexQueryTest databaseIO+              , getListWithRegexAtIndexQueryTest databaseIO+              , getListWithNullQueryTest databaseIO+              , getListWithNullAtIndexQueryTest databaseIO+              , getListWithMixedQueryTest databaseIO+              , getListWithTwoStringsQueryTest databaseIO+              ]++testReadOnlyDatabaseOpts :: Options+testReadOnlyDatabaseOpts =+    minimalOptions "./test/read-only-db" [ readonlyOpenFlags ]++getListWithBoolQueryTest :: IO Database -> TestTree+getListWithBoolQueryTest databaseIO = testCase "getListWithBoolQuery" $ do+    database <- databaseIO+    query <- Query.fromString "@plants/[isTree=:?] | asc /name"+    Query.setBoolAtIndex False 0 query+    plants <- getList database query+    plants+        @?= [ ( 2+                  , Just nothingPlant { id          = Nothing+                                      , name        = Just "gentiana brentae"+                                      , isTree      = Just False+                                      , year        = Just 2008+                                      , description = Just "violet 🌺flower"+                                      }+                  )+            , ( 3+                  , Just nothingPlant { id          = Nothing+                                      , name        = Just "leontopodium"+                                      , isTree      = Just False+                                      , year        = Just 1817+                                      , description =+                                            Just "tipical alpine flower"+                                      }+                  )+            , ( 4+                  , Just nothingPlant { id          = Nothing+                                      , name        =+                                            Just "leucanthemum vulgare"+                                      , isTree      = Just False+                                      , year        = Just 1778+                                      , description = Just "very common flower in Italy 🍕"+                                      , ratio       = Just 1.618+                                      }+                  )+            ]++getListWithI64QueryTest :: IO Database -> TestTree+getListWithI64QueryTest databaseIO = testCase "getListWithI64Query" $ do+    database <- databaseIO+    query <- Query.fromString "@plants/[year>:year] | asc /name"+    Query.setI64 1800 "year" query+    plants <- getList database query+    plants+        @?= [ ( 2+                  , Just nothingPlant { id          = Nothing+                                      , name        = Just "gentiana brentae"+                                      , isTree      = Just False+                                      , year        = Just 2008+                                      , description = Just "violet 🌺flower"+                                      }+                  )+            , ( 3+                  , Just nothingPlant { id          = Nothing+                                      , name        = Just "leontopodium"+                                      , isTree      = Just False+                                      , year        = Just 1817+                                      , description =+                                            Just "tipical alpine flower"+                                      }+                  )+            ]++getListWithI64AtIndexQueryTest :: IO Database -> TestTree+getListWithI64AtIndexQueryTest databaseIO = testCase "getListWithI64AtIndexQuery" $ do+    database <- databaseIO+    query <- Query.fromString "@plants/[year>:?] | asc /name"+    Query.setI64AtIndex 1800 0 query+    plants <- getList database query+    plants+        @?= [ ( 2+                  , Just nothingPlant { id          = Nothing+                                      , name        = Just "gentiana brentae"+                                      , isTree      = Just False+                                      , year        = Just 2008+                                      , description = Just "violet 🌺flower"+                                      }+                  )+            , ( 3+                  , Just nothingPlant { id          = Nothing+                                      , name        = Just "leontopodium"+                                      , isTree      = Just False+                                      , year        = Just 1817+                                      , description =+                                            Just "tipical alpine flower"+                                      }+                  )+            ]++getListWithF64QueryTest :: IO Database -> TestTree+getListWithF64QueryTest databaseIO = testCase "getListWithF64Query" $ do+    database <- databaseIO+    query <- Query.fromString "@plants/[ratio > :ratio] | asc /name"+    Query.setF64 1.6 "ratio" query+    plants <- getList database query+    plants @?= [ ( 4+                     , Just nothingPlant { id          = Nothing+                                         , name        =+                                               Just "leucanthemum vulgare"+                                         , isTree      = Just False+                                         , year        = Just 1778+                                         , description = Just "very common flower in Italy 🍕"+                                         , ratio       = Just 1.618+                                         }+                     )+               ]++getListWithF64AtIndexQueryTest :: IO Database -> TestTree+getListWithF64AtIndexQueryTest databaseIO =+    testCase "getListWithF64AtIndexQuery" $ do+        database <- databaseIO+        query <- Query.fromString "@plants/[ratio > :?] | asc /name"+        Query.setF64AtIndex 1.6 0 query+        plants <- getList database query+        plants @?= [ ( 4+                         , Just nothingPlant { id          = Nothing+                                             , name        =+                                                   Just "leucanthemum vulgare"+                                             , isTree      = Just False+                                             , year        = Just 1778+                                             , description = Just "very common flower in Italy 🍕"+                                             , ratio       = Just 1.618+                                             }+                         )+                   ]++getListWithStringQueryTest :: IO Database -> TestTree+getListWithStringQueryTest databaseIO = testCase "getListWithStringQuery" $ do+    database <- databaseIO+    query <- Query.fromString "@plants/[name=:name] | asc /name"+    Query.setString "pinus" "name" query+    plants <- getList database query+    plants @?= [ ( 1+                     , Just nothingPlant { id          = Nothing+                                         , name        = Just "pinus"+                                         , isTree      = Just True+                                         , year        = Just 1753+                                         , description = Just "wow 🌲"+                                         }+                     )+               ]++getListWithStringAtIndexQueryTest :: IO Database -> TestTree+getListWithStringAtIndexQueryTest databaseIO =+    testCase "getListWithStringAtIndexQuery" $ do+        database <- databaseIO+        query <- Query.fromString "@plants/[name=:?] | asc /name"+        Query.setStringAtIndex "pinus" 0 query+        plants <- getList database query+        plants @?= [ ( 1+                         , Just nothingPlant { id          = Nothing+                                             , name        = Just "pinus"+                                             , isTree      = Just True+                                             , year        = Just 1753+                                             , description = Just "wow 🌲"+                                             }+                         )+                   ]++getListWithRegexQueryTest :: IO Database -> TestTree+getListWithRegexQueryTest databaseIO = testCase "getListWithRegexQuery" $ do+    database <- databaseIO+    query+        <- Query.fromString "@plants/[description re :description ] | asc /name"+    Query.setRegex ".*Italy.*" "description" query+    plants <- getList database query+    plants @?= [ ( 4+                     , Just nothingPlant { id          = Nothing+                                         , name        =+                                               Just "leucanthemum vulgare"+                                         , isTree      = Just False+                                         , year        = Just 1778+                                         , description = Just "very common flower in Italy 🍕"+                                         , ratio       = Just 1.618+                                         }+                     )+               ]++getListWithRegexAtIndexQueryTest :: IO Database -> TestTree+getListWithRegexAtIndexQueryTest databaseIO =+    testCase "getListWithRegexAtIndexQuery" $ do+        database <- databaseIO+        query <- Query.fromString "@plants/[description re :?] | asc /name"+        Query.setRegexAtIndex "very.*Italy" 0 query+        plants <- getList database query+        plants @?= [ ( 4+                         , Just nothingPlant { id          = Nothing+                                             , name        =+                                                   Just "leucanthemum vulgare"+                                             , isTree      = Just False+                                             , year        = Just 1778+                                             , description = Just "very common flower in Italy 🍕"+                                             , ratio       = Just 1.618+                                             }+                         )+                   ]++getListWithNullQueryTest :: IO Database -> TestTree+getListWithNullQueryTest databaseIO = testCase "getListWithNullQuery" $ do+    database <- databaseIO+    query <- Query.fromString "@plants/[ratio=:ratio] | asc /name"+    Query.setNull "ratio" query+    plants <- getList database query+    plants @?= [ ( 1+                     , Just nothingPlant { id          = Nothing+                                         , name        = Just "pinus"+                                         , isTree      = Just True+                                         , year        = Just 1753+                                         , description = Just "wow 🌲"+                                         , ratio       = Nothing+                                         }+                     )+               ]++getListWithNullAtIndexQueryTest :: IO Database -> TestTree+getListWithNullAtIndexQueryTest databaseIO =+    testCase "getListWithNullAtIndexQuery" $ do+        database <- databaseIO+        query <- Query.fromString "@plants/[ratio=:?] | asc /name"+        Query.setNullAtIndex 0 query+        plants <- getList database query+        plants @?= [ ( 1+                         , Just nothingPlant { id          = Nothing+                                             , name        = Just "pinus"+                                             , isTree      = Just True+                                             , year        = Just 1753+                                             , description = Just "wow 🌲"+                                             , ratio       = Nothing+                                             }+                         )+                   ]++getListWithMixedQueryTest :: IO Database -> TestTree+getListWithMixedQueryTest databaseIO = testCase "getListWithMixedQuery" $ do+    database <- databaseIO+    query <- Query.fromString "@plants/[year>:year] and /[isTree=:?] and /[name=:?] | asc /name"+    Query.setI64 1700 "year" query+    Query.setBoolAtIndex True 0 query+    Query.setStringAtIndex "pinus" 1 query+    plants <- getList database query+    plants @?= [ ( 1+                     , Just nothingPlant { id          = Nothing+                                         , name        = Just "pinus"+                                         , isTree      = Just True+                                         , year        = Just 1753+                                         , description = Just "wow 🌲"+                                         }+                     )+               ]++getListWithTwoStringsQueryTest :: IO Database -> TestTree+getListWithTwoStringsQueryTest databaseIO =+    testCase "getListWithTwoStringsQuery" $ do+        database <- databaseIO+        query <- Query.fromString "@plants/[description re :descr] and /[name=:name] | asc /name"+        Query.setRegex ".*wow.*" "descr" query+        Query.setString "pinus" "name" query+        plants <- getList database query+        plants @?= [ ( 1+                         , Just nothingPlant { id          = Nothing+                                             , name        = Just "pinus"+                                             , isTree      = Just True+                                             , year        = Just 1753+                                             , description = Just "wow 🌲"+                                             }+                         )+                   ]
+ test/read-only-db view
binary file changed (absent → 20480 bytes)