diff --git a/AUTHORS b/AUTHORS
new file mode 100644
--- /dev/null
+++ b/AUTHORS
@@ -0,0 +1,9 @@
+# The following people, listed in alphabetical order, contributed to the
+# rocksdb-haskell library:
+
+Austin Seipp
+Alexander Thiemann
+Kim Altintop
+Michael Lazarev
+Nicolas Trangez
+Will Moss
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+Copyright (c) 2011, Kim Altintop
+Copyright (c) 2014, Alexander Thiemann
+
+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,47 @@
+This library provides Haskell bindings to
+[RocksDB](http://rocksdb.org)
+
+[](https://drone.io/github.com/agrafix/rocksdb-haskell/latest)
+
+## History
+
+Version 0.1.x:
+
+* initial fork of leveldb-haskell
+
+## Installation
+
+Prerequisites:
+
+* [GHC 7.*](http://www.haskell.org/ghc)
+* [Cabal](http://www.haskell.org/cabal), version 1.3 or higher
+* [RocksDB](http://rocksdb.org)
+* Optional: [Snappy](http://code.google.com/p/snappy),
+ if compression support is desired
+
+To install the latest version from hackage:
+
+```shell
+$ cabal install rocksdb-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/agrafix/rocksdb-haskell/issues.
+Patches are best submitted as pull requests, or via email
+(mail@agrafix.net).
+
+## 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/rocksdb-haskell.cabal b/rocksdb-haskell.cabal
new file mode 100644
--- /dev/null
+++ b/rocksdb-haskell.cabal
@@ -0,0 +1,55 @@
+name: rocksdb-haskell
+version: 0.1.0
+synopsis: Haskell bindings to RocksDB
+homepage: http://github.com/agrafix/rocksdb-haskell
+bug-reports: http://github.com/agrafix/rocksdb-haskell/issues
+license: BSD3
+license-file: LICENSE
+author: Kim Altintop, Alexander Thiemann et.al. (see AUTHORS file)
+maintainer: mail@agrafix.net
+copyright: Copyright (c) 2012-2014 The leveldb-haskell Authors, Copyright (c) 2014 The rocksdb-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 :
+ .
+ RocksDB is an embeddable persistent key-value store for fast storage. RocksDB can also be the foundation for a client-server database but our current focus is on embedded workloads.
+ .
+ RocksDB builds on LevelDB to be scalable to run on servers with many CPU cores, to efficiently use fast storage, to support IO-bound, in-memory and write-once workloads, and to be flexible to allow for innovation.
+extra-source-files: Readme.md, AUTHORS
+
+source-repository head
+ type: git
+ location: git://github.com/agrafix/rocksdb-haskell.git
+
+library
+ exposed-modules: Database.RocksDB
+ , Database.RocksDB.Base
+ , Database.RocksDB.C
+ , Database.RocksDB.Internal
+ , Database.RocksDB.Iterator
+ , Database.RocksDB.MonadResource
+ , Database.RocksDB.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: rocksdb
diff --git a/src/Database/RocksDB.hs b/src/Database/RocksDB.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/RocksDB.hs
@@ -0,0 +1,17 @@
+-- |
+-- Module : Database.RocksDB
+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors
+-- (c) 2014 The rocksdb-haskell Authors
+-- License : BSD3
+-- Maintainer : mail@agrafix.net
+-- Stability : experimental
+-- Portability : non-portable
+--
+-- RocksDB Haskell binding.
+--
+-- The API closely follows the C-API of RocksDB.
+-- For more information, see:
+
+module Database.RocksDB (module R) where
+
+import Database.RocksDB.MonadResource as R
diff --git a/src/Database/RocksDB/Base.hs b/src/Database/RocksDB/Base.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/RocksDB/Base.hs
@@ -0,0 +1,245 @@
+-- |
+-- Module : Database.RocksDB.Base
+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors
+-- (c) 2014 The rocksdb-haskell Authors
+-- License : BSD3
+-- Maintainer : mail@agrafix.net
+-- Stability : experimental
+-- Portability : non-portable
+--
+-- RocksDB Haskell binding.
+--
+-- The API closely follows the C-API of RocksDB.
+-- For more information, see:
+
+module Database.RocksDB.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
+
+ -- * Iteration
+ , module Database.RocksDB.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.RocksDB.C
+import Database.RocksDB.Internal
+import Database.RocksDB.Iterator
+import Database.RocksDB.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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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) = "rocksdb.num-files-at-level" ++ show i
+ prop Stats = "rocksdb.stats"
+ prop SSTables = "rocksdb.sstables"
+
+-- | Destroy the given RocksDB 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_rocksdb_destroy_db opts_ptr path_ptr
+
+-- | Repair the given RocksDB 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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_writebatch_create c_rocksdb_writebatch_destroy $ \batch_ptr -> do
+
+ mapM_ (batchAdd batch_ptr) batch
+
+ throwIfErr "write" $ c_rocksdb_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_rocksdb_writebatch_put batch_ptr
+ key_ptr (intToCSize klen)
+ val_ptr (intToCSize vlen)
+
+ batchAdd batch_ptr (Del key) =
+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->
+ c_rocksdb_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
+
+createBloomFilter :: MonadIO m => Int -> m BloomFilter
+createBloomFilter i = do
+ let i' = fromInteger . toInteger $ i
+ fp_ptr <- liftIO $ c_rocksdb_filterpolicy_create_bloom i'
+ return $ BloomFilter fp_ptr
+
+releaseBloomFilter :: MonadIO m => BloomFilter -> m ()
+releaseBloomFilter (BloomFilter fp) = liftIO $ c_rocksdb_filterpolicy_destroy fp
diff --git a/src/Database/RocksDB/C.hsc b/src/Database/RocksDB/C.hsc
new file mode 100644
--- /dev/null
+++ b/src/Database/RocksDB/C.hsc
@@ -0,0 +1,344 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}
+-- |
+-- Module : Database.RocksDB.C
+-- Copyright : (c) 2012-2013 The rocksdb-haskell Authors
+-- License : BSD3
+-- Maintainer : kim.altintop@gmail.com
+-- Stability : experimental
+-- Portability : non-portable
+--
+
+module Database.RocksDB.C where
+
+import Foreign
+import Foreign.C.Types
+import Foreign.C.String
+
+#include
+
+data RocksDB
+data LCache
+data LComparator
+data LIterator
+data LLogger
+data LOptions
+data LReadOptions
+data LSnapshot
+data LWriteBatch
+data LWriteOptions
+data LFilterPolicy
+
+type RocksDBPtr = Ptr RocksDB
+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
+ , enableCompression = 1
+ }
+
+
+foreign import ccall safe "rocksdb/c.h rocksdb_open"
+ c_rocksdb_open :: OptionsPtr -> DBName -> ErrPtr -> IO RocksDBPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_close"
+ c_rocksdb_close :: RocksDBPtr -> IO ()
+
+
+foreign import ccall safe "rocksdb/c.h rocksdb_put"
+ c_rocksdb_put :: RocksDBPtr
+ -> WriteOptionsPtr
+ -> Key -> CSize
+ -> Val -> CSize
+ -> ErrPtr
+ -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_delete"
+ c_rocksdb_delete :: RocksDBPtr
+ -> WriteOptionsPtr
+ -> Key -> CSize
+ -> ErrPtr
+ -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_write"
+ c_rocksdb_write :: RocksDBPtr
+ -> 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 "rocksdb/c.h rocksdb_get"
+ c_rocksdb_get :: RocksDBPtr
+ -> ReadOptionsPtr
+ -> Key -> CSize
+ -> Ptr CSize -- ^ value length
+ -> ErrPtr
+ -> IO CString
+
+foreign import ccall safe "rocksdb/c.h rocksdb_create_snapshot"
+ c_rocksdb_create_snapshot :: RocksDBPtr -> IO SnapshotPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_release_snapshot"
+ c_rocksdb_release_snapshot :: RocksDBPtr -> SnapshotPtr -> IO ()
+
+-- | Returns NULL if property name is unknown. Else returns a pointer to a
+-- malloc()-ed null-terminated value.
+foreign import ccall safe "rocksdb/c.h rocksdb_property_value"
+ c_rocksdb_property_value :: RocksDBPtr -> CString -> IO CString
+
+foreign import ccall safe "rocksdb/c.h rocksdb_approximate_sizes"
+ c_rocksdb_approximate_sizes :: RocksDBPtr
+ -> 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 "rocksdb/c.h rocksdb_destroy_db"
+ c_rocksdb_destroy_db :: OptionsPtr -> DBName -> ErrPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_repair_db"
+ c_rocksdb_repair_db :: OptionsPtr -> DBName -> ErrPtr -> IO ()
+
+
+--
+-- Iterator
+--
+
+foreign import ccall safe "rocksdb/c.h rocksdb_create_iterator"
+ c_rocksdb_create_iterator :: RocksDBPtr -> ReadOptionsPtr -> IO IteratorPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_destroy"
+ c_rocksdb_iter_destroy :: IteratorPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_valid"
+ c_rocksdb_iter_valid :: IteratorPtr -> IO CUChar
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek_to_first"
+ c_rocksdb_iter_seek_to_first :: IteratorPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek_to_last"
+ c_rocksdb_iter_seek_to_last :: IteratorPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek"
+ c_rocksdb_iter_seek :: IteratorPtr -> Key -> CSize -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_next"
+ c_rocksdb_iter_next :: IteratorPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_prev"
+ c_rocksdb_iter_prev :: IteratorPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_key"
+ c_rocksdb_iter_key :: IteratorPtr -> Ptr CSize -> IO Key
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_value"
+ c_rocksdb_iter_value :: IteratorPtr -> Ptr CSize -> IO Val
+
+foreign import ccall safe "rocksdb/c.h rocksdb_iter_get_error"
+ c_rocksdb_iter_get_error :: IteratorPtr -> ErrPtr -> IO ()
+
+
+--
+-- Write batch
+--
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_create"
+ c_rocksdb_writebatch_create :: IO WriteBatchPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_destroy"
+ c_rocksdb_writebatch_destroy :: WriteBatchPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_clear"
+ c_rocksdb_writebatch_clear :: WriteBatchPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_put"
+ c_rocksdb_writebatch_put :: WriteBatchPtr
+ -> Key -> CSize
+ -> Val -> CSize
+ -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_delete"
+ c_rocksdb_writebatch_delete :: WriteBatchPtr -> Key -> CSize -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_iterate"
+ c_rocksdb_writebatch_iterate :: WriteBatchPtr
+ -> Ptr () -- ^ state
+ -> FunPtr (Ptr () -> Key -> CSize -> Val -> CSize) -- ^ put
+ -> FunPtr (Ptr () -> Key -> CSize) -- ^ delete
+ -> IO ()
+
+
+--
+-- Options
+--
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_create"
+ c_rocksdb_options_create :: IO OptionsPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_destroy"
+ c_rocksdb_options_destroy :: OptionsPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_comparator"
+ c_rocksdb_options_set_comparator :: OptionsPtr -> ComparatorPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_filter_policy"
+ c_rocksdb_options_set_filter_policy :: OptionsPtr -> FilterPolicyPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_create_if_missing"
+ c_rocksdb_options_set_create_if_missing :: OptionsPtr -> CUChar -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_error_if_exists"
+ c_rocksdb_options_set_error_if_exists :: OptionsPtr -> CUChar -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_paranoid_checks"
+ c_rocksdb_options_set_paranoid_checks :: OptionsPtr -> CUChar -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_info_log"
+ c_rocksdb_options_set_info_log :: OptionsPtr -> LoggerPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_write_buffer_size"
+ c_rocksdb_options_set_write_buffer_size :: OptionsPtr -> CSize -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_max_open_files"
+ c_rocksdb_options_set_max_open_files :: OptionsPtr -> CInt -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_block_size"
+ c_rocksdb_options_set_block_size :: OptionsPtr -> CSize -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_block_restart_interval"
+ c_rocksdb_options_set_block_restart_interval :: OptionsPtr -> CInt -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_compression"
+ c_rocksdb_options_set_compression :: OptionsPtr -> CompressionOpt -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_cache"
+ c_rocksdb_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 "rocksdb/c.h rocksdb_comparator_create"
+ c_rocksdb_comparator_create :: StatePtr
+ -> FunPtr Destructor
+ -> FunPtr CompareFun
+ -> FunPtr NameFun
+ -> IO ComparatorPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_comparator_destroy"
+ c_rocksdb_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 "rocksdb/c.h rocksdb_filterpolicy_create"
+ c_rocksdb_filterpolicy_create :: StatePtr
+ -> FunPtr Destructor
+ -> FunPtr CreateFilterFun
+ -> FunPtr KeyMayMatchFun
+ -> FunPtr NameFun
+ -> IO FilterPolicyPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_destroy"
+ c_rocksdb_filterpolicy_destroy :: FilterPolicyPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_create_bloom"
+ c_rocksdb_filterpolicy_create_bloom :: CInt -> IO FilterPolicyPtr
+
+--
+-- Read options
+--
+
+foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_create"
+ c_rocksdb_readoptions_create :: IO ReadOptionsPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_destroy"
+ c_rocksdb_readoptions_destroy :: ReadOptionsPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_set_verify_checksums"
+ c_rocksdb_readoptions_set_verify_checksums :: ReadOptionsPtr -> CUChar -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_set_fill_cache"
+ c_rocksdb_readoptions_set_fill_cache :: ReadOptionsPtr -> CUChar -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_set_snapshot"
+ c_rocksdb_readoptions_set_snapshot :: ReadOptionsPtr -> SnapshotPtr -> IO ()
+
+
+--
+-- Write options
+--
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writeoptions_create"
+ c_rocksdb_writeoptions_create :: IO WriteOptionsPtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writeoptions_destroy"
+ c_rocksdb_writeoptions_destroy :: WriteOptionsPtr -> IO ()
+
+foreign import ccall safe "rocksdb/c.h rocksdb_writeoptions_set_sync"
+ c_rocksdb_writeoptions_set_sync :: WriteOptionsPtr -> CUChar -> IO ()
+
+
+--
+-- Cache
+--
+
+foreign import ccall safe "rocksdb/c.h rocksdb_cache_create_lru"
+ c_rocksdb_cache_create_lru :: CSize -> IO CachePtr
+
+foreign import ccall safe "rocksdb/c.h rocksdb_cache_destroy"
+ c_rocksdb_cache_destroy :: CachePtr -> IO ()
diff --git a/src/Database/RocksDB/Internal.hs b/src/Database/RocksDB/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/RocksDB/Internal.hs
@@ -0,0 +1,294 @@
+{-# LANGUAGE RecordWildCards #-}
+-- |
+-- Module : Database.RocksDB.Internal
+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors
+-- (c) 2014 The rocksdb-haskell Authors
+-- License : BSD3
+-- Maintainer : mail@agrafix.net
+-- Stability : experimental
+-- Portability : non-portable
+--
+
+module Database.RocksDB.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.RocksDB.C
+import Database.RocksDB.Types
+
+import qualified Data.ByteString as BS
+
+
+-- | Database handle
+data DB = DB RocksDBPtr 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_rocksdb_options_create
+
+ c_rocksdb_options_set_block_restart_interval opts_ptr
+ $ intToCInt blockRestartInterval
+ c_rocksdb_options_set_block_size opts_ptr
+ $ intToCSize blockSize
+ c_rocksdb_options_set_compression opts_ptr
+ $ ccompression compression
+ c_rocksdb_options_set_create_if_missing opts_ptr
+ $ boolToNum createIfMissing
+ c_rocksdb_options_set_error_if_exists opts_ptr
+ $ boolToNum errorIfExists
+ c_rocksdb_options_set_max_open_files opts_ptr
+ $ intToCInt maxOpenFiles
+ c_rocksdb_options_set_paranoid_checks opts_ptr
+ $ boolToNum paranoidChecks
+ c_rocksdb_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 EnableCompression =
+ enableCompression
+
+ maybeSetCache :: OptionsPtr -> Int -> IO (Maybe CachePtr)
+ maybeSetCache opts_ptr size =
+ if size <= 0
+ then return Nothing
+ else do
+ cache_ptr <- c_rocksdb_cache_create_lru $ intToCSize size
+ c_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_options_destroy opts_ptr
+ maybe (return ()) c_rocksdb_cache_destroy mcache_ptr
+ maybe (return ()) freeComparator mcmp_ptr
+ maybe (return ())
+ (either c_rocksdb_filterpolicy_destroy freeFilterPolicy)
+ mfp
+
+ return ()
+
+withCWriteOpts :: WriteOptions -> (WriteOptionsPtr -> IO a) -> IO a
+withCWriteOpts WriteOptions{..} = bracket mkCWriteOpts freeCWriteOpts
+ where
+ mkCWriteOpts = do
+ opts_ptr <- c_rocksdb_writeoptions_create
+ onException
+ (c_rocksdb_writeoptions_set_sync opts_ptr $ boolToNum sync)
+ (c_rocksdb_writeoptions_destroy opts_ptr)
+ return opts_ptr
+
+ freeCWriteOpts = c_rocksdb_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_rocksdb_comparator_create nullPtr cdest ccmpfun cname
+ return $ Comparator' ccmpfun cdest cname ccmp
+
+
+freeComparator :: Comparator' -> IO ()
+freeComparator (Comparator' ccmpfun cdest cname ccmp) = do
+ c_rocksdb_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_rocksdb_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_rocksdb_filterpolicy_destroy cfp
+ freeHaskellFunPtr ccffun
+ freeHaskellFunPtr ckmfun
+ freeHaskellFunPtr cdest
+ freeHaskellFunPtr cname
+
+mkCReadOpts :: ReadOptions -> IO ReadOptionsPtr
+mkCReadOpts ReadOptions{..} = do
+ opts_ptr <- c_rocksdb_readoptions_create
+ flip onException (c_rocksdb_readoptions_destroy opts_ptr) $ do
+ c_rocksdb_readoptions_set_verify_checksums opts_ptr $ boolToNum verifyCheckSums
+ c_rocksdb_readoptions_set_fill_cache opts_ptr $ boolToNum fillCache
+
+ case useSnapshot of
+ Just (Snapshot snap_ptr) -> c_rocksdb_readoptions_set_snapshot opts_ptr snap_ptr
+ Nothing -> return ()
+
+ return opts_ptr
+
+freeCReadOpts :: ReadOptionsPtr -> IO ()
+freeCReadOpts = c_rocksdb_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/RocksDB/Iterator.hs b/src/Database/RocksDB/Iterator.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/RocksDB/Iterator.hs
@@ -0,0 +1,228 @@
+-- |
+-- Module : Database.RocksDB.Iterator
+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors
+-- (c) 2014 The rocksdb-haskell Authors
+-- License : BSD3
+-- Maintainer : mail@agrafix.net
+-- Stability : experimental
+-- Portability : non-portable
+--
+-- Iterating over key ranges.
+--
+
+module Database.RocksDB.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.RocksDB.C
+import Database.RocksDB.Internal
+import Database.RocksDB.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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_iter_valid iter_ptr
+ when (valid /= 0) $ c_rocksdb_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_rocksdb_iter_valid iter_ptr
+ when (valid /= 0) $ c_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_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_rocksdb_iter_valid iter_ptr
+ if valid == 0
+ then return acc
+ else do
+ val <- f iter
+ () <- liftIO $ c_rocksdb_iter_next iter_ptr
+ go (val : acc)
+
+-- | 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_rocksdb_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/RocksDB/MonadResource.hs b/src/Database/RocksDB/MonadResource.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/RocksDB/MonadResource.hs
@@ -0,0 +1,279 @@
+-- |
+-- Module : Database.RocksDB.MonadResource
+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors
+-- (c) 2014 The rocksdb-haskell Authors
+-- License : BSD3
+-- Maintainer : mail@agrafix.net
+-- Stability : experimental
+-- Portability : non-portable
+--
+
+module Database.RocksDB.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
+
+ -- * 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.RocksDB.Base (BatchOp, BloomFilter, Comparator,
+ Compression, DB, FilterPolicy,
+ Iterator, Options, Property,
+ Range, ReadOptions, Snapshot,
+ WriteBatch, WriteOptions,
+ defaultOptions,
+ defaultReadOptions,
+ defaultWriteOptions)
+import qualified Database.RocksDB.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 rocksdb database.
+destroy :: MonadResource m => FilePath -> Options -> m ()
+destroy = Base.destroy
+
+-- | Repair the given rocksdb 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
diff --git a/src/Database/RocksDB/Types.hs b/src/Database/RocksDB/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/RocksDB/Types.hs
@@ -0,0 +1,218 @@
+-- |
+-- Module : Database.RocksDB.Types
+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors
+-- (c) 2014 The rocksdb-haskell Authors
+-- License : BSD3
+-- Maintainer : mail@agrafix.net
+-- Stability : experimental
+-- Portability : non-portable
+--
+
+module Database.RocksDB.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.RocksDB.C
+
+-- | Snapshot handle
+newtype Snapshot = Snapshot SnapshotPtr deriving (Eq)
+
+-- | Compression setting
+data Compression = NoCompression | EnableCompression 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, rocksdb
+ -- 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: 'EnableCompression'
+ , 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 = EnableCompression
+ , 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 RocksDB
+data Property = NumFilesAtLevel Int | Stats | SSTables
+ deriving (Eq, Show)