rocksdb-haskell 1.0.0 → 1.0.1
raw patch · 3 files changed
+67/−16 lines, 3 filesdep +directory
Dependencies added: directory
Files
- rocksdb-haskell.cabal +2/−1
- src/Database/RocksDB/Base.hs +47/−7
- tests/tests.hs +18/−8
rocksdb-haskell.cabal view
@@ -1,5 +1,5 @@ name: rocksdb-haskell-version: 1.0.0+version: 1.0.1 synopsis: Haskell bindings to RocksDB homepage: http://github.com/serokell/rocksdb-haskell bug-reports: http://github.com/serokell/rocksdb-haskell/issues@@ -43,6 +43,7 @@ , binary , bytestring , data-default+ , directory , filepath , resourcet > 0.3.2 , transformers
src/Database/RocksDB/Base.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TupleSections #-}+ -- | -- Module : Database.RocksDB.Base -- Copyright : (c) 2012-2013 The leveldb-haskell Authors@@ -66,7 +69,7 @@ import Control.Applicative ((<$>)) import Control.Exception (bracket, bracketOnError, finally)-import Control.Monad (liftM)+import Control.Monad (liftM, when) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Resource (MonadResource (..), ReleaseKey, allocate,@@ -77,7 +80,8 @@ import Data.ByteString.Internal (ByteString (..)) import qualified Data.ByteString.Lazy as BSL import Foreign-import Foreign.C.String (withCString)+import Foreign.C.String (CString, withCString)+import System.Directory (createDirectoryIfMissing) import Database.RocksDB.C import Database.RocksDB.Internal@@ -87,6 +91,9 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BU +import qualified GHC.Foreign as GHC+import qualified GHC.IO.Encoding as GHC+ -- | Create a 'BloomFilter' bloomFilter :: MonadResource m => Int -> m BloomFilter bloomFilter i =@@ -127,10 +134,34 @@ -- -- The returned handle should be released with 'close'. open :: MonadIO m => FilePath -> Options -> m DB-open path opts = liftIO $ bracketOnError (mkOpts opts) freeOpts mkDB+open path opts = liftIO $ bracketOnError initialize finalize mkDB where- mkDB opts'@(Options' opts_ptr _ _) =- withCString path $ \path_ptr ->+# ifdef mingw32_HOST_OS+ initialize =+ (, ()) <$> mkOpts opts+ finalize (opts', ()) =+ freeOpts opts'+# else+ initialize = do+ opts' <- mkOpts opts+ -- With LC_ALL=C, two things happen:+ -- * rocksdb can't open a database with unicode in path;+ -- * rocksdb can't create a folder properly.+ -- So, we create the folder by ourselves, and for thart we+ -- need to set the encoding we're going to use. On Linux+ -- it's almost always UTC-8.+ oldenc <- GHC.getFileSystemEncoding+ when (createIfMissing opts) $+ GHC.setFileSystemEncoding GHC.utf8+ pure (opts', oldenc)+ finalize (opts', oldenc) = do+ freeOpts opts'+ GHC.setFileSystemEncoding oldenc+# endif+ mkDB (opts'@(Options' opts_ptr _ _), _) = do+ when (createIfMissing opts) $+ createDirectoryIfMissing True path+ withFilePath path $ \path_ptr -> liftM (`DB` opts') $ throwIfErr "open" $ c_rocksdb_open opts_ptr path_ptr@@ -184,7 +215,7 @@ destroy path opts = liftIO $ bracket (mkOpts opts) freeOpts destroy' where destroy' (Options' opts_ptr _ _) =- withCString path $ \path_ptr ->+ withFilePath path $ \path_ptr -> throwIfErr "destroy" $ c_rocksdb_destroy_db opts_ptr path_ptr -- | Repair the given RocksDB database.@@ -192,7 +223,7 @@ repair path opts = liftIO $ bracket (mkOpts opts) freeOpts repair' where repair' (Options' opts_ptr _ _) =- withCString path $ \path_ptr ->+ withFilePath path $ \path_ptr -> throwIfErr "repair" $ c_rocksdb_repair_db opts_ptr path_ptr @@ -307,3 +338,12 @@ bsToBinary :: Binary v => ByteString -> v bsToBinary x = Binary.decode (BSL.fromStrict x)++-- | Marshal a 'FilePath' (Haskell string) into a `NUL` terminated C string using+-- temporary storage.+-- On Linux, UTF-8 is almost always the encoding used.+-- When on Windows, UTF-8 can also be used, although the default for those devices is+-- UTF-16. For a more detailed explanation, please refer to+-- https://msdn.microsoft.com/en-us/library/windows/desktop/dd374081(v=vs.85).aspx.+withFilePath :: FilePath -> (CString -> IO a) -> IO a+withFilePath = GHC.withCString GHC.utf8
tests/tests.hs view
@@ -1,19 +1,21 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Resource (MonadResource, runResourceT)-import Data.Default-import System.Process (system)+import Data.Default (def) import System.IO.Temp (withSystemTempDirectory)-import Test.Hspec-import Test.Hspec.Expectations-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck -import Database.RocksDB+import Database.RocksDB (Compression (..), DB, compression,+ createIfMissing, defaultOptions, get, open,+ put) +import Test.Hspec (describe, hspec, it, shouldReturn)+import Test.QuickCheck (Arbitrary (..), UnicodeString (..),+ generate)+ initializeDB :: MonadResource m => FilePath -> m DB initializeDB path = open@@ -28,7 +30,15 @@ it "should put items into the database and retrieve them" $ do runResourceT $ withSystemTempDirectory "rocksdb" $ \path -> do db <- initializeDB path+ put db def "zzz" "zzz"+ get db def "zzz"+ `shouldReturn` (Just "zzz") + it "should put items into a database whose filepath has unicode characters and\+ \ retrieve them" $ do+ runResourceT $ withSystemTempDirectory "rocksdb" $ \path -> do+ unicode <- getUnicodeString <$> liftIO (generate arbitrary)+ db <- initializeDB $ path ++ unicode put db def "zzz" "zzz" get db def "zzz" `shouldReturn` (Just "zzz")