leveldb-haskell-fork (empty) → 0.3.1
raw patch · 18 files changed
+2175/−0 lines, 18 filesdep +QuickCheckdep +asyncdep +basesetup-changed
Dependencies added: QuickCheck, async, base, bytestring, data-default, filepath, hspec, hspec-expectations, leveldb-haskell, mtl, process, resourcet, transformers
Files
- AUTHORS +8/−0
- CHANGELOG +28/−0
- LICENSE +30/−0
- Readme.md +73/−0
- Setup.hs +2/−0
- examples/comparator.hs +31/−0
- examples/features.hs +80/−0
- examples/filterpolicy.hs +28/−0
- examples/iterforkio.hs +36/−0
- leveldb-haskell-fork.cabal +169/−0
- src/Database/LevelDB.hs +16/−0
- src/Database/LevelDB/Base.hs +254/−0
- src/Database/LevelDB/C.hsc +355/−0
- src/Database/LevelDB/Internal.hs +291/−0
- src/Database/LevelDB/Iterator.hs +227/−0
- src/Database/LevelDB/MonadResource.hs +285/−0
- src/Database/LevelDB/Types.hs +217/−0
- tests/tests.hs +45/−0
+ AUTHORS view
@@ -0,0 +1,8 @@+# The following people, listed in alphabetical order, contributed to the+# leveldb-haskell library:++Austin Seipp+Kim Altintop+Michael Lazarev+Nicolas Trangez+Will Moss
+ CHANGELOG view
@@ -0,0 +1,28 @@+[0.3.0]:++* ResourceT is no longer compulsory+++[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)+++[0.1.0]:++* memory (foreign pointers) is managed through+ [ResourceT](http://hackage.haskell.org/package/resourcet). Note that this+ requires to lift monadic actions inside the `MonadResource` monad, see the+ examples.+* links against shared library (LevelDB v1.3 or higher)+* LevelDB 1.3 API fully supported (including custom comparators, excluding+ custom environments)+++[0.0.x]:++* experimental releases
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011, Kim Altintop++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Kim Altintop nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Readme.md view
@@ -0,0 +1,73 @@+This library provides Haskell bindings to+[LevelDB](http://leveldb.googlecode.com)++[](http://travis-ci.org/kim/leveldb-haskell)++## History++Version 0.3.0:++* ResourceT is no longer compulsory++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+ [ResourceT](http://hackage.haskell.org/package/resourcet). Note that this+ requires to lift monadic actions inside the `MonadResource` monad, see the+ examples.+* links against shared library (LevelDB v1.3 or higher)+* LevelDB 1.3 API fully supported (including custom comparators, excluding+ custom environments)++Version 0.0.x:++* experimental releases++## Installation++Prerequisites:++* [GHC 7.*](http://www.haskell.org/ghc)+* [Cabal](http://www.haskell.org/cabal), version 1.3 or higher+* [LevelDB](http://code.google.com/p/leveldb)+* Optional: [Snappy](http://code.google.com/p/snappy),+ if compression support is desired++**Note:** as of version 1.3, LevelDB can be built as a shared library. Thus, as+of version 0.1.0 of this library, LevelDB is no longer bundled and must be+installed on the target system.++To install the latest version from hackage:++```shell+$ cabal install leveldb-haskell+```++To install from checked-out source:++```shell+$ cabal install+```++## Notes++This library is in very early stage and has seen very limited testing. Comments+and contributions are welcome.++## Bugs and Contributing++Please report issues via http://github.com/kim/leveldb-haskell/issues.<br />+Patches are best submitted as pull requests, or via email+(kim.altintop@gmail.com).++## License++BSD 3, see LICENSE file.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/comparator.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Demo custom comparator++module Main where++import Control.Monad.IO.Class (liftIO)+import Data.Default++import Database.LevelDB+++customComparator :: Comparator+customComparator = Comparator compare++main :: IO ()+main = runResourceT $ do+ db <- open "/tmp/lvlcmptest"+ defaultOptions{ createIfMissing = True+ , comparator = Just customComparator+ }++ put db def "zzz" ""+ put db def "yyy" ""+ put db def "xxx" ""++ withIterator db def $ \iter -> do+ iterFirst iter+ iterItems iter >>= liftIO . print++ return ()
+ examples/features.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Comprehensive walkthough of the functionality provided by this library.+--+module Main where++import Control.Monad+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Resource (release)+import Data.ByteString.Char8 hiding (take)+import Data.Default+import Prelude hiding (putStrLn)++import Database.LevelDB+++main :: IO ()+main = runResourceT $ do+ printVersion++ db <- open "/tmp/leveltest"+ defaultOptions{ createIfMissing = True+ , cacheSize= 2048+ }+ put db def "foo" "bar"+ get db def "foo" >>= liftIO . print+ delete db def "foo"+ get db def "foo" >>= liftIO . print++ (releaseSnap, snap) <- createSnapshot' db+ write db def{sync = True} [ Put "a" "one"+ , Put "b" "two"+ , Put "c" "three"+ ]++ withIterator db def{useSnapshot = Just snap} $ \iter -> dumpEntries iter++ -- early release snapshot+ release releaseSnap++ -- here, we keep the iterator around for later reuse.+ -- Note that we don't explicitly release it (and thus don't keep the release+ -- key). The iterator will be released when runResourceT terminates.+ iter <- iterOpen db def+ dumpEntries iter++ approximateSize db ("a", "z") >>= liftIO . print++ getProperty db SSTables >>= printProperty "sstables"+ getProperty db Stats >>= printProperty "stats"+ getProperty db (NumFilesAtLevel 1) >>= printProperty "num files at level"++ write db def [ Del "a"+ , Del "b"+ , Del "c"+ ]+ dumpEntries iter++ return ()++ where++ dumpEntries iter = do+ iterFirst iter+ iterItems iter >>= liftIO . print++ 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
+ examples/filterpolicy.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Demo filter policy / bloom filter++module Main where++import Control.Monad.IO.Class (liftIO)+import Data.Default++import Database.LevelDB+++main :: IO ()+main = runResourceT $ do+ bloom <- bloomFilter 10+ db <- open "/tmp/lvlbloomtest"+ defaultOptions { createIfMissing = True+ , filterPolicy = Just . Left $ bloom+ }++ 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 ()
+ examples/iterforkio.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++-- |+-- Simplistic demo of 'Iterator' synchronization, using the 'Base" API+--+module Main where++import Control.Concurrent+import Control.Concurrent.Async+import Control.Exception+import Data.Default++import Database.LevelDB.Base++import qualified Data.ByteString.Char8 as BS++main :: IO ()+main = bracket (open "/tmp/leveltest" def{ createIfMissing = True }) close $ \ db -> do++ let xs = [1..100] :: [Int]++ write db def (map (\ x -> Put (BS.pack . show $ x) "") xs)++ bracket (createIter db def) releaseIter $ \ iter -> do+ _ <- iterFirst iter+ lck <- newMVar iter+ es <- mapConcurrently (getEntry lck) xs+ mapM (\ (i,e) -> putStrLn $ "#" ++ show i ++ ": " ++ show e) es++ return ()+ where+ getEntry lck i = withMVar lck $ \ iter -> do+ entry <- iterEntry iter+ iterNext iter+ return (i, entry)
+ leveldb-haskell-fork.cabal view
@@ -0,0 +1,169 @@+name: leveldb-haskell-fork+version: 0.3.1+synopsis: Haskell bindings to LevelDB+homepage: http://github.com/kim/leveldb-haskell+bug-reports: http://github.com/kim/leveldb-haskell/issues+license: BSD3+license-file: LICENSE+author: Kim Altintop et.al. (see AUTHORS file)+maintainer: kim.altintop@gmail.com+copyright: Copyright (c) 2012-2014 The leveldb-haskell Authors+category: Database, FFI+stability: Experimental+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.2.2, GHC == 7.4.1+description:+ From <http://leveldb.googlecode.com>:+ .+ LevelDB is a fast key-value storage library written at Google that provides+ an ordered mapping from string keys to string values.+ .+ .+ This library provides a Haskell language binding to LeveldDB. It is in very+ early stage and has seen very limited testing.+ .+ 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.7 or greater is required).++extra-source-files: Readme.md, AUTHORS, CHANGELOG examples/*.hs++source-repository head+ type: git+ location: git://github.com/kim/leveldb-haskell.git++Flag Examples+ description: Build examples+ default: False+ manual: True++library+ exposed-modules: Database.LevelDB+ , Database.LevelDB.Base+ , Database.LevelDB.C+ , Database.LevelDB.Internal+ , Database.LevelDB.Iterator+ , Database.LevelDB.MonadResource+ , Database.LevelDB.Types++ default-language: Haskell2010+ other-extensions: CPP+ , ForeignFunctionInterface+ , EmptyDataDecls+ , RecordWildCards++ build-depends: base >= 3 && < 5+ , bytestring+ , data-default+ , filepath+ , resourcet > 0.3.2+ , transformers++ ghc-options: -Wall -rtsopts -funbox-strict-fields+ ghc-prof-options: -prof -auto-all++ hs-source-dirs: src++ extra-libraries: leveldb++executable leveldb-example-comparator+ main-is: comparator.hs++ default-language: Haskell2010++ build-depends: base >= 3 && < 5+ , transformers+ , data-default+ , leveldb-haskell++ ghc-options: -Wall -Werror -O -rtsopts+ ghc-prof-options: -prof -auto-all++ hs-source-dirs: examples++ if flag(Examples)+ buildable: True+ else+ buildable: False++executable leveldb-example-features+ main-is: features.hs++ default-language: Haskell2010++ build-depends: base >= 3 && < 5+ , bytestring+ , transformers+ , resourcet > 0.3.2+ , data-default+ , leveldb-haskell++ ghc-options: -Wall -Werror -O -rtsopts+ ghc-prof-options: -prof -auto-all++ hs-source-dirs: examples++ if flag(Examples)+ buildable: True+ else+ buildable: False++executable leveldb-example-filterpolicy+ main-is: filterpolicy.hs++ default-language: Haskell2010++ build-depends: base >= 3 && < 5+ , transformers+ , data-default+ , leveldb-haskell++ ghc-options: -Wall -Werror -O -rtsopts+ ghc-prof-options: -prof -auto-all++ hs-source-dirs: examples++ if flag(Examples)+ buildable: True+ else+ buildable: False++executable leveldb-example-iterforkio+ main-is: iterforkio.hs++ default-language: Haskell2010++ build-depends: base >= 3 && < 5+ , async+ , bytestring >= 0.10.4.0+ , data-default+ , leveldb-haskell++ ghc-options: -Wall -Werror -O -rtsopts+ ghc-prof-options: -prof -auto-all++ hs-source-dirs: examples++ if flag(Examples)+ buildable: True+ else+ buildable: False+++test-suite tests+ ghc-options: -Wall+ main-is: tests.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ build-depends: base >= 3 && < 5,+ leveldb-haskell,+ hspec >= 1.8,+ process >= 1.1.0.2,+ bytestring >= 0.10.4.0,+ data-default,+ transformers,+ hspec-expectations,+ QuickCheck,+ mtl+ default-language: Haskell2010
+ src/Database/LevelDB.hs view
@@ -0,0 +1,16 @@+-- |+-- Module : Database.LevelDB+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- License : BSD3+-- Maintainer : kim.altintop@gmail.com+-- Stability : experimental+-- Portability : non-portable+--+-- LevelDB Haskell binding.+--+-- The API closely follows the C-API of LevelDB.+-- For more information, see: <http://leveldb.googlecode.com>++module Database.LevelDB (module R) where++import Database.LevelDB.MonadResource as R
+ src/Database/LevelDB/Base.hs view
@@ -0,0 +1,254 @@+-- |+-- Module : Database.LevelDB.Base+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- License : BSD3+-- Maintainer : kim.altintop@gmail.com+-- Stability : experimental+-- Portability : non-portable+--+-- LevelDB Haskell binding.+--+-- The API closely follows the C-API of LevelDB.+-- For more information, see: <http://leveldb.googlecode.com>++module Database.LevelDB.Base+ ( -- * Exported Types+ DB+ , BatchOp (..)+ , Comparator (..)+ , Compression (..)+ , Options (..)+ , ReadOptions (..)+ , Snapshot+ , WriteBatch+ , WriteOptions (..)+ , Range++ -- * Defaults+ , defaultOptions+ , defaultReadOptions+ , defaultWriteOptions++ -- * Basic Database Manipulations+ , open+ , close+ , put+ , delete+ , write+ , get+ , withSnapshot+ , createSnapshot+ , releaseSnapshot++ -- * Filter Policy / Bloom Filter+ , FilterPolicy (..)+ , BloomFilter+ , createBloomFilter+ , releaseBloomFilter++ -- * Administrative Functions+ , Property (..), getProperty+ , destroy+ , repair+ , approximateSize+ , version++ -- * Iteration+ , module Database.LevelDB.Iterator+ )+where++import Control.Applicative ((<$>))+import Control.Exception (bracket, bracketOnError, finally)+import Control.Monad (liftM)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.ByteString (ByteString)+import Data.ByteString.Internal (ByteString (..))+import Foreign+import Foreign.C.String (withCString)++import Database.LevelDB.C+import Database.LevelDB.Internal+import Database.LevelDB.Iterator+import Database.LevelDB.Types++import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BU+++-- | Open a database.+--+-- The returned handle should be released with 'close'.+open :: MonadIO m => FilePath -> Options -> m DB+open path opts = liftIO $ bracketOnError (mkOpts opts) freeOpts mkDB+ where+ mkDB opts'@(Options' opts_ptr _ _ _) =+ withCString path $ \path_ptr ->+ liftM (`DB` opts')+ $ throwIfErr "open"+ $ c_leveldb_open opts_ptr path_ptr++-- | Close a database.+--+-- The handle will be invalid after calling this action and should no+-- longer be used.+close :: MonadIO m => DB -> m ()+close (DB db_ptr opts_ptr) = liftIO $+ c_leveldb_close db_ptr `finally` freeOpts opts_ptr+++-- | Run an action with a 'Snapshot' of the database.+withSnapshot :: MonadIO m => DB -> (Snapshot -> IO a) -> m a+withSnapshot db act = liftIO $+ bracket (createSnapshot db) (releaseSnapshot db) act++-- | Create a snapshot of the database.+--+-- The returned 'Snapshot' should be released with 'releaseSnapshot'.+createSnapshot :: MonadIO m => DB -> m Snapshot+createSnapshot (DB db_ptr _) = liftIO $+ Snapshot <$> c_leveldb_create_snapshot db_ptr++-- | Release a snapshot.+--+-- The handle will be invalid after calling this action and should no+-- longer be used.+releaseSnapshot :: MonadIO m => DB -> Snapshot -> m ()+releaseSnapshot (DB db_ptr _) (Snapshot snap) = liftIO $+ c_leveldb_release_snapshot db_ptr snap++-- | Get a DB property.+getProperty :: MonadIO m => DB -> Property -> m (Maybe ByteString)+getProperty (DB db_ptr _) p = liftIO $+ withCString (prop p) $ \prop_ptr -> do+ val_ptr <- c_leveldb_property_value db_ptr prop_ptr+ if val_ptr == nullPtr+ then return Nothing+ else do res <- Just <$> BS.packCString val_ptr+ free val_ptr+ return res+ where+ prop (NumFilesAtLevel i) = "leveldb.num-files-at-level" ++ show i+ prop Stats = "leveldb.stats"+ prop SSTables = "leveldb.sstables"++-- | Destroy the given LevelDB database.+destroy :: MonadIO m => FilePath -> Options -> m ()+destroy path opts = liftIO $ bracket (mkOpts opts) freeOpts destroy'+ where+ destroy' (Options' opts_ptr _ _ _) =+ withCString path $ \path_ptr ->+ throwIfErr "destroy" $ c_leveldb_destroy_db opts_ptr path_ptr++-- | Repair the given LevelDB database.+repair :: MonadIO m => FilePath -> Options -> m ()+repair path opts = liftIO $ bracket (mkOpts opts) freeOpts repair'+ where+ repair' (Options' opts_ptr _ _ _) =+ withCString path $ \path_ptr ->+ throwIfErr "repair" $ c_leveldb_repair_db opts_ptr path_ptr+++-- TODO: support [Range], like C API does+type Range = (ByteString, ByteString)++-- | Inspect the approximate sizes of the different levels.+approximateSize :: MonadIO m => DB -> Range -> m Int64+approximateSize (DB db_ptr _) (from, to) = liftIO $+ BU.unsafeUseAsCStringLen from $ \(from_ptr, flen) ->+ BU.unsafeUseAsCStringLen to $ \(to_ptr, tlen) ->+ withArray [from_ptr] $ \from_ptrs ->+ withArray [intToCSize flen] $ \flen_ptrs ->+ withArray [to_ptr] $ \to_ptrs ->+ withArray [intToCSize tlen] $ \tlen_ptrs ->+ allocaArray 1 $ \size_ptrs -> do+ c_leveldb_approximate_sizes db_ptr 1+ from_ptrs flen_ptrs+ to_ptrs tlen_ptrs+ size_ptrs+ liftM head $ peekArray 1 size_ptrs >>= mapM toInt64++ where+ toInt64 = return . fromIntegral+++-- | Write a key/value pair.+put :: MonadIO m => DB -> WriteOptions -> ByteString -> ByteString -> m ()+put (DB db_ptr _) opts key value = liftIO $ withCWriteOpts opts $ \opts_ptr ->+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ BU.unsafeUseAsCStringLen value $ \(val_ptr, vlen) ->+ throwIfErr "put"+ $ c_leveldb_put db_ptr opts_ptr+ key_ptr (intToCSize klen)+ val_ptr (intToCSize vlen)++-- | Read a value by key.+get :: MonadIO m => DB -> ReadOptions -> ByteString -> m (Maybe ByteString)+get (DB db_ptr _) opts key = liftIO $ withCReadOpts opts $ \opts_ptr ->+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ alloca $ \vlen_ptr -> do+ val_ptr <- throwIfErr "get" $+ c_leveldb_get db_ptr opts_ptr key_ptr (intToCSize klen) vlen_ptr+ vlen <- peek vlen_ptr+ if val_ptr == nullPtr+ then return Nothing+ else do+ res' <- Just <$> BS.packCStringLen (val_ptr, cSizeToInt vlen)+ free val_ptr+ return res'++-- | Delete a key/value pair.+delete :: MonadIO m => DB -> WriteOptions -> ByteString -> m ()+delete (DB db_ptr _) opts key = liftIO $ withCWriteOpts opts $ \opts_ptr ->+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ throwIfErr "delete"+ $ c_leveldb_delete db_ptr opts_ptr key_ptr (intToCSize klen)++-- | Perform a batch mutation.+write :: MonadIO m => DB -> WriteOptions -> WriteBatch -> m ()+write (DB db_ptr _) opts batch = liftIO $ withCWriteOpts opts $ \opts_ptr ->+ bracket c_leveldb_writebatch_create c_leveldb_writebatch_destroy $ \batch_ptr -> do++ mapM_ (batchAdd batch_ptr) batch++ 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++ where+ batchAdd batch_ptr (Put key val) =+ 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) =+ 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++-- | Return the runtime version of the underlying LevelDB library as a (major,+-- minor) pair.+version :: MonadIO m => m (Int, Int)+version = do+ major <- liftIO c_leveldb_major_version+ minor <- liftIO c_leveldb_minor_version++ return (cIntToInt major, cIntToInt minor)++createBloomFilter :: MonadIO m => Int -> m BloomFilter+createBloomFilter i = do+ let i' = fromInteger . toInteger $ i+ fp_ptr <- liftIO $ c_leveldb_filterpolicy_create_bloom i'+ return $ BloomFilter fp_ptr++releaseBloomFilter :: MonadIO m => BloomFilter -> m ()+releaseBloomFilter (BloomFilter fp) = liftIO $ c_leveldb_filterpolicy_destroy fp
+ src/Database/LevelDB/C.hsc view
@@ -0,0 +1,355 @@+{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}+-- |+-- Module : Database.LevelDB.C+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- License : BSD3+-- Maintainer : kim.altintop@gmail.com+-- Stability : experimental+-- Portability : non-portable+--++module Database.LevelDB.C where++import Foreign+import Foreign.C.Types+import Foreign.C.String++#include <leveldb/c.h>++data LevelDB+data LCache+data LComparator+data LIterator+data LLogger+data LOptions+data LReadOptions+data LSnapshot+data LWriteBatch+data LWriteOptions+data LFilterPolicy++type LevelDBPtr = Ptr LevelDB+type CachePtr = Ptr LCache+type ComparatorPtr = Ptr LComparator+type IteratorPtr = Ptr LIterator+type LoggerPtr = Ptr LLogger+type OptionsPtr = Ptr LOptions+type ReadOptionsPtr = Ptr LReadOptions+type SnapshotPtr = Ptr LSnapshot+type WriteBatchPtr = Ptr LWriteBatch+type WriteOptionsPtr = Ptr LWriteOptions+type FilterPolicyPtr = Ptr LFilterPolicy++type DBName = CString+type ErrPtr = Ptr CString+type Key = CString+type Val = CString++newtype CompressionOpt = CompressionOpt { compressionOpt :: CInt }+ deriving (Eq, Show)+#{enum CompressionOpt, CompressionOpt+ , noCompression = 0+ , snappyCompression = 1+ }+++foreign import ccall safe "leveldb/c.h leveldb_open"+ c_leveldb_open :: OptionsPtr -> DBName -> ErrPtr -> IO LevelDBPtr++foreign import ccall safe "leveldb/c.h leveldb_close"+ c_leveldb_close :: LevelDBPtr -> IO ()+++foreign import ccall safe "leveldb/c.h leveldb_put"+ c_leveldb_put :: LevelDBPtr+ -> WriteOptionsPtr+ -> Key -> CSize+ -> Val -> CSize+ -> ErrPtr+ -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_delete"+ c_leveldb_delete :: LevelDBPtr+ -> WriteOptionsPtr+ -> Key -> CSize+ -> ErrPtr+ -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_write"+ c_leveldb_write :: LevelDBPtr+ -> WriteOptionsPtr+ -> WriteBatchPtr+ -> ErrPtr+ -> IO ()++-- | Returns NULL if not found. A malloc()ed array otherwise. Stores the length+-- of the array in *vallen.+foreign import ccall safe "leveldb/c.h leveldb_get"+ c_leveldb_get :: LevelDBPtr+ -> ReadOptionsPtr+ -> Key -> CSize+ -> Ptr CSize -- ^ value length+ -> ErrPtr+ -> IO CString++foreign import ccall safe "leveldb/c.h leveldb_create_snapshot"+ c_leveldb_create_snapshot :: LevelDBPtr -> IO SnapshotPtr++foreign import ccall safe "leveldb/c.h leveldb_release_snapshot"+ c_leveldb_release_snapshot :: LevelDBPtr -> SnapshotPtr -> IO ()++-- | Returns NULL if property name is unknown. Else returns a pointer to a+-- malloc()-ed null-terminated value.+foreign import ccall safe "leveldb/c.h leveldb_property_value"+ c_leveldb_property_value :: LevelDBPtr -> CString -> IO CString++foreign import ccall safe "leveldb/c.h leveldb_approximate_sizes"+ c_leveldb_approximate_sizes :: LevelDBPtr+ -> CInt -- ^ num ranges+ -> Ptr CString -> Ptr CSize -- ^ range start keys (array)+ -> Ptr CString -> Ptr CSize -- ^ range limit keys (array)+ -> Ptr Word64 -- ^ array of approx. sizes of ranges+ -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_destroy_db"+ c_leveldb_destroy_db :: OptionsPtr -> DBName -> ErrPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_repair_db"+ c_leveldb_repair_db :: OptionsPtr -> DBName -> ErrPtr -> IO ()+++--+-- Iterator+--++foreign import ccall safe "leveldb/c.h leveldb_create_iterator"+ c_leveldb_create_iterator :: LevelDBPtr -> ReadOptionsPtr -> IO IteratorPtr++foreign import ccall safe "leveldb/c.h leveldb_iter_destroy"+ c_leveldb_iter_destroy :: IteratorPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_iter_valid"+ c_leveldb_iter_valid :: IteratorPtr -> IO CUChar++foreign import ccall safe "leveldb/c.h leveldb_iter_seek_to_first"+ c_leveldb_iter_seek_to_first :: IteratorPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_iter_seek_to_last"+ c_leveldb_iter_seek_to_last :: IteratorPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_iter_seek"+ c_leveldb_iter_seek :: IteratorPtr -> Key -> CSize -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_iter_next"+ c_leveldb_iter_next :: IteratorPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_iter_prev"+ c_leveldb_iter_prev :: IteratorPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_iter_key"+ c_leveldb_iter_key :: IteratorPtr -> Ptr CSize -> IO Key++foreign import ccall safe "leveldb/c.h leveldb_iter_value"+ c_leveldb_iter_value :: IteratorPtr -> Ptr CSize -> IO Val++foreign import ccall safe "leveldb/c.h leveldb_iter_get_error"+ c_leveldb_iter_get_error :: IteratorPtr -> ErrPtr -> IO ()+++--+-- Write batch+--++foreign import ccall safe "leveldb/c.h leveldb_writebatch_create"+ c_leveldb_writebatch_create :: IO WriteBatchPtr++foreign import ccall safe "leveldb/c.h leveldb_writebatch_destroy"+ c_leveldb_writebatch_destroy :: WriteBatchPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_writebatch_clear"+ c_leveldb_writebatch_clear :: WriteBatchPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_writebatch_put"+ c_leveldb_writebatch_put :: WriteBatchPtr+ -> Key -> CSize+ -> Val -> CSize+ -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_writebatch_delete"+ c_leveldb_writebatch_delete :: WriteBatchPtr -> Key -> CSize -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_writebatch_iterate"+ c_leveldb_writebatch_iterate :: WriteBatchPtr+ -> Ptr () -- ^ state+ -> FunPtr (Ptr () -> Key -> CSize -> Val -> CSize) -- ^ put+ -> FunPtr (Ptr () -> Key -> CSize) -- ^ delete+ -> IO ()+++--+-- Options+--++foreign import ccall safe "leveldb/c.h leveldb_options_create"+ c_leveldb_options_create :: IO OptionsPtr++foreign import ccall safe "leveldb/c.h leveldb_options_destroy"+ c_leveldb_options_destroy :: OptionsPtr -> IO ()++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 ()++foreign import ccall safe "leveldb/c.h leveldb_options_set_error_if_exists"+ c_leveldb_options_set_error_if_exists :: OptionsPtr -> CUChar -> IO ()++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_info_log"+ c_leveldb_options_set_info_log :: OptionsPtr -> LoggerPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_options_set_write_buffer_size"+ c_leveldb_options_set_write_buffer_size :: OptionsPtr -> CSize -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_options_set_max_open_files"+ c_leveldb_options_set_max_open_files :: OptionsPtr -> CInt -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_options_set_block_size"+ c_leveldb_options_set_block_size :: OptionsPtr -> CSize -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_options_set_block_restart_interval"+ c_leveldb_options_set_block_restart_interval :: OptionsPtr -> CInt -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_options_set_compression"+ c_leveldb_options_set_compression :: OptionsPtr -> CompressionOpt -> IO ()++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+type NameFun = StatePtr -> CString++-- | Make a FunPtr to a user-defined comparator function+foreign import ccall "wrapper" mkCmp :: CompareFun -> IO (FunPtr CompareFun)++-- | Make a destructor FunPtr+foreign import ccall "wrapper" mkDest :: Destructor -> IO (FunPtr Destructor)++-- | Make a name FunPtr+foreign import ccall "wrapper" mkName :: NameFun -> IO (FunPtr NameFun)++foreign import ccall safe "leveldb/c.h leveldb_comparator_create"+ c_leveldb_comparator_create :: StatePtr+ -> FunPtr Destructor+ -> FunPtr CompareFun+ -> FunPtr NameFun+ -> IO ComparatorPtr++foreign import ccall safe "leveldb/c.h leveldb_comparator_destroy"+ c_leveldb_comparator_destroy :: ComparatorPtr -> IO ()+++--+-- 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++foreign import ccall safe "leveldb/c.h leveldb_readoptions_destroy"+ c_leveldb_readoptions_destroy :: ReadOptionsPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_readoptions_set_verify_checksums"+ c_leveldb_readoptions_set_verify_checksums :: ReadOptionsPtr -> CUChar -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_readoptions_set_fill_cache"+ c_leveldb_readoptions_set_fill_cache :: ReadOptionsPtr -> CUChar -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_readoptions_set_snapshot"+ c_leveldb_readoptions_set_snapshot :: ReadOptionsPtr -> SnapshotPtr -> IO ()+++--+-- Write options+--++foreign import ccall safe "leveldb/c.h leveldb_writeoptions_create"+ c_leveldb_writeoptions_create :: IO WriteOptionsPtr++foreign import ccall safe "leveldb/c.h leveldb_writeoptions_destroy"+ c_leveldb_writeoptions_destroy :: WriteOptionsPtr -> IO ()++foreign import ccall safe "leveldb/c.h leveldb_writeoptions_set_sync"+ c_leveldb_writeoptions_set_sync :: WriteOptionsPtr -> CUChar -> IO ()+++--+-- 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 ()+++--+-- Version+--++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
+ src/Database/LevelDB/Internal.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE RecordWildCards #-}+-- |+-- Module : Database.LevelDB.Internal+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- License : BSD3+-- Maintainer : kim.altintop@gmail.com+-- Stability : experimental+-- Portability : non-portable+--++module Database.LevelDB.Internal+ ( -- * Types+ DB (..)+ , Comparator'+ , FilterPolicy'+ , Options' (..)++ -- * "Smart" constructors and deconstructors+ , freeCReadOpts+ , freeComparator+ , freeFilterPolicy+ , freeOpts+ , mkCReadOpts+ , mkComparator+ , mkCompareFun+ , mkCreateFilterFun+ , mkFilterPolicy+ , mkKeyMayMatchFun+ , mkOpts++ -- * combinators+ , withCWriteOpts+ , withCReadOpts++ -- * Utilities+ , throwIfErr+ , cSizeToInt+ , intToCSize+ , intToCInt+ , cIntToInt+ , boolToNum+ )+where++import Control.Applicative ((<$>))+import Control.Exception (bracket, onException, throwIO)+import Control.Monad (when)+import Data.ByteString (ByteString)+import Foreign+import Foreign.C.String (peekCString, withCString)+import Foreign.C.Types (CInt, CSize)++import Database.LevelDB.C+import Database.LevelDB.Types++import qualified Data.ByteString as BS+++-- | Database handle+data DB = DB LevelDBPtr Options'++instance Eq DB where+ (DB pt1 _) == (DB pt2 _) = pt1 == pt2++-- | Internal representation of a 'Comparator'+data Comparator' = Comparator' (FunPtr CompareFun)+ (FunPtr Destructor)+ (FunPtr NameFun)+ ComparatorPtr++-- | Internal representation of a 'FilterPolicy'+data FilterPolicy' = FilterPolicy' (FunPtr CreateFilterFun)+ (FunPtr KeyMayMatchFun)+ (FunPtr Destructor)+ (FunPtr NameFun)+ FilterPolicyPtr++-- | Internal representation of the 'Options'+data Options' = Options'+ { _optsPtr :: !OptionsPtr+ , _cachePtr :: !(Maybe CachePtr)+ , _comp :: !(Maybe Comparator')+ , _fpPtr :: !(Maybe (Either FilterPolicyPtr FilterPolicy'))+ }+++mkOpts :: Options -> IO Options'+mkOpts Options{..} = do+ opts_ptr <- c_leveldb_options_create++ c_leveldb_options_set_block_restart_interval opts_ptr+ $ intToCInt blockRestartInterval+ c_leveldb_options_set_block_size opts_ptr+ $ intToCSize blockSize+ c_leveldb_options_set_compression opts_ptr+ $ ccompression compression+ c_leveldb_options_set_create_if_missing opts_ptr+ $ boolToNum createIfMissing+ c_leveldb_options_set_error_if_exists opts_ptr+ $ boolToNum errorIfExists+ c_leveldb_options_set_max_open_files opts_ptr+ $ intToCInt maxOpenFiles+ c_leveldb_options_set_paranoid_checks opts_ptr+ $ boolToNum paranoidChecks+ c_leveldb_options_set_write_buffer_size opts_ptr+ $ intToCSize writeBufferSize++ cache <- maybeSetCache opts_ptr cacheSize+ cmp <- maybeSetCmp opts_ptr comparator+ fp <- maybeSetFilterPolicy opts_ptr filterPolicy++ return (Options' opts_ptr cache cmp fp)++ where+ ccompression NoCompression = noCompression+ ccompression Snappy = snappyCompression++ maybeSetCache :: OptionsPtr -> Int -> IO (Maybe CachePtr)+ maybeSetCache opts_ptr size =+ if size <= 0+ then return Nothing+ else do+ cache_ptr <- c_leveldb_cache_create_lru $ intToCSize size+ c_leveldb_options_set_cache opts_ptr cache_ptr+ return . Just $ cache_ptr++ maybeSetCmp :: OptionsPtr -> Maybe Comparator -> IO (Maybe Comparator')+ maybeSetCmp opts_ptr (Just mcmp) = Just <$> setcmp opts_ptr mcmp+ maybeSetCmp _ Nothing = return Nothing++ setcmp :: OptionsPtr -> Comparator -> IO Comparator'+ setcmp opts_ptr (Comparator cmp) = do+ cmp'@(Comparator' _ _ _ cmp_ptr) <- mkComparator "user-defined" cmp+ 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 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 ()++withCWriteOpts :: WriteOptions -> (WriteOptionsPtr -> IO a) -> IO a+withCWriteOpts WriteOptions{..} = bracket mkCWriteOpts freeCWriteOpts+ where+ mkCWriteOpts = do+ opts_ptr <- c_leveldb_writeoptions_create+ onException+ (c_leveldb_writeoptions_set_sync opts_ptr $ boolToNum sync)+ (c_leveldb_writeoptions_destroy opts_ptr)+ return opts_ptr++ freeCWriteOpts = c_leveldb_writeoptions_destroy++mkCompareFun :: (ByteString -> ByteString -> Ordering) -> CompareFun+mkCompareFun cmp = cmp'+ where+ cmp' _ a alen b blen = do+ a' <- BS.packCStringLen (a, fromInteger . toInteger $ alen)+ b' <- BS.packCStringLen (b, fromInteger . toInteger $ blen)+ return $ case cmp a' b' of+ EQ -> 0+ GT -> 1+ LT -> -1++mkComparator :: String -> (ByteString -> ByteString -> Ordering) -> IO Comparator'+mkComparator name f =+ withCString name $ \cs -> do+ ccmpfun <- mkCmp . mkCompareFun $ f+ cdest <- mkDest $ const ()+ cname <- mkName $ const cs+ ccmp <- c_leveldb_comparator_create nullPtr cdest ccmpfun cname+ return $ Comparator' ccmpfun cdest cname ccmp+++freeComparator :: Comparator' -> IO ()+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 $ const cs+ cdest <- mkDest $ const ()+ 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++mkCReadOpts :: ReadOptions -> IO ReadOptionsPtr+mkCReadOpts ReadOptions{..} = do+ opts_ptr <- c_leveldb_readoptions_create+ flip onException (c_leveldb_readoptions_destroy opts_ptr) $ do+ c_leveldb_readoptions_set_verify_checksums opts_ptr $ boolToNum verifyCheckSums+ c_leveldb_readoptions_set_fill_cache opts_ptr $ boolToNum fillCache++ case useSnapshot of+ Just (Snapshot snap_ptr) -> c_leveldb_readoptions_set_snapshot opts_ptr snap_ptr+ Nothing -> return ()++ return opts_ptr++freeCReadOpts :: ReadOptionsPtr -> IO ()+freeCReadOpts = c_leveldb_readoptions_destroy++withCReadOpts :: ReadOptions -> (ReadOptionsPtr -> IO a) -> IO a+withCReadOpts opts = bracket (mkCReadOpts opts) freeCReadOpts++throwIfErr :: String -> (ErrPtr -> IO a) -> IO a+throwIfErr s f = alloca $ \err_ptr -> do+ poke err_ptr nullPtr+ res <- f err_ptr+ erra <- peek err_ptr+ when (erra /= nullPtr) $ do+ err <- peekCString erra+ throwIO $ userError $ s ++ ": " ++ err+ return res++cSizeToInt :: CSize -> Int+cSizeToInt = fromIntegral+{-# INLINE cSizeToInt #-}++intToCSize :: Int -> CSize+intToCSize = fromIntegral+{-# INLINE intToCSize #-}++intToCInt :: Int -> CInt+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)+{-# INLINE boolToNum #-}
+ src/Database/LevelDB/Iterator.hs view
@@ -0,0 +1,227 @@+-- |+-- Module : Database.LevelDB.Iterator+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- License : BSD3+-- Maintainer : kim.altintop@gmail.com+-- Stability : experimental+-- Portability : non-portable+--+-- Iterating over key ranges.+--++module Database.LevelDB.Iterator+ ( Iterator+ , createIter+ , iterEntry+ , iterFirst+ , iterGetError+ , iterItems+ , iterKey+ , iterKeys+ , iterLast+ , iterNext+ , iterPrev+ , iterSeek+ , iterValid+ , iterValue+ , iterValues+ , mapIter+ , releaseIter+ , withIter+ )+where++import Control.Applicative ((<$>), (<*>))+import Control.Exception (bracket, finally, onException)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.ByteString (ByteString)+import Data.Maybe (catMaybes)+import Foreign+import Foreign.C.Error (throwErrnoIfNull)+import Foreign.C.String (CString, peekCString)+import Foreign.C.Types (CSize)++import Database.LevelDB.C+import Database.LevelDB.Internal+import Database.LevelDB.Types++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Unsafe as BU++-- | Iterator handle+--+-- Note that an 'Iterator' requires external synchronization if it is shared+-- between multiple threads which mutate it's state. See+-- @examples/iterforkio.hs@ for a simple example of how to do that.+data Iterator = Iterator !IteratorPtr !ReadOptionsPtr deriving (Eq)++-- | Create an 'Iterator'.+--+-- The iterator should be released with 'releaseIter'.+--+-- Note that an 'Iterator' creates a snapshot of the database implicitly, so+-- updates written after the iterator was created are not visible. You may,+-- however, specify an older 'Snapshot' in the 'ReadOptions'.+createIter :: MonadIO m => DB -> ReadOptions -> m Iterator+createIter (DB db_ptr _) opts = liftIO $ do+ opts_ptr <- mkCReadOpts opts+ flip onException (freeCReadOpts opts_ptr) $ do+ iter_ptr <- throwErrnoIfNull "create_iterator" $+ c_leveldb_create_iterator db_ptr opts_ptr+ return $ Iterator iter_ptr opts_ptr++-- | Release an 'Iterator'.+--+-- The handle will be invalid after calling this action and should no+-- longer be used. Calling this function with an already released 'Iterator'+-- will cause a double-free error!+releaseIter :: MonadIO m => Iterator -> m ()+releaseIter (Iterator iter_ptr opts) = liftIO $+ c_leveldb_iter_destroy iter_ptr `finally` freeCReadOpts opts++-- | Run an action with an 'Iterator'+withIter :: MonadIO m => DB -> ReadOptions -> (Iterator -> IO a) -> m a+withIter db opts = liftIO . bracket (createIter db opts) releaseIter++-- | An iterator is either positioned at a key/value pair, or not valid. This+-- function returns /true/ iff the iterator is valid.+iterValid :: MonadIO m => Iterator -> m Bool+iterValid (Iterator iter_ptr _) = liftIO $ do+ x <- c_leveldb_iter_valid iter_ptr+ return (x /= 0)++-- | Position at the first key in the source that is at or past target. The+-- iterator is /valid/ after this call iff the source contains an entry that+-- comes at or past target.+iterSeek :: MonadIO m => Iterator -> ByteString -> m ()+iterSeek (Iterator iter_ptr _) key = liftIO $+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ c_leveldb_iter_seek iter_ptr key_ptr (intToCSize klen)++-- | Position at the first key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterFirst :: MonadIO m => Iterator -> m ()+iterFirst (Iterator iter_ptr _) = liftIO $ c_leveldb_iter_seek_to_first iter_ptr++-- | Position at the last key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterLast :: MonadIO m => Iterator -> m ()+iterLast (Iterator iter_ptr _) = liftIO $ c_leveldb_iter_seek_to_last iter_ptr++-- | Moves to the next entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the last entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterPrev' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterNext :: MonadIO m => Iterator -> m ()+iterNext (Iterator iter_ptr _) = liftIO $ do+ valid <- c_leveldb_iter_valid iter_ptr+ when (valid /= 0) $ c_leveldb_iter_next iter_ptr++-- | Moves to the previous entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the first entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterNext' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterPrev :: MonadIO m => Iterator -> m ()+iterPrev (Iterator iter_ptr _) = liftIO $ do+ valid <- c_leveldb_iter_valid iter_ptr+ when (valid /= 0) $ c_leveldb_iter_prev iter_ptr++-- | Return the key for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterKey :: MonadIO m => Iterator -> m (Maybe ByteString)+iterKey = liftIO . flip iterString c_leveldb_iter_key++-- | Return the value for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterValue :: MonadIO m => Iterator -> m (Maybe ByteString)+iterValue = liftIO . flip iterString c_leveldb_iter_value++-- | Return the current entry as a pair, if the iterator is currently positioned+-- at an entry, ie. 'iterValid'.+iterEntry :: MonadIO m => Iterator -> m (Maybe (ByteString, ByteString))+iterEntry iter = liftIO $ do+ mkey <- iterKey iter+ mval <- iterValue iter+ return $ (,) <$> mkey <*> mval++-- | Check for errors+--+-- Note that this captures somewhat severe errors such as a corrupted database.+iterGetError :: MonadIO m => Iterator -> m (Maybe ByteString)+iterGetError (Iterator iter_ptr _) = liftIO $+ alloca $ \err_ptr -> do+ poke err_ptr nullPtr+ c_leveldb_iter_get_error iter_ptr err_ptr+ erra <- peek err_ptr+ if erra == nullPtr+ then return Nothing+ else do+ err <- peekCString erra+ return . Just . BC.pack $ err++-- | Map a function over an iterator, advancing the iterator forward and+-- returning the value. The iterator should be put in the right position prior+-- to calling the function.+--+-- Note that this function accumulates the result strictly, ie. it reads all+-- values into memory until the iterator is exhausted. This is most likely not+-- what you want for large ranges. You may consider using conduits instead, for+-- an example see: <https://gist.github.com/adc8ec348f03483446a5>+mapIter :: MonadIO m => (Iterator -> m a) -> Iterator -> m [a]+mapIter f iter@(Iterator iter_ptr _) = go []+ where+ go acc = do+ valid <- liftIO $ c_leveldb_iter_valid iter_ptr+ if valid == 0+ then return acc+ else do+ val <- f iter+ () <- liftIO $ c_leveldb_iter_next iter_ptr+ go (acc ++ [val])++-- | Return a list of key and value tuples from an iterator. The iterator+-- should be put in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'.+iterItems :: (Functor m, MonadIO m) => Iterator -> m [(ByteString, ByteString)]+iterItems iter = catMaybes <$> mapIter iterEntry iter++-- | Return a list of key from an iterator. The iterator should be put+-- in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'+iterKeys :: (Functor m, MonadIO m) => Iterator -> m [ByteString]+iterKeys iter = catMaybes <$> mapIter iterKey iter++-- | Return a list of values from an iterator. The iterator should be put+-- in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'+iterValues :: (Functor m, MonadIO m) => Iterator -> m [ByteString]+iterValues iter = catMaybes <$> mapIter iterValue iter+++--+-- Internal+--++iterString :: Iterator+ -> (IteratorPtr -> Ptr CSize -> IO CString)+ -> IO (Maybe ByteString)+iterString (Iterator iter_ptr _) f = do+ valid <- c_leveldb_iter_valid iter_ptr+ if valid == 0+ then return Nothing+ else alloca $ \len_ptr -> do+ ptr <- f iter_ptr len_ptr+ if ptr == nullPtr+ then return Nothing+ else do+ len <- peek len_ptr+ Just <$> BS.packCStringLen (ptr, cSizeToInt len)
+ src/Database/LevelDB/MonadResource.hs view
@@ -0,0 +1,285 @@+-- |+-- Module : Database.LevelDB.MonadResource+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- License : BSD3+-- Maintainer : kim.altintop@gmail.com+-- Stability : experimental+-- Portability : non-portable+--++module Database.LevelDB.MonadResource+ ( -- * Exported Types+ DB+ , BatchOp(..)+ , Comparator(..)+ , Compression(..)+ , Options(..)+ , ReadOptions(..)+ , Snapshot+ , WriteBatch+ , WriteOptions(..)+ , Range++ -- * Defaults+ , defaultOptions+ , defaultWriteOptions+ , defaultReadOptions++ -- * Basic Database Manipulation+ , withSnapshot+ , open+ , put+ , delete+ , write+ , get+ , createSnapshot+ , createSnapshot'++ -- * Filter Policy / Bloom Filter+ , FilterPolicy(..)+ , bloomFilter++ -- * Administrative Functions+ , Property(..), getProperty+ , destroy+ , repair+ , approximateSize+ , version++ -- * Iteration+ , Iterator+ , withIterator+ , iterOpen+ , iterOpen'+ , iterValid+ , iterSeek+ , iterFirst+ , iterLast+ , iterNext+ , iterPrev+ , iterKey+ , iterValue+ , iterGetError+ , mapIter+ , iterItems+ , iterKeys+ , iterValues++ -- * Re-exports+ , MonadResource (..)+ , runResourceT+ , resourceForkIO+ )+where++import Control.Applicative ((<$>))+import Control.Monad.Trans.Resource+import Data.ByteString (ByteString)+import Data.Int (Int64)++import Database.LevelDB.Base (BatchOp, BloomFilter, Comparator,+ Compression, DB, FilterPolicy,+ Iterator, Options, Property,+ Range, ReadOptions, Snapshot,+ WriteBatch, WriteOptions,+ defaultOptions,+ defaultReadOptions,+ defaultWriteOptions)+import qualified Database.LevelDB.Base as Base+++-- | Create a 'BloomFilter'+bloomFilter :: MonadResource m => Int -> m BloomFilter+bloomFilter i =+ snd <$> allocate (Base.createBloomFilter i)+ Base.releaseBloomFilter++-- | Open a database+--+-- The returned handle will automatically be released when the enclosing+-- 'runResourceT' terminates.+open :: MonadResource m => FilePath -> Options -> m DB+open path opts = snd <$> open' path opts++open' :: MonadResource m => FilePath -> Options -> m (ReleaseKey, DB)+open' path opts = allocate (Base.open path opts) Base.close+{-# INLINE open' #-}++-- | Run an action with a snapshot of the database.+--+-- The snapshot will be released when the action terminates or throws an+-- exception. Note that this function is provided for convenience and does not+-- prevent the 'Snapshot' handle to escape. It will, however, be invalid after+-- this function returns and should not be used anymore.+withSnapshot :: MonadResource m => DB -> (Snapshot -> m a) -> m a+withSnapshot db f = do+ (rk, snap) <- createSnapshot' db+ res <- f snap+ release rk+ return res++-- | Create a snapshot of the database.+--+-- The returned 'Snapshot' will be released automatically when the enclosing+-- 'runResourceT' terminates. It is recommended to use 'createSnapshot'' instead+-- and release the resource manually as soon as possible.+createSnapshot :: MonadResource m => DB -> m Snapshot+createSnapshot db = snd <$> createSnapshot' db++-- | Create a snapshot of the database which can (and should) be released early.+createSnapshot' :: MonadResource m => DB -> m (ReleaseKey, Snapshot)+createSnapshot' db = allocate (Base.createSnapshot db) (Base.releaseSnapshot db)++-- | Get a DB property+getProperty :: MonadResource m => DB -> Property -> m (Maybe ByteString)+getProperty = Base.getProperty++-- | Destroy the given leveldb database.+destroy :: MonadResource m => FilePath -> Options -> m ()+destroy = Base.destroy++-- | Repair the given leveldb database.+repair :: MonadResource m => FilePath -> Options -> m ()+repair = Base.repair+++-- | Inspect the approximate sizes of the different levels+approximateSize :: MonadResource m => DB -> Range -> m Int64+approximateSize = Base.approximateSize++-- | Write a key/value pair+put :: MonadResource m => DB -> WriteOptions -> ByteString -> ByteString -> m ()+put = Base.put++-- | Read a value by key+get :: MonadResource m => DB -> ReadOptions -> ByteString -> m (Maybe ByteString)+get = Base.get++-- | Delete a key/value pair+delete :: MonadResource m => DB -> WriteOptions -> ByteString -> m ()+delete = Base.delete++-- | Perform a batch mutation+write :: MonadResource m => DB -> WriteOptions -> WriteBatch -> m ()+write = Base.write+++-- | 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.+withIterator :: MonadResource m => DB -> ReadOptions -> (Iterator -> m a) -> m a+withIterator db opts f = do+ (rk, iter) <- iterOpen' db opts+ res <- f iter+ release rk+ return res++-- | Create an 'Iterator'.+--+-- The iterator will be released when the enclosing 'runResourceT' terminates.+-- You may consider to use 'iterOpen'' instead and manually release the iterator+-- as soon as it is no longer needed (alternatively, use 'withIterator').+--+-- Note that an 'Iterator' creates a snapshot of the database implicitly, so+-- updates written after the iterator was created are not visible. You may,+-- however, specify an older 'Snapshot' in the 'ReadOptions'.+iterOpen :: MonadResource m => DB -> ReadOptions -> m Iterator+iterOpen db opts = snd <$> iterOpen' db opts++-- | Create an 'Iterator' which can be released early.+iterOpen' :: MonadResource m => DB -> ReadOptions -> m (ReleaseKey, Iterator)+iterOpen' db opts = allocate (Base.createIter db opts) Base.releaseIter++-- | An iterator is either positioned at a key/value pair, or not valid. This+-- function returns /true/ iff the iterator is valid.+iterValid :: MonadResource m => Iterator -> m Bool+iterValid = Base.iterValid++-- | Position at the first key in the source that is at or past target. The+-- iterator is /valid/ after this call iff the source contains an entry that+-- comes at or past target.+iterSeek :: MonadResource m => Iterator -> ByteString -> m ()+iterSeek = Base.iterSeek++-- | Position at the first key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterFirst :: MonadResource m => Iterator -> m ()+iterFirst = Base.iterFirst++-- | Position at the last key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterLast :: MonadResource m => Iterator -> m ()+iterLast = Base.iterLast++-- | Moves to the next entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the last entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterPrev' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterNext :: MonadResource m => Iterator -> m ()+iterNext = Base.iterNext++-- | Moves to the previous entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the first entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterNext' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterPrev :: MonadResource m => Iterator -> m ()+iterPrev = Base.iterPrev++-- | Return the key for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterKey :: MonadResource m => Iterator -> m (Maybe ByteString)+iterKey = Base.iterKey++-- | Return the value for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterValue :: MonadResource m => Iterator -> m (Maybe ByteString)+iterValue = Base.iterValue++-- | Check for errors+--+-- Note that this captures somewhat severe errors such as a corrupted database.+iterGetError :: MonadResource m => Iterator -> m (Maybe ByteString)+iterGetError = Base.iterGetError+++-- | Map a function over an iterator, advancing the iterator forward and+-- returning the value. The iterator should be put in the right position prior+-- to calling the function.+--+-- Note that this function accumulates the result strictly, ie. it reads all+-- values into memory until the iterator is exhausted. This is most likely not+-- what you want for large ranges. You may consider using conduits instead, for+-- an example see: <https://gist.github.com/adc8ec348f03483446a5>+mapIter :: MonadResource m => (Iterator -> m a) -> Iterator -> m [a]+mapIter = Base.mapIter++-- | Return a list of key and value tuples from an iterator. The iterator+-- should be put in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'.+iterItems :: MonadResource m => Iterator -> m [(ByteString, ByteString)]+iterItems = Base.iterItems++-- | Return a list of key from an iterator. The iterator should be put+-- in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'+iterKeys :: MonadResource m => Iterator -> m [ByteString]+iterKeys = Base.iterKeys++-- | Return a list of values from an iterator. The iterator should be put+-- in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'+iterValues :: MonadResource m => Iterator -> m [ByteString]+iterValues = Base.iterValues+++-- | Return the runtime version of the underlying LevelDB library as a (major,+-- minor) pair.+version :: MonadResource m => m (Int, Int)+version = Base.version
+ src/Database/LevelDB/Types.hs view
@@ -0,0 +1,217 @@+-- |+-- Module : Database.LevelDB.Types+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- License : BSD3+-- Maintainer : kim.altintop@gmail.com+-- Stability : experimental+-- Portability : non-portable+--++module Database.LevelDB.Types+ ( BatchOp (..)+ , BloomFilter (..)+ , Comparator (..)+ , Compression (..)+ , FilterPolicy (..)+ , Options (..)+ , Property (..)+ , ReadOptions (..)+ , Snapshot (..)+ , WriteBatch+ , WriteOptions (..)++ , defaultOptions+ , defaultReadOptions+ , defaultWriteOptions+ )+where++import Data.ByteString (ByteString)+import Data.Default+import Foreign++import Database.LevelDB.C++-- | Snapshot handle+newtype Snapshot = Snapshot SnapshotPtr deriving (Eq)++-- | Compression setting+data Compression = NoCompression | Snappy deriving (Eq, Show)++-- | User-defined comparator+newtype Comparator = Comparator (ByteString -> ByteString -> Ordering)++-- | User-defined filter policy+data FilterPolicy = FilterPolicy+ { fpName :: String+ , createFilter :: [ByteString] -> ByteString+ , keyMayMatch :: ByteString -> ByteString -> Bool+ }++-- | Represents the built-in Bloom Filter+newtype BloomFilter = BloomFilter FilterPolicyPtr++-- | Options when opening a database+data Options = Options+ { blockRestartInterval :: !Int+ -- ^ Number of keys between restart points for delta encoding of keys.+ --+ -- This parameter can be changed dynamically. Most clients should leave+ -- this parameter alone.+ --+ -- Default: 16+ , blockSize :: !Int+ -- ^ Approximate size of user data packed per block.+ --+ -- Note that the block size specified here corresponds to uncompressed+ -- data. The actual size of the unit read from disk may be smaller if+ -- compression is enabled.+ --+ -- This parameter can be changed dynamically.+ --+ -- Default: 4k+ , cacheSize :: !Int+ -- ^ Control over blocks (user data is stored in a set of blocks, and a+ -- block is the unit of reading from disk).+ --+ -- If > 0, use the specified cache (in bytes) for blocks. If 0, leveldb+ -- will automatically create and use an 8MB internal cache.+ --+ -- Default: 0+ , comparator :: !(Maybe Comparator)+ -- ^ Comparator used to defined the order of keys in the table.+ --+ -- If 'Nothing', the default comparator is used, which uses lexicographic+ -- bytes-wise ordering.+ --+ -- NOTE: the client must ensure that the comparator supplied here has the+ -- same name and orders keys /exactly/ the same as the comparator provided+ -- to previous open calls on the same DB.+ --+ -- Default: Nothing+ , compression :: !Compression+ -- ^ Compress blocks using the specified compression algorithm.+ --+ -- This parameter can be changed dynamically.+ --+ -- Default: 'Snappy'+ , createIfMissing :: !Bool+ -- ^ If true, the database will be created if it is missing.+ --+ -- Default: False+ , errorIfExists :: !Bool+ -- ^ It true, an error is raised if the database already exists.+ --+ -- Default: False+ , maxOpenFiles :: !Int+ -- ^ Number of open files that can be used by the DB.+ --+ -- You may need to increase this if your database has a large working set+ -- (budget one open file per 2MB of working set).+ --+ -- Default: 1000+ , paranoidChecks :: !Bool+ -- ^ If true, the implementation will do aggressive checking of the data+ -- it is processing and will stop early if it detects any errors.+ --+ -- This may have unforeseen ramifications: for example, a corruption of+ -- one DB entry may cause a large number of entries to become unreadable+ -- or for the entire DB to become unopenable.+ --+ -- Default: False+ , writeBufferSize :: !Int+ -- ^ Amount of data to build up in memory (backed by an unsorted log on+ -- disk) before converting to a sorted on-disk file.+ --+ -- Larger values increase performance, especially during bulk loads. Up to+ -- to write buffers may be held in memory at the same time, so you may+ -- with to adjust this parameter to control memory usage. Also, a larger+ -- write buffer will result in a longer recovery time the next time the+ -- database is opened.+ --+ -- Default: 4MB+ , filterPolicy :: !(Maybe (Either BloomFilter FilterPolicy))+ }++defaultOptions :: Options+defaultOptions = Options+ { blockRestartInterval = 16+ , blockSize = 4096+ , cacheSize = 0+ , comparator = Nothing+ , compression = Snappy+ , createIfMissing = False+ , errorIfExists = False+ , maxOpenFiles = 1000+ , paranoidChecks = False+ , writeBufferSize = 4 `shift` 20+ , filterPolicy = Nothing+ }++instance Default Options where+ def = defaultOptions++-- | Options for write operations+data WriteOptions = WriteOptions+ { sync :: !Bool+ -- ^ If true, the write will be flushed from the operating system buffer+ -- cache (by calling WritableFile::Sync()) before the write is considered+ -- complete. If this flag is true, writes will be slower.+ --+ -- If this flag is false, and the machine crashes, some recent writes may+ -- be lost. Note that if it is just the process that crashes (i.e., the+ -- machine does not reboot), no writes will be lost even if sync==false.+ --+ -- In other words, a DB write with sync==false has similar crash semantics+ -- as the "write()" system call. A DB write with sync==true has similar+ -- crash semantics to a "write()" system call followed by "fsync()".+ --+ -- Default: False+ } deriving (Eq, Show)++defaultWriteOptions :: WriteOptions+defaultWriteOptions = WriteOptions { sync = False }++instance Default WriteOptions where+ def = defaultWriteOptions++-- | Options for read operations+data ReadOptions = ReadOptions+ { verifyCheckSums :: !Bool+ -- ^ If true, all data read from underlying storage will be verified+ -- against corresponding checksuyms.+ --+ -- Default: False+ , fillCache :: !Bool+ -- ^ Should the data read for this iteration be cached in memory? Callers+ -- may with to set this field to false for bulk scans.+ --+ -- Default: True+ , useSnapshot :: !(Maybe Snapshot)+ -- ^ If 'Just', read as of the supplied snapshot (which must belong to the+ -- DB that is being read and which must not have been released). If+ -- 'Nothing', use an implicit snapshot of the state at the beginning of+ -- this read operation.+ --+ -- Default: Nothing+ } deriving (Eq)++defaultReadOptions :: ReadOptions+defaultReadOptions = ReadOptions+ { verifyCheckSums = False+ , fillCache = True+ , useSnapshot = Nothing+ }++instance Default ReadOptions where+ def = defaultReadOptions++type WriteBatch = [BatchOp]++-- | Batch operation+data BatchOp = Put ByteString ByteString | Del ByteString+ deriving (Eq, Show)++-- | Properties exposed by LevelDB+data Property = NumFilesAtLevel Int | Stats | SSTables+ deriving (Eq, Show)
+ tests/tests.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}++module Main where++import System.Process(system)+import Test.Hspec+import Test.Hspec.Expectations+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck++import Control.Monad (liftM, void)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Default+import Database.LevelDB+++import Control.Monad.Reader++initializeDB :: MonadResource m => m DB+initializeDB =+ open "/tmp/leveltest" defaultOptions{ createIfMissing = True+ , cacheSize= 2048+ }++main :: IO ()+main = hspec $ do+ it "cleanup" $ cleanup >>= shouldReturn (return())++ describe "Basic DB Functionality" $ do++ it "should put items into the database and retrieve them" $ do+ let res = runResourceT $ do+ db <- initializeDB++ put db def "zzz" "zzz"+ get db def "zzz"+ res `shouldReturn` (Just "zzz")+++testDBPath :: String+testDBPath = "/tmp/haskell-leveldb-tests"++cleanup :: IO ()+cleanup = system ("rm -fr " ++ testDBPath) >> return ()