leveldb-haskell 0.1.1 → 0.2.0

raw patch · 7 files changed

+230/−77 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Readme.md +8/−0
• examples/features.hs +13/−0
• examples/filterpolicy.hs +2/−38
• examples/giantwrite.hs +1/−1
• leveldb-haskell.cabal +2/−2
• src/Database/LevelDB.hs +128/−9
• src/Database/LevelDB/Base.hsc +76/−27

@@ -3,6 +3,14 @@  ## History +Version 0.2.0:++* requires LevelDB v1.7+* support for filter policy (LevelDB v1.5), either custom or using the built-in+  bloom filter implementation+* write batch values no longer require a `memcpy` to be early-finalizer-safe+  (introduced in 0.1.1)+ Version 0.1.0:  * memory (foreign pointers) is managed through

@@ -16,6 +16,8 @@  main :: IO () main = runResourceT $ do+    printVersion+     db <- open "/tmp/leveltest"                defaultOptions{ createIfMissing = True                              , cacheSize= 2048@@ -65,3 +67,14 @@         printProperty l p = liftIO $ do             putStrLn l             maybe (putStrLn "n/a") putStrLn $ p++        printVersion = do+            v <- versionBS+            liftIO . putStrLn $ "LevelDB Version: " `append` v++        versionBS = do+            (major, minor) <- version+            return $ intToBs major `append` "." `append` intToBs minor++        intToBs :: Int -> ByteString+        intToBs = pack . show

@@ -5,19 +5,13 @@ module Main where  import Control.Monad.IO.Class (liftIO)-import Data.BloomFilter-import Data.BloomFilter.Easy  (easyList)-import Data.BloomFilter.Hash  (cheapHashes)-import Data.ByteString.Char8  (take) import Data.Default  import Database.LevelDB -import qualified Data.Serialize as S --builtinBloom :: IO ()-builtinBloom = runResourceT $ do+main :: IO ()+main = runResourceT $ do     bloom <- bloomFilter 10     db <- open "/tmp/lvlbloomtest"                defaultOptions { createIfMissing = True@@ -32,33 +26,3 @@     get db def "xxx" >>= liftIO . print      return ()--customFilterPolicy :: IO ()-customFilterPolicy = runResourceT $ do-    let create bs     = S.encode . bitArrayB $ easyList 0.01 bs-        maymatch k bs = False-        fp = FilterPolicy-               { fpName = "custom.filter.policy"-               , createFilter = create-               , keyMayMatch  = maymatch-               }--    db <- open "/tmp/lvlfptest"-               defaultOptions { createIfMissing = True-                              , filterPolicy    = Just . Right $ fp-                              }--    put db def "zzz" "zzz"-    put db def "yyy" "yyy"-    put db def "xxx" "xxx"--    get db def "yyy" >>= liftIO . print-    get db def "xxx" >>= liftIO . print--    return ()---main :: IO ()-main = do-    builtinBloom-    customFilterPolicy

@@ -21,6 +21,6 @@                defaultOptions { createIfMissing = True }      let w x = put db def x x-    mapM_ (w . BC.pack . show) [1..10000000]+    mapM_ (w . BC.pack . show) [1..100000]      approximateSize db ("0", "z") >>= liftIO . print

@@ -1,5 +1,5 @@ name:                leveldb-haskell-version:             0.1.1+version:             0.2.0 synopsis:            Haskell bindings to LevelDB homepage:            http://github.com/kim/leveldb-haskell bug-reports:         http://github.com/kim/leveldb-haskell/issues@@ -28,7 +28,7 @@     .     Note: as of v1.3, LevelDB can be built as a shared library. Thus, as of     v0.1.0 of this library, LevelDB is no longer bundled and must be installed-    on the target system (version 1.3 or greater).+    on the target system (version 1.7 or greater is required).  extra-source-files:  Readme.md, examples/*.hs 

@@ -40,11 +40,16 @@   , createSnapshot   , createSnapshot' +  -- * Filter Policy / Bloom Filter+  , FilterPolicy(..)+  , bloomFilter+   -- * Administrative Functions   , Property(..), getProperty   , destroy   , repair   , approximateSize+  , version    -- * Iteration   , Iterator@@ -78,6 +83,7 @@ import Control.Monad.IO.Class             (liftIO) import Control.Monad.Trans.Resource import Data.ByteString                    (ByteString)+import Data.ByteString.Internal           (ByteString(..)) import Data.Default import Data.Maybe                         (catMaybes) import Foreign@@ -116,6 +122,30 @@                                (FunPtr NameFun)                                ComparatorPtr +-- | User-defined filter policy+data FilterPolicy = FilterPolicy+    { fpName       :: String+    , createFilter :: [ByteString] -> ByteString+    , keyMayMatch  :: ByteString -> ByteString -> Bool+    }++data FilterPolicy' = FilterPolicy' (FunPtr CreateFilterFun)+                                   (FunPtr KeyMayMatchFun)+                                   (FunPtr Destructor)+                                   (FunPtr NameFun)+                                   FilterPolicyPtr++-- | Represents the built-in Bloom Filter+newtype BloomFilter = BloomFilter FilterPolicyPtr++bloomFilter :: MonadResource m => Int -> m BloomFilter+bloomFilter i = do+    let i' = fromInteger . toInteger $ i+    fp_ptr <- snd <$> allocate (c_leveldb_filterpolicy_create_bloom i')+                               (c_leveldb_filterpolicy_destroy)+    return . BloomFilter $ fp_ptr++ -- | Options when opening a database data Options = Options     { blockRestartInterval :: !Int@@ -195,6 +225,7 @@       -- database is opened.       --       -- Default: 4MB+    , filterPolicy         :: !(Maybe (Either BloomFilter FilterPolicy))     }  defaultOptions :: Options@@ -209,6 +240,7 @@     , maxOpenFiles         = 1000     , paranoidChecks       = False     , writeBufferSize      = 4 `shift` 20+    , filterPolicy         = Nothing     }  instance Default Options where@@ -218,6 +250,7 @@     { _optsPtr  :: !OptionsPtr     , _cachePtr :: !(Maybe CachePtr)     , _comp     :: !(Maybe Comparator')+    , _fpPtr    :: !(Maybe (Either FilterPolicyPtr FilterPolicy'))     }  -- | Options for write operations@@ -298,7 +331,7 @@     allocate (mkDB opts') freeDB      where-        mkDB (Options' opts_ptr _ _) =+        mkDB (Options' opts_ptr _ _ _) =             withCString path $ \path_ptr ->                 liftM DB                 $ throwIfErr "open"@@ -362,7 +395,7 @@     release rk      where-        destroy' (Options' opts_ptr _ _) =+        destroy' (Options' opts_ptr _ _ _) =             withCString path $ \path_ptr ->                 throwIfErr "destroy" $ c_leveldb_destroy_db opts_ptr path_ptr @@ -374,7 +407,7 @@     release rk      where-        repair' (Options' opts_ptr _ _) =+        repair' (Options' opts_ptr _ _ _) =             withCString path $ \path_ptr ->                 throwIfErr "repair" $ c_leveldb_repair_db opts_ptr path_ptr @@ -460,21 +493,31 @@         $ throwIfErr "write"         $ c_leveldb_write db_ptr opts_ptr batch_ptr +    -- ensure @ByteString@s (and respective shared @CStringLen@s) aren't GC'ed+    -- until here+    mapM_ (liftIO . touch) batch+     release rk_opts     release rk_batch      where         batchAdd batch_ptr (Put key val) =-            BS.useAsCStringLen key $ \(key_ptr, klen) ->-            BS.useAsCStringLen val $ \(val_ptr, vlen) ->+            BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+            BU.unsafeUseAsCStringLen val $ \(val_ptr, vlen) ->                 c_leveldb_writebatch_put batch_ptr                                          key_ptr (intToCSize klen)                                          val_ptr (intToCSize vlen)          batchAdd batch_ptr (Del key) =-            BS.useAsCStringLen key $ \(key_ptr, klen) ->+            BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->                 c_leveldb_writebatch_delete batch_ptr key_ptr (intToCSize klen) +        touch (Put (PS p _ _) (PS p' _ _)) = do+            touchForeignPtr p+            touchForeignPtr p'++        touch (Del (PS p _ _)) = touchForeignPtr p+ -- | Run an action with an Iterator. The iterator will be closed after the -- action returns or an error is thrown. Thus, the iterator will /not/ be valid -- after this function terminates.@@ -676,6 +719,16 @@ iterValues :: MonadResource m => Iterator -> m [ByteString] iterValues iter = catMaybes <$> mapIter iterValue iter ++-- | Return the runtime version of the underlying LevelDB library as a (major,+-- minor) pair.+version :: MonadResource m => m (Int, Int)+version = do+    major <- liftIO c_leveldb_major_version+    minor <- liftIO c_leveldb_minor_version++    return (cIntToInt major, cIntToInt minor)+ -- -- Internal --@@ -703,8 +756,9 @@      cache <- maybeSetCache opts_ptr cacheSize     cmp   <- maybeSetCmp opts_ptr comparator+    fp    <- maybeSetFilterPolicy opts_ptr filterPolicy -    return (Options' opts_ptr cache cmp)+    return (Options' opts_ptr cache cmp fp)      where         ccompression NoCompression = noCompression@@ -729,11 +783,27 @@             c_leveldb_options_set_comparator opts_ptr cmp_ptr             return cmp' +        maybeSetFilterPolicy :: OptionsPtr+                             -> Maybe (Either BloomFilter FilterPolicy)+                             -> IO (Maybe (Either FilterPolicyPtr FilterPolicy'))+        maybeSetFilterPolicy _ Nothing = return Nothing+        maybeSetFilterPolicy opts_ptr (Just (Left (BloomFilter bloom_ptr))) = do+            c_leveldb_options_set_filter_policy opts_ptr bloom_ptr+            return Nothing -- bloom filter is freed automatically+        maybeSetFilterPolicy opts_ptr (Just (Right fp)) = do+            fp'@(FilterPolicy' _ _ _ _ fp_ptr) <- mkFilterPolicy fp+            c_leveldb_options_set_filter_policy opts_ptr fp_ptr+            return . Just . Right $ fp'+ freeOpts :: Options' -> IO ()-freeOpts (Options' opts_ptr mcache_ptr mcmp_ptr) = do+freeOpts (Options' opts_ptr mcache_ptr mcmp_ptr mfp) = do     c_leveldb_options_destroy opts_ptr     maybe (return ()) c_leveldb_cache_destroy mcache_ptr     maybe (return ()) freeComparator mcmp_ptr+    maybe (return ())+          (either c_leveldb_filterpolicy_destroy freeFilterPolicy)+          mfp+     return ()  mkCWriteOpts :: MonadResource m => WriteOptions -> m (ReleaseKey, WriteOptionsPtr)@@ -792,6 +862,10 @@ intToCInt = fromIntegral {-# INLINE intToCInt #-} +cIntToInt :: CInt -> Int+cIntToInt = fromIntegral+{-# INLINE cIntToInt #-}+ boolToNum :: Num b => Bool -> b boolToNum True  = fromIntegral (1 :: Int) boolToNum False = fromIntegral (0 :: Int)@@ -799,6 +873,7 @@  mkCompareFun :: (ByteString -> ByteString -> Ordering) -> CompareFun mkCompareFun cmp = cmp'+     where         cmp' _ a alen b blen = do             a' <- BS.packCStringLen (a, fromInteger . toInteger $ alen)@@ -811,7 +886,7 @@ mkComparator :: String -> (ByteString -> ByteString -> Ordering) -> IO Comparator' mkComparator name f =     withCString name $ \cs -> do-        ccmpfun <- mkCmp  $ mkCompareFun f+        ccmpfun <- mkCmp . mkCompareFun $ f         cdest   <- mkDest $ \_ -> ()         cname   <- mkName $ \_ -> cs         ccmp    <- c_leveldb_comparator_create nullPtr cdest ccmpfun cname@@ -822,5 +897,49 @@ freeComparator (Comparator' ccmpfun cdest cname ccmp) = do     c_leveldb_comparator_destroy ccmp     freeHaskellFunPtr ccmpfun+    freeHaskellFunPtr cdest+    freeHaskellFunPtr cname++mkCreateFilterFun :: ([ByteString] -> ByteString) -> CreateFilterFun+mkCreateFilterFun f = f'++    where+        f' _ ks ks_lens n_ks flen = do+            let n_ks' = fromInteger . toInteger $ n_ks+            ks'      <- peekArray n_ks' ks+            ks_lens' <- peekArray n_ks' ks_lens+            keys     <- mapM bstr (zip ks' ks_lens')+            let res = f keys+            poke flen (fromIntegral . BS.length $ res)+            BS.useAsCString res $ \cstr -> return cstr++        bstr (x,len) = BS.packCStringLen (x, fromInteger . toInteger $ len)++mkKeyMayMatchFun :: (ByteString -> ByteString -> Bool) -> KeyMayMatchFun+mkKeyMayMatchFun g = g'++    where+        g' _ k klen f flen = do+            k' <- BS.packCStringLen (k, fromInteger . toInteger $ klen)+            f' <- BS.packCStringLen (f, fromInteger . toInteger $ flen)+            return . boolToNum $ g k' f'+++mkFilterPolicy :: FilterPolicy -> IO FilterPolicy'+mkFilterPolicy FilterPolicy{..} =+    withCString fpName $ \cs -> do+        cname  <- mkName $ \_ -> cs+        cdest  <- mkDest $ \_ -> ()+        ccffun <- mkCF . mkCreateFilterFun $ createFilter+        ckmfun <- mkKMM . mkKeyMayMatchFun $ keyMayMatch+        cfp    <- c_leveldb_filterpolicy_create nullPtr cdest ccffun ckmfun cname++        return $ FilterPolicy' ccffun ckmfun cdest cname cfp++freeFilterPolicy :: FilterPolicy' -> IO ()+freeFilterPolicy (FilterPolicy' ccffun ckmfun cdest cname cfp) = do+    c_leveldb_filterpolicy_destroy cfp+    freeHaskellFunPtr ccffun+    freeHaskellFunPtr ckmfun     freeHaskellFunPtr cdest     freeHaskellFunPtr cname

@@ -26,6 +26,7 @@ data LSnapshot data LWriteBatch data LWriteOptions+data LFilterPolicy  type LevelDBPtr      = Ptr LevelDB type CachePtr        = Ptr LCache@@ -37,18 +38,7 @@ type SnapshotPtr     = Ptr LSnapshot type WriteBatchPtr   = Ptr LWriteBatch type WriteOptionsPtr = Ptr LWriteOptions---- custom env from haskell doesn't make too much sense-data LEnv-data LFileLock-data LRandomFile-data LSeqfile-data LWritableFile-type EnvPtr          = Ptr LEnv-type FileLockPtr     = Ptr LFileLock-type RandomFilePtr   = Ptr LRandomFile-type WritableFilePtr = Ptr LWritableFile-type SeqfilePtr      = Ptr LSeqfile+type FilterPolicyPtr = Ptr LFilterPolicy  type DBName = CString type ErrPtr = Ptr CString@@ -113,7 +103,6 @@ foreign import ccall safe "leveldb/c.h leveldb_property_value"   c_leveldb_property_value :: LevelDBPtr -> CString -> IO CString --- not sure why this needs to be imported safe foreign import ccall safe "leveldb/c.h leveldb_approximate_sizes"   c_leveldb_approximate_sizes :: LevelDBPtr                               -> CInt                     -- ^ num ranges@@ -128,8 +117,11 @@ foreign import ccall safe "leveldb/c.h leveldb_repair_db"   c_leveldb_repair_db :: OptionsPtr -> DBName -> ErrPtr -> IO () --- ^ Iterator +--+-- Iterator+--+ foreign import ccall safe "leveldb/c.h leveldb_create_iterator"   c_leveldb_create_iterator :: LevelDBPtr -> ReadOptionsPtr -> IO IteratorPtr @@ -163,8 +155,11 @@ foreign import ccall safe "leveldb/c.h leveldb_iter_get_error"   c_leveldb_iter_get_error :: IteratorPtr -> ErrPtr -> IO () --- ^ Write batch +--+-- Write batch+--+ foreign import ccall safe "leveldb/c.h leveldb_writebatch_create"   c_leveldb_writebatch_create :: IO WriteBatchPtr @@ -190,8 +185,11 @@                                -> FunPtr (Ptr () -> Key -> CSize)     -- ^ delete                                -> IO () --- ^ Options +--+-- Options+--+ foreign import ccall safe "leveldb/c.h leveldb_options_create"   c_leveldb_options_create :: IO OptionsPtr @@ -201,6 +199,9 @@ foreign import ccall safe "leveldb/c.h leveldb_options_set_comparator"   c_leveldb_options_set_comparator :: OptionsPtr -> ComparatorPtr -> IO () +foreign import ccall safe "leveldb/c.h leveldb_options_set_filter_policy"+  c_leveldb_options_set_filter_policy :: OptionsPtr -> FilterPolicyPtr -> IO ()+ foreign import ccall safe "leveldb/c.h leveldb_options_set_create_if_missing"   c_leveldb_options_set_create_if_missing :: OptionsPtr -> CUChar -> IO () @@ -210,9 +211,6 @@ foreign import ccall safe "leveldb/c.h leveldb_options_set_paranoid_checks"   c_leveldb_options_set_paranoid_checks :: OptionsPtr -> CUChar -> IO () -foreign import ccall safe "leveldb/c.h leveldb_options_set_env"-  c_leveldb_options_set_env :: OptionsPtr -> EnvPtr -> IO ()- foreign import ccall safe "leveldb/c.h leveldb_options_set_info_log"   c_leveldb_options_set_info_log :: OptionsPtr -> LoggerPtr -> IO () @@ -234,9 +232,11 @@ foreign import ccall safe "leveldb/c.h leveldb_options_set_cache"   c_leveldb_options_set_cache :: OptionsPtr -> CachePtr -> IO () + -- -- Comparator --+ type StatePtr   = Ptr () type Destructor = StatePtr -> () type CompareFun = StatePtr -> CString -> CSize -> CString -> CSize -> IO CInt@@ -261,8 +261,48 @@ foreign import ccall safe "leveldb/c.h leveldb_comparator_destroy"   c_leveldb_comparator_destroy :: ComparatorPtr -> IO () --- ^ Read options +--+-- Filter Policy+--++type CreateFilterFun = StatePtr+                     -> Ptr CString -- ^ key array+                     -> Ptr CSize   -- ^ key length array+                     -> CInt        -- ^ num keys+                     -> Ptr CSize   -- ^ filter length+                     -> IO CString  -- ^ the filter+type KeyMayMatchFun  = StatePtr+                     -> CString     -- ^ key+                     -> CSize       -- ^ key length+                     -> CString     -- ^ filter+                     -> CSize       -- ^ filter length+                     -> IO CUChar   -- ^ whether key is in filter++-- | Make a FunPtr to a user-defined create_filter function+foreign import ccall "wrapper" mkCF :: CreateFilterFun -> IO (FunPtr CreateFilterFun)++-- | Make a FunPtr to a user-defined key_may_match function+foreign import ccall "wrapper" mkKMM :: KeyMayMatchFun -> IO (FunPtr KeyMayMatchFun)++foreign import ccall safe "leveldb/c.h leveldb_filterpolicy_create"+  c_leveldb_filterpolicy_create :: StatePtr+                                -> FunPtr Destructor+                                -> FunPtr CreateFilterFun+                                -> FunPtr KeyMayMatchFun+                                -> FunPtr NameFun+                                -> IO FilterPolicyPtr++foreign import ccall safe "leveldb/c.h leveldb_filterpolicy_destroy"+  c_leveldb_filterpolicy_destroy :: FilterPolicyPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_filterpolicy_create_bloom"+  c_leveldb_filterpolicy_create_bloom :: CInt -> IO FilterPolicyPtr++--+-- Read options+--+ foreign import ccall safe "leveldb/c.h leveldb_readoptions_create"   c_leveldb_readoptions_create :: IO ReadOptionsPtr @@ -278,8 +318,11 @@ foreign import ccall safe "leveldb/c.h leveldb_readoptions_set_snapshot"   c_leveldb_readoptions_set_snapshot :: ReadOptionsPtr -> SnapshotPtr -> IO () --- ^ Write options +--+-- Write options+--+ foreign import ccall safe "leveldb/c.h leveldb_writeoptions_create"   c_leveldb_writeoptions_create :: IO WriteOptionsPtr @@ -289,18 +332,24 @@ foreign import ccall safe "leveldb/c.h leveldb_writeoptions_set_sync"   c_leveldb_writeoptions_set_sync :: WriteOptionsPtr -> CUChar -> IO () --- ^ Cache +--+-- Cache+--+ foreign import ccall safe "leveldb/c.h leveldb_cache_create_lru"   c_leveldb_cache_create_lru :: CSize -> IO CachePtr  foreign import ccall safe "leveldb/c.h leveldb_cache_destroy"   c_leveldb_cache_destroy :: CachePtr -> IO () --- ^ Env -foreign import ccall safe "leveldb/c.h leveldb_create_default_env"-  c_leveldb_create_default_env :: IO EnvPtr+--+-- Version+-- -foreign import ccall safe "leveldb/c.h leveldb_env_destroy"-  c_leveldb_env_destroy :: EnvPtr -> IO ()+foreign import ccall unsafe "leveldb/c.h leveldb_major_version"+  c_leveldb_major_version :: IO CInt++foreign import ccall unsafe "leveldb/c.h leveldb_minor_version"+  c_leveldb_minor_version :: IO CInt