diff --git a/AUTHORS b/AUTHORS
new file mode 100644
--- /dev/null
+++ b/AUTHORS
@@ -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
diff --git a/CHANGELOG b/CHANGELOG
new file mode 100644
--- /dev/null
+++ b/CHANGELOG
@@ -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
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Readme.md b/Readme.md
new file mode 100644
--- /dev/null
+++ b/Readme.md
@@ -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.
+Patches are best submitted as pull requests, or via email
+(kim.altintop@gmail.com).
+
+## License
+
+BSD 3, see LICENSE file.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/examples/comparator.hs b/examples/comparator.hs
new file mode 100644
--- /dev/null
+++ b/examples/comparator.hs
@@ -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 ()
diff --git a/examples/features.hs b/examples/features.hs
new file mode 100644
--- /dev/null
+++ b/examples/features.hs
@@ -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
diff --git a/examples/filterpolicy.hs b/examples/filterpolicy.hs
new file mode 100644
--- /dev/null
+++ b/examples/filterpolicy.hs
@@ -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 ()
diff --git a/examples/iterforkio.hs b/examples/iterforkio.hs
new file mode 100644
--- /dev/null
+++ b/examples/iterforkio.hs
@@ -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)
diff --git a/leveldb-haskell-fork.cabal b/leveldb-haskell-fork.cabal
new file mode 100644
--- /dev/null
+++ b/leveldb-haskell-fork.cabal
@@ -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 :
+ .
+ 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
diff --git a/src/Database/LevelDB.hs b/src/Database/LevelDB.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/LevelDB.hs
@@ -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:
+
+module Database.LevelDB (module R) where
+
+import Database.LevelDB.MonadResource as R
diff --git a/src/Database/LevelDB/Base.hs b/src/Database/LevelDB/Base.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/LevelDB/Base.hs
@@ -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:
+
+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
diff --git a/src/Database/LevelDB/C.hsc b/src/Database/LevelDB/C.hsc
new file mode 100644
--- /dev/null
+++ b/src/Database/LevelDB/C.hsc
@@ -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
+
+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
diff --git a/src/Database/LevelDB/Internal.hs b/src/Database/LevelDB/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/LevelDB/Internal.hs
@@ -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 #-}
diff --git a/src/Database/LevelDB/Iterator.hs b/src/Database/LevelDB/Iterator.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/LevelDB/Iterator.hs
@@ -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:
+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)
diff --git a/src/Database/LevelDB/MonadResource.hs b/src/Database/LevelDB/MonadResource.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/LevelDB/MonadResource.hs
@@ -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:
+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
diff --git a/src/Database/LevelDB/Types.hs b/src/Database/LevelDB/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/LevelDB/Types.hs
@@ -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)
diff --git a/tests/tests.hs b/tests/tests.hs
new file mode 100644
--- /dev/null
+++ b/tests/tests.hs
@@ -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 ()