lmdb-simple 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+190/−35 lines, 7 filesdep ~binarydep ~bytestringdep ~lmdbPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: binary, bytestring, lmdb

API changes (from Hackage documentation)

Files

• lmdb-simple.cabal +6/−4
• src/Database/LMDB/Simple.hs +15/−8
• src/Database/LMDB/Simple/DBRef.hs +122/−0
• src/Database/LMDB/Simple/Internal.hs +7/−10
• src/Database/LMDB/Simple/View.hs +4/−3
• test/Database/LMDB/Simple/DBRefSpec.hs +27/−0
• test/Database/LMDB/SimpleSpec.hs +9/−10

@@ -1,6 +1,6 @@  name:                lmdb-simple-version:             0.1.0.0+version:             0.2.0.0  synopsis:            Simple API for LMDB @@ -35,14 +35,15 @@   hs-source-dirs:      src    exposed-modules:     Database.LMDB.Simple+                       Database.LMDB.Simple.DBRef                        Database.LMDB.Simple.Extra                        Database.LMDB.Simple.View   other-modules:       Database.LMDB.Simple.Internal    build-depends:       base >= 4.7 && < 5-                     , binary >= 0.8-                     , bytestring-                     , lmdb >= 0.2+                     , binary >= 0.8 && < 0.9+                     , bytestring >= 0.10 && < 0.11+                     , lmdb >= 0.2 && < 0.3   ghc-options:         -Wall -Wno-name-shadowing -Wno-unused-do-bind   default-language:    Haskell2010   default-extensions:  Trustworthy@@ -64,6 +65,7 @@   hs-source-dirs:      test   main-is:             hspec.hs   other-modules:       Database.LMDB.SimpleSpec+                       Database.LMDB.Simple.DBRefSpec                        Harness   build-depends:       base                      , hspec

@@ -32,9 +32,16 @@   print =<< readOnlyTransaction env (get db "nine")  -- Nothing @ -Additional functions for querying and modifying LMDB databases are provided in-"Database.LMDB.Simple.Extra". For an option to access LMDB databases from pure-code, see "Database.LMDB.Simple.View".+These additional APIs are available:++  * "Database.LMDB.Simple.Extra" provides additional functions for querying+    and modifying LMDB databases within the 'Transaction' monad++  * "Database.LMDB.Simple.View" provides a read-only snapshot of an LMDB+    database that can be accessed from pure code++  * "Database.LMDB.Simple.DBRef" provides a mutable variable (accessed from+    'IO') that is tied to a particular key that persists in an LMDB database -}  module Database.LMDB.Simple@@ -275,12 +282,12 @@ -- -- An exception will cause the nested transaction to be implicitly aborted. nestTransaction :: Transaction ReadWrite a -> Transaction ReadWrite (Maybe a)-nestTransaction tx@(Txn tf) = Txn $ run (isReadOnlyTransaction tx)-  where run ro ptxn = let env = mdb_txn_env ptxn in maybeAborted $-          bracketOnError (mdb_txn_begin env (Just ptxn) ro) mdb_txn_abort $-          \ctxn -> tf ctxn >>= \result -> mdb_txn_commit ctxn >> return result+nestTransaction (Txn tf) = Txn $ \ptxn ->+  let env = mdb_txn_env ptxn in maybeAborted $+  bracketOnError (mdb_txn_begin env (Just ptxn) False) mdb_txn_abort $+  \ctxn -> tf ctxn >>= \result -> mdb_txn_commit ctxn >> return result -        maybeAborted :: IO a -> IO (Maybe a)+  where maybeAborted :: IO a -> IO (Maybe a)         maybeAborted io = either           (\e -> let _ = e :: AbortedTransaction in Nothing) Just <$> try io 

@@ -0,0 +1,122 @@++-- | This module provides a mutable variable 'DBRef' that is similar in+-- concept to 'Data.IORef.IORef' except that it is tied to a particular key+-- that persists in an LMDB database.++module Database.LMDB.Simple.DBRef+  ( DBRef+  , newDBRef+  , readDBRef+  , writeDBRef+  , modifyDBRef_+  , modifyDBRef+  ) where++import Control.Monad+  ( (>=>)+  , void+  )++import Control.Monad.IO.Class+  ( MonadIO (liftIO)+  )++import Data.Binary+  ( Binary+  , encode+  )++import Data.ByteString+  ( ByteString+  )++import Data.ByteString.Lazy+  ( toStrict+  )++import Data.ByteString.Unsafe+  ( unsafeUseAsCStringLen+  )++import Database.LMDB.Raw+  ( MDB_dbi'+  , MDB_val (..)+  , mdb_get'+  , mdb_put'+  , mdb_del'+  )++import Database.LMDB.Simple+  ( transaction+  )++import Database.LMDB.Simple.Internal+  ( Environment (..)+  , Transaction (..)+  , Database (..)+  , ReadWrite+  , ReadOnly+  , marshalIn+  , marshalOut+  , defaultWriteFlags+  )++import Foreign+  ( castPtr+  )++-- | A 'DBRef' is a reference to a particular key within an LMDB database. It+-- may be empty ('Nothing') if the key does not currently exist in the+-- database, or it may contain a 'Just' value corresponding to the key.+--+-- A 'DBRef' may be 'ReadWrite' or 'ReadOnly', depending on the environment+-- within which it is created. Note that 'ReadOnly' does not imply that the+-- contained value will not change, since the LMDB database could be modified+-- externally.+data DBRef mode a = Ref (Environment mode) MDB_dbi' ByteString++-- | Create a new 'DBRef' for the given key and database within the given+-- environment.+newDBRef :: Binary k+         => Environment mode -> Database k a -> k -> IO (DBRef mode a)+newDBRef env (Db _ dbi) = return . Ref env dbi . toStrict . encode++withVal :: ByteString -> (MDB_val -> IO a) -> IO a+withVal bs f = unsafeUseAsCStringLen bs $ \(ptr, len) ->+  f $ MDB_val (fromIntegral len) (castPtr ptr)++-- | Read the current value of a 'DBRef'.+readDBRef :: Binary a => DBRef mode a -> IO (Maybe a)+readDBRef ref@(Ref env dbi key) = transaction env (tx ref)++  where tx :: Binary a => DBRef mode a -> Transaction ReadOnly (Maybe a)+        tx _ = Txn $ \txn -> withVal key $ mdb_get' txn dbi >=>+          maybe (return Nothing) (liftIO . fmap Just . marshalIn)++-- | Write a new value into a 'DBRef'.+writeDBRef :: Binary a => DBRef ReadWrite a -> Maybe a -> IO ()+writeDBRef (Ref env dbi key) = transaction env . maybe delKey putKey++  where delKey :: Transaction ReadWrite ()+        delKey = Txn $ \txn -> withVal key $ \kval ->+          void $ mdb_del' txn dbi kval Nothing++        putKey :: Binary a => a -> Transaction ReadWrite ()+        putKey value = Txn $ \txn -> withVal key $ \kval ->+          marshalOut value $ \vval ->  -- FIXME: use mdb_reserve'+          void $ mdb_put' defaultWriteFlags txn dbi kval vval++-- | Atomically mutate the contents of a 'DBRef'.+modifyDBRef_ :: Binary a => DBRef ReadWrite a -> (Maybe a -> Maybe a) -> IO ()+modifyDBRef_ ref f = modifyDBRef ref $ \x -> (f x, ())++-- | Atomically mutate the contents of a 'DBRef' and return a value.+modifyDBRef :: Binary a => DBRef ReadWrite a -> (Maybe a -> (Maybe a, b)) -> IO b+modifyDBRef (Ref env dbi key) = transaction env . tx++  where tx :: Binary a => (Maybe a -> (Maybe a, b)) -> Transaction ReadWrite b+        tx f = Txn $ \txn -> withVal key $ \kval -> mdb_get' txn dbi kval >>=+          maybe (return Nothing) (fmap Just . marshalIn) >>= \x ->+          let (x', r) = f x in maybe (mdb_del' txn dbi kval Nothing)+            (flip marshalOut $ mdb_put' defaultWriteFlags txn dbi kval) x' >>+          return r

@@ -98,14 +98,11 @@ data ReadWrite data ReadOnly -class Mode mode where-  isReadOnlyMode :: mode -> Bool--instance Mode ReadWrite where-  isReadOnlyMode _ = False+class Mode a where+  isReadOnlyMode :: a -> Bool -instance Mode ReadOnly where-  isReadOnlyMode _ = True+instance Mode ReadWrite where isReadOnlyMode _ = False+instance Mode ReadOnly  where isReadOnlyMode _ = True  type family SubMode a b :: Constraint where   SubMode a ReadWrite = a ~ ReadWrite@@ -122,7 +119,7 @@  -- | An LMDB transaction is an atomic unit for reading and/or changing one or -- more LMDB databases within an environment, during which the transaction has--- a consistent view of the databases and is unaffected by any other+-- a consistent view of the database(s) and is unaffected by any other -- transaction. The effects of a transaction can either be committed to the -- LMDB environment atomically, or they can be rolled back with no observable -- effect on the environment if the transaction is aborted.@@ -146,7 +143,7 @@ isReadWriteTransaction = not . isReadOnlyTransaction  instance Functor (Transaction mode) where-  fmap f (Txn tf) = Txn $ \txn -> fmap f (tf txn)+  fmap f (Txn tf) = Txn $ fmap f . tf  instance Applicative (Transaction mode) where   pure x = Txn $ \_ -> pure x@@ -156,7 +153,7 @@   Txn tf >>= f = Txn $ \txn -> tf txn >>= \r -> let Txn tf' = f r in tf' txn  instance MonadIO (Transaction mode) where-  liftIO io = Txn $ const io+  liftIO = Txn . const  -- | A database maps arbitrary keys to values. This API uses the 'Binary' -- class to serialize keys and values for LMDB to store on disk.

@@ -1,7 +1,8 @@ -{-| This module provides a read-only 'View' for an LMDB database at a single-point in time. Because the view is unchanging, it can be used within pure-code. Behind the scenes, data is accessed from the underlying LMDB memory map.+{-| This module provides a read-only 'View' that is a snapshot of an LMDB+database at a single point in time. Because the view is unchanging, it can be+used within pure code. Behind the scenes, data is accessed from the underlying+LMDB memory map.  Each 'View' internally keeps open a read-only transaction in the LMDB environment (consuming a slot in the lock table), so their use should be

@@ -0,0 +1,27 @@++module Database.LMDB.Simple.DBRefSpec+  ( spec+  ) where++import Database.LMDB.Simple.DBRef+import Harness+import Test.Hspec++spec :: Spec+spec = beforeAll (setup >>= \(env, db) -> newDBRef env db 0) $ do++  it "starts empty" $ \ref ->+    readDBRef ref+    `shouldReturn` Nothing++  it "reads what is written" $ \ref ->+    (writeDBRef ref (Just "foo") >> readDBRef ref)+    `shouldReturn` Just "foo"++  it "reads what is modified" $ \ref ->+    (modifyDBRef_ ref (fmap (++ "bar")) >> readDBRef ref)+    `shouldReturn` Just "foobar"++  it "can be made empty again" $ \ref ->+    (writeDBRef ref Nothing >> readDBRef ref)+    `shouldReturn` Nothing

@@ -10,44 +10,43 @@ import Test.Hspec  spec :: Spec-spec = do-  (env, db) <- runIO setup+spec = beforeAll setup $ do    describe "basic operations" $ do-    it "inserts and counts entries" $+    it "inserts and counts entries" $ \(env, db) ->       transaction env       ( do forM_ [1..100] $ \i -> put db i (Just $ show i)            size db       ) `shouldReturn` 100 -    it "retrieves entries" $+    it "retrieves entries" $ \(env, db) ->       readOnlyTransaction env (forM [1..100] $ \i -> get db i)       `shouldReturn` map (Just . show) [1 :: Int .. 100] -    it "deletes entries" $+    it "deletes entries" $ \(env, db) ->       transaction env (put db 50 Nothing >> (,) <$> get db 50 <*> size db)       `shouldReturn` (Nothing, 99)    describe "transactions" $ do-    it "aborts" $+    it "aborts" $ \(env, db) ->       transaction env (put db 0 (Just "zero") >> abort)       `shouldThrow` (const True :: Selector AbortedTransaction) -    it "rolls back" $+    it "rolls back" $ \(env, db) ->       readOnlyTransaction env (get db 0)       `shouldReturn` Nothing -    it "aborts nested transactions" $+    it "aborts nested transactions" $ \(env, db) ->       transaction env       ( do put db 1 (Just "one")            nestTransaction $ put db 2 (Just "two") >> abort       ) `shouldReturn` (Nothing :: Maybe ()) -    it "rolls back nested transactions" $+    it "rolls back nested transactions" $ \(env, db) ->       readOnlyTransaction env ((,) <$> get db 1 <*> get db 2)       `shouldReturn` (Just "one", Just "2") -    it "commits nested transactions" $+    it "commits nested transactions" $ \(env, db) ->       transaction env       ( do nestTransaction (put db 3 $ Just "three")            get db 3