ejdb2-binding 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+106/−43 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• ejdb2-binding.cabal +2/−1
• src/Database/EJDB2.hs +54/−23
• src/Database/EJDB2/JBL.hs +1/−19
• test/FoldTests.hs +38/−0
• test/Main.hs +3/−0

@@ -0,0 +1,8 @@+# Changelog+All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),++## [0.2.0.0] - 2020-04-19+### Added+- fold function to reduce a query result

@@ -3,7 +3,7 @@ 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+version:             0.2.0.0 license:             MIT license-file:        LICENSE homepage:            https://github.com/cescobaz/ejdb2haskell#readme@@ -69,6 +69,7 @@                        CollectionTests                        IndexTests                        OnlineBackupTests+                       FoldTests   build-depends:       base ^>=4.12.0.0                      , tasty ^>=1.2.3                      , tasty-hunit ^>=0.10.0.2

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Database.EJDB2     ( init     , Database@@ -28,6 +30,7 @@     , ensureIndex     , removeIndex     , onlineBackup+    , fold     ) where  import           Control.Exception@@ -35,6 +38,7 @@  import qualified Data.Aeson                             as Aeson import qualified Data.ByteString                        as BS+import qualified Data.HashMap.Strict                    as Map import           Data.IORef import           Data.Int import           Data.Word@@ -129,42 +133,68 @@     \countPtr -> c_ejdb_count ejdb jql countPtr 0 >>= checkRC >> peek countPtr     >>= \(CIntMax int) -> return int +exec :: EJDBExecVisitor -> Database -> Query -> IO ()+exec visitor (Database _ ejdb) (Query jql _ _) = do+    visitor <- mkEJDBExecVisitor visitor+    let exec = EJDBExec.zero { db = ejdb, q = jql, EJDBExec.visitor = visitor }+    finally (with exec c_ejdb_exec >>= checkRC) (freeHaskellFunPtr visitor)++-- | Iterate over query result building the result+fold :: Aeson.FromJSON b+     => Database+     -> (a+         -> (Int64, Maybe b)+         -> a) -- ^ The second argument is a tuple with the object id and the object+     -> a -- ^ Initial result+     -> Query+     -> IO a+fold database f i query = newIORef (f, i) >>= \ref ->+    exec (foldVisitor ref) database query >> snd <$> readIORef ref++foldVisitor :: Aeson.FromJSON b+            => IORef ((a -> (Int64, Maybe b) -> a), a)+            -> EJDBExecVisitor+foldVisitor ref _ docPtr _ = do+    doc <- peek docPtr+    value <- decode (raw doc)+    let id = fromIntegral $ EJDBDoc.id doc+    modifyIORef' ref $ \(f, partial) -> (f, f partial (id, value))+    return 0+ {-|   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+getList database query = reverse <$> fold database foldList [] query -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+foldList :: Aeson.FromJSON a+         => [(Int64, Maybe a)]+         -> (Int64, Maybe a)+         -> [(Int64, Maybe a)]+foldList = flip (:)  {-|   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'+getList' database query = reverse <$> fold database foldList' [] query -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+foldList'+    :: Aeson.FromJSON a => [Maybe a] -> (Int64, Maybe Aeson.Value) -> [Maybe a]+foldList' list (id, value) = parse (setId id value) : list -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)+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+ {-|   Save new document into collection under new generated identifier. -}@@ -321,3 +351,4 @@ onlineBackup (Database _ ejdb) filePath = withCString filePath $ \cFilePath ->     alloca $ \timestampPtr -> c_ejdb_online_backup ejdb timestampPtr cFilePath     >>= checkRC >> peek timestampPtr >>= \(CUIntMax t) -> return t+

@@ -1,13 +1,10 @@-{-# LANGUAGE OverloadedStrings #-}--module Database.EJDB2.JBL ( decode, decode', encode, encodeToByteString ) where+module Database.EJDB2.JBL ( 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 @@ -21,9 +18,6 @@ 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@@ -31,18 +25,6 @@     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

@@ -0,0 +1,38 @@+module FoldTests where++import           Data.Int++import qualified Database.EJDB2         as DB+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 (DB.open testReadOnlyDatabaseOpts) DB.close $+    \databaseIO -> testGroup "get" [ foldOnIsTreeTest databaseIO ]++testReadOnlyDatabaseOpts :: Options+testReadOnlyDatabaseOpts =+    DB.minimalOptions "./test/read-only-db" [ DB.readonlyOpenFlags ]++foldOnIsTreeTest :: IO DB.Database -> TestTree+foldOnIsTreeTest databaseIO = testCase "foldOnIsTree" $ do+    database <- databaseIO+    query <- Query.fromString "@plants/*"+    result <- DB.fold database foldOnIsTree (0, 0) query+    result @?= (1, 3)++foldOnIsTree :: (Int, Int) -> (Int64, Maybe Plant) -> (Int, Int)+foldOnIsTree acc (_, Nothing) = acc+foldOnIsTree acc@(trueCount, falseCount) (_, Just plant) =+    maybe acc+          (\flag -> if flag+                    then (trueCount + 1, falseCount)+                    else (trueCount, falseCount + 1))+          (isTree plant)

@@ -6,6 +6,8 @@  import           DeleteTests +import           FoldTests+ import           GetTests  import           IndexTests@@ -32,4 +34,5 @@                   , CollectionTests.tests                   , IndexTests.tests                   , OnlineBackupTests.tests+                  , FoldTests.tests                   ]