higher-leveldb 0.4.0.1 → 0.5.0.0
raw patch · 3 files changed
+22/−55 lines, 3 filesdep +unliftio-coredep −lifted-basedep −monad-controldep ~basedep ~resourcet
Dependencies added: unliftio-core
Dependencies removed: lifted-base, monad-control
Dependency ranges changed: base, resourcet
Files
- higher-leveldb.cabal +3/−6
- src/Database/LevelDB/Higher.hs +16/−46
- test/Database/LevelDB/HigherSpec.hs +3/−3
higher-leveldb.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: higher-leveldb-version: 0.4.0.1+version: 0.5.0.0 synopsis: A rich monadic API for working with leveldb databases. description: A rich monadic API for working with leveldb databases. homepage: https://github.com/jeremyjh/higher-leveldb@@ -31,12 +31,11 @@ , data-default >= 0.5.1 && < 0.8 , exceptions >= 0.6.0 , leveldb-haskell >= 0.2 && <= 0.7- , lifted-base >= 0.2.1.1 && < 0.3- , monad-control >= 0.3 && < 1.1 , mtl >= 2.0 && < 2.3- , resourcet >= 1.1.0 && <= 1.2+ , resourcet >= 1.2.0 && <= 1.3 , transformers >= 0.3 && < 0.6 , transformers-base >= 0.4.1 && < 0.5+ , unliftio-core >= 0.1 && < 0.2 test-suite spec@@ -53,8 +52,6 @@ , leveldb-haskell , bytestring , process- , monad-control , transformers-base , mtl , transformers- , lifted-base
src/Database/LevelDB/Higher.hs view
@@ -43,7 +43,7 @@ , runResourceT , Options(..), ReadOptions(..), WriteOptions(..), RWOptions , WriteBatch, def- , MonadThrow, MonadResourceBase+ , MonadThrow, MonadUnliftIO ) where @@ -56,8 +56,11 @@ #endif import Control.Monad.Base (MonadBase(..)) -import Control.Concurrent.MVar.Lifted import Control.Concurrent (ThreadId)+import Control.Concurrent.MVar (MVar+ , newMVar+ , takeMVar+ , putMVar) import qualified Data.ByteString as BS import Data.ByteString (ByteString)@@ -68,18 +71,15 @@ import Database.LevelDB hiding (put, get, delete, write, withSnapshot) import Control.Monad.Trans.Resource-import Control.Monad.Trans.Control import Control.Monad.Catch (MonadCatch (..) , MonadMask (..)) - #if MIN_VERSION_mtl(2,2,1) import qualified Control.Monad.Except as Except #else import qualified Control.Monad.Trans.Error as Error #endif - import qualified Control.Monad.Trans.Cont as Cont import qualified Control.Monad.Trans.Identity as Identity import qualified Control.Monad.Trans.List as List@@ -151,7 +151,7 @@ instance MonadTrans LevelDBT where lift = LevelDBT . lift . lift -instance (MonadResourceBase m) => MonadResource (LevelDBT m) where+instance (MonadUnliftIO m) => MonadResource (LevelDBT m) where liftResourceT = LevelDBT . liftResourceT instance MonadCatch m => MonadCatch (LevelDBT m) where@@ -171,42 +171,12 @@ q u (LevelDBT (ReaderT b)) = LevelDBT $ ReaderT (u . b) -#if MIN_VERSION_monad_control(1,0,0)-instance MonadTransControl LevelDBT where- type StT LevelDBT a = StT ResourceT (StT (ReaderT DBContext) a)- liftWith f =- LevelDBT $ liftWith $ \run ->- liftWith $ \run' ->- f $ run' . run . unLevelDBT- restoreT = LevelDBT . restoreT . restoreT--instance (MonadBaseControl b m) => MonadBaseControl b (LevelDBT m) where- type StM (LevelDBT m) a = ComposeSt LevelDBT m a- liftBaseWith = defaultLiftBaseWith- restoreM = defaultRestoreM-#else-instance MonadTransControl LevelDBT where- newtype StT LevelDBT a = StLevelDBT- {unStLevelDBT :: StT ResourceT (StT (ReaderT DBContext) a) }- liftWith f =- LevelDBT $ liftWith $ \run ->- liftWith $ \run' ->- f $ liftM StLevelDBT . run' . run . unLevelDBT- restoreT = LevelDBT . restoreT . restoreT . liftM unStLevelDBT--instance (MonadBaseControl b m) => MonadBaseControl b (LevelDBT m) where- newtype StM (LevelDBT m) a = StMT {unStMT :: ComposeSt LevelDBT m a}- liftBaseWith = defaultLiftBaseWith StMT- restoreM = defaultRestoreM unStMT-#endif- -- | MonadLevelDB class used by all the public functions in this module. class ( Monad m , MonadThrow m , MonadIO m , Applicative m- , MonadResource m- , MonadBase IO m )+ , MonadResource m ) => MonadLevelDB m where -- | Override context for an action - only usable internally for functions -- like 'withKeySpace' and 'withOptions'.@@ -214,7 +184,7 @@ -- | Lift a LevelDBT IO action into the current monad. liftLevelDB :: LevelDBT IO a -> m a -instance (MonadResourceBase m) => MonadLevelDB (LevelDBT m) where+instance (MonadThrow m, MonadUnliftIO m) => MonadLevelDB (LevelDBT m) where liftLevelDB = mapLevelDBT liftIO withDBContext = localLDB @@ -252,7 +222,7 @@ -- tip: you can use the Data.Default (def) method to specify default options e.g. -- -- > runLevelDB "/tmp/mydb" def (def, def{sync = true}) "My Keyspace" $ do-runLevelDB :: (MonadResourceBase m)+runLevelDB :: (MonadThrow m, MonadUnliftIO m) => FilePath -- ^ path to DB to open/create -> Options -- ^ database options to use -> RWOptions -- ^ default read/write ops; use 'withOptions' to override@@ -263,7 +233,7 @@ -- |Same as 'runLevelDB' but doesn't call 'runResourceT'. This gives you the option -- to manage that yourself-runLevelDB' :: (MonadResourceBase m)+runLevelDB' :: (MonadThrow m, MonadUnliftIO m) => FilePath -- ^ path to DB to open/create -> Options -- ^ database options to use -> RWOptions -- ^ default read/write ops; use 'withOptions' to override@@ -272,7 +242,7 @@ -> ResourceT m a runLevelDB' path dbopt rwopt ks ma = do db <- openDB- mv <- newMVar 0+ mv <- liftIO $ newMVar 0 ksId <- withSystemContext db mv $ getKeySpaceId ks runReaderT (unLevelDBT ma) (DBC db ksId mv rwopt) where@@ -281,7 +251,7 @@ runReaderT (unLevelDBT sctx) $ DBC db systemKeySpaceId mv rwopt -- | A helper for runLevelDB using default 'Options' except createIfMissing=True-runCreateLevelDB :: (MonadResourceBase m)+runCreateLevelDB :: (MonadThrow m, MonadUnliftIO m) => FilePath -- ^ path to DB to open/create -> KeySpace -- ^ "Bucket" in which Keys will be unique -> LevelDBT m a -- ^ The actions to execute@@ -496,10 +466,10 @@ -- | This little dance with asksLDB & localLDB let's us get away from -- exposing MonadReader DBContext in LevelDBT.-asksLDB :: (MonadResourceBase m) => (DBContext -> a) -> LevelDBT m a+asksLDB :: (MonadUnliftIO m) => (DBContext -> a) -> LevelDBT m a asksLDB = LevelDBT . asks -localLDB :: (MonadResourceBase m)+localLDB :: (MonadUnliftIO m) => (DBContext -> DBContext) -> LevelDBT m a -> LevelDBT m a localLDB f ma = LevelDBT $ local f (unLevelDBT ma)@@ -541,8 +511,8 @@ case findMaxId of (Just found) -> putMVarDBC $ decodeKsId found Nothing -> putMVarDBC 2 -- first user keyspace- putMVarDBC v = asksLDB dbcSyncMV >>= flip putMVar v- takeMVarDBC = asksLDB dbcSyncMV >>= takeMVar+ putMVarDBC v = asksLDB dbcSyncMV >>= liftIO . flip putMVar v+ takeMVarDBC = asksLDB dbcSyncMV >>= liftIO . takeMVar decodeKsId bs = case decode bs of Left e -> error $
test/Database/LevelDB/HigherSpec.hs view
@@ -9,12 +9,12 @@ import Test.Hspec import System.Process(system) import Database.LevelDB.Higher+import Control.Concurrent (ThreadId, threadDelay) import Control.Monad.Trans.Resource import Control.Monad.Reader import Control.Monad.Writer import Control.Applicative (Applicative) import Control.Monad.Base (MonadBase(..))-import Control.Concurrent.Lifted --debug import Debug.Trace@@ -128,9 +128,9 @@ put "onetwo" "three" forkTestAppR $ do rv <- ask- threadDelay 1+ liftIO $ threadDelay 1 put "three" rv- threadDelay 100+ liftIO $ threadDelay 100 get "three" `shouldReturn` Just "a string value to read" it "scans with a keyspace" $ do