diff --git a/higher-leveldb.cabal b/higher-leveldb.cabal --- a/higher-leveldb.cabal +++ b/higher-leveldb.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: higher-leveldb -version: 0.3.0.1 +version: 0.3.1.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 @@ -34,12 +34,13 @@ , transformers-base >= 0.4.1 && < 0.5 , mtl >= 2.0 && < 2.3 , monad-control >= 0.3 && < 1.1 - , data-default >= 0.5.1 && < 0.6 + , data-default >= 0.5.1 && < 0.8 , transformers >= 0.3 && < 0.6 test-suite spec ghc-options: -optl-Wl,-rpath,/usr/local/lib,-enable-new-dtags + other-modules: Database.LevelDB.HigherSpec type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs diff --git a/src/Database/LevelDB/Higher.hs b/src/Database/LevelDB/Higher.hs --- a/src/Database/LevelDB/Higher.hs +++ b/src/Database/LevelDB/Higher.hs @@ -218,7 +218,7 @@ INST(Monoid w, Strict.RWST r w s, Strict.mapRWST) #if MIN_VERSION_mtl(2,2,1) -INST(Except.MonadError e m, Except.ExceptT e, Except.mapExceptT) +INST(Monad m, Except.ExceptT e, Except.mapExceptT) #else INST(Error.Error e, Error.ErrorT e, Error.mapErrorT) #endif diff --git a/test/Database/LevelDB/HigherSpec.hs b/test/Database/LevelDB/HigherSpec.hs new file mode 100644 --- /dev/null +++ b/test/Database/LevelDB/HigherSpec.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Database.LevelDB.HigherSpec (main, spec) where + +import qualified Data.ByteString as BS +import Data.Serialize (encode) +import Data.Monoid +import Test.Hspec +import System.Process(system) +import Database.LevelDB.Higher +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 +debug :: (Show a) => a -> a +debug a = traceShow a a +--debug + + +main :: IO () +main = hspec spec + +setup :: IO () +setup = system ("rm -rf " <> testDB) >> return () + +spec :: Spec +spec = do + it "setup" $ setup >>= shouldReturn (return()) + describe "has a reader context API that" $ do + it "can put" $ do + withDBT $ put "putgetkey" "putgetvalue" + `shouldReturn` () + it "can get" $ do + withDBT $ get "putgetkey" + `shouldReturn` (Just "putgetvalue") + it "can delete" $ do + withDBRT $ do + put "deletekey" "doesn't matter" + delete "deletekey" + get "deletekey" + `shouldReturn` Nothing + it "can isolate data with keyspaces" $ do + runCreateLevelDB testDB "thespace" $ do + put "thekey" "thevalue" + withKeySpace "otherspace" $ put "thekey" "othervalue" + get "thekey" + `shouldReturn` (Just "thevalue") + it "can override read/write options locally" $ do + withDBT $ do + withOptions (def, def {sync = True}) $ do + put "puttingsync" "can't you tell?" + get "puttingsync" + `shouldReturn` Just "can't you tell?" + it "can scan and transform" $ do + runCreateLevelDB testDB "scan" $ do + put "employee:1" "Jill" + put "employee:2" "Jack" + put "cheeseburgers:1" "do not want" + r1 <- scan "employee:" queryItems + r2 <- scan "employee" $ + queryList {scanMap = \ (k, v) -> v <> " Smith"} + r3 <- scan "e" + queryItems { scanFilter = \ (_, v) -> v > "Jack" } + r4 <- scan "employee" $ + queryBegins { scanInit = 0 + , scanMap = \ (_, v) -> BS.head v + , scanFold = (+) } + return (r1, r2, r3, r4) + `shouldReturn` ( [("employee:1", "Jill"), ("employee:2", "Jack")] + , [ "Jill Smith", "Jack Smith"] + , [("employee:1", "Jill")] + , 148) + it "can write data in batches" $ do + runLevelDB testDB dbOpts def "batches" $ do + runBatch $ do + putB "\1" "first" + putB "\2" "second" + putB "\3" "third" + deleteB "\2" + scan "" queryCount + `shouldReturn` 2 + it "will do consistent reads in a snapshot" $ do + runCreateLevelDB testDB "snapshot" $ do + put "first" "initial value" + withSnapshot $ do + put "first" "don't see me" + get "first" + `shouldReturn` Just "initial value" + describe "can be used in a custom MonadT stack" $ do + it "can be used with a reader" $ do + runTestAppR testDB "TestAppReader" $ do + value <- ask + put "thiskey" value + get "thiskey" + `shouldReturn` (Just "a string value to read") + it "still works withKeySpace" $ do + runTestAppR testDB "TestAppReader" $ do + withKeySpace "TestAppReader2" $ do + notit <- get "thiskey" -- not found in this keyspace + gotit <- ask -- our top Reader still works + return (notit, gotit) + `shouldReturn` (Nothing, "a string value to read") + it "can be used with a writer" $ do + runTestAppW testDB "TestAppWriter" $ do + put "writekey" "words" + tell "tolja" + withKeySpace "TestAppWriter2" $ do + put "writekey" "not these words" + tell "twice" + get "writekey" + `shouldReturn` (Just "words", "toljatwice") + it "can work with a reader/writer" $ do + runTestAppRW testDB "TestAppRW" $ do + v <- ask + put "writekey" v + tell "toljer" + get "writekey" + `shouldReturn` (Just "a different string value to read" + , "toljer") + it "can get forked" $ do + runTestAppR testDB "forkInReader" $ do + put "onetwo" "three" + forkTestAppR $ do + rv <- ask + threadDelay 1 + put "three" rv + threadDelay 100 + get "three" + `shouldReturn` Just "a string value to read" + it "scans with a keyspace" $ do + withDBT $ withKeySpace "overflow" $ do + forM ([1..10] :: [Int]) $ \i -> do + put (encode i) "hi guys" + xs <- scan "" queryItems + return $ length xs + `shouldReturn` 10 + + +testDB = "/tmp/leveltest" +dbOpts = def {createIfMissing = True, cacheSize= 2048} + +withDBT :: LevelDBT IO a -> IO a +withDBT = runLevelDB testDB dbOpts def "Database.LevelDB.HigherSpec" + +withDBRT :: LevelDBT IO a -> IO a +withDBRT = runResourceT . runLevelDB' testDB dbOpts def "Database.LevelDB.HigherSpec" + +runTestAppR :: FilePath -> KeySpace -> TestAppR a -> IO a +runTestAppR path ks ta = runLevelDB path dbOpts def ks $ do + runReaderT (unTestAppR ta) "a string value to read" + +runTestAppW :: FilePath -> KeySpace -> TestAppW a -> IO (a, BS.ByteString) +runTestAppW path ks ta = runLevelDB path dbOpts def ks $ do + runWriterT (unTestAppW ta) + +runTestAppRW :: FilePath -> KeySpace -> TestAppRW a -> IO (a, BS.ByteString) +runTestAppRW path ks ta = runLevelDB path dbOpts def ks $ do + runWriterT $ runReaderT (unTestAppRW ta) "a different string value to read" + +forkTestAppR :: TestAppR () -> TestAppR ThreadId +forkTestAppR ma = TestAppR $ + mapReaderT + (\ld -> forkLevelDB ld) + (unTestAppR ma) + + +newtype TestAppR a = TestAppR { unTestAppR :: ReaderT BS.ByteString (LevelDBT IO) a} + deriving ( Functor, Applicative, Monad, MonadBase IO + , MonadReader BS.ByteString, MonadResource + , MonadIO, MonadThrow, MonadLevelDB + ) + +newtype TestAppW a = TestAppW { unTestAppW :: WriterT BS.ByteString (LevelDBT IO) a} + deriving ( Functor, Applicative, Monad, MonadBase IO + , MonadWriter BS.ByteString, MonadResource + , MonadIO, MonadThrow, MonadLevelDB + ) +newtype TestAppRW a = TestAppRW { unTestAppRW :: ReaderT BS.ByteString + (WriterT BS.ByteString (LevelDBT IO)) a} + deriving ( Functor, Applicative, Monad, MonadBase IO + , MonadReader BS.ByteString, MonadWriter BS.ByteString, MonadResource + , MonadIO, MonadThrow, MonadLevelDB)