{-# LANGUAGE LambdaCase #-}
-- |
-- Module      : Database.RocksDB.Base
-- Copyright   : (c) 2012-2013 The leveldb-haskell Authors
--               (c) 2014-2020 The rocksdb-haskell Authors
-- License     : BSD3
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : non-portable
--
-- RocksDB Haskell binding.
--
-- The API closely follows the C-API of RocksDB.

module Database.RocksDB.Base
    ( -- * Exported Types
      DB (..)
    , BatchOp (..)
    , Range
    , ColumnFamily

    -- * Options
    , Config (..)

    -- * Basic Database Manipulations
    , withDB
    , withDBCF
    , put
    , putCF
    , delete
    , deleteCF
    , write
    , get
    , getCF
    , withSnapshot

    -- * Administrative Functions
    , Property (..), getProperty
    , destroy
    , repair
    , approximateSize

    -- * Iteration
    , module Database.RocksDB.Iterator
    ) where

import           Control.Monad             (when, (>=>), forM)
import           Data.ByteString           (ByteString)
import qualified Data.ByteString           as BS
import           Data.ByteString.Internal  (ByteString (..))
import qualified Data.ByteString.Unsafe    as BU
import           Database.RocksDB.C
import           Database.RocksDB.Internal
import           Database.RocksDB.Iterator
import           UnliftIO
import           UnliftIO.Directory
import           UnliftIO.Foreign

-- | Properties exposed by RocksDB
data Property = NumFilesAtLevel Int | Stats | SSTables
    deriving (Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show)

data BatchOp = Put !ByteString !ByteString
             | Del !ByteString
             | PutCF !ColumnFamily !ByteString !ByteString
             | DelCF !ColumnFamily !ByteString
             deriving (BatchOp -> BatchOp -> Bool
(BatchOp -> BatchOp -> Bool)
-> (BatchOp -> BatchOp -> Bool) -> Eq BatchOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchOp -> BatchOp -> Bool
$c/= :: BatchOp -> BatchOp -> Bool
== :: BatchOp -> BatchOp -> Bool
$c== :: BatchOp -> BatchOp -> Bool
Eq, Int -> BatchOp -> ShowS
[BatchOp] -> ShowS
BatchOp -> String
(Int -> BatchOp -> ShowS)
-> (BatchOp -> String) -> ([BatchOp] -> ShowS) -> Show BatchOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchOp] -> ShowS
$cshowList :: [BatchOp] -> ShowS
show :: BatchOp -> String
$cshow :: BatchOp -> String
showsPrec :: Int -> BatchOp -> ShowS
$cshowsPrec :: Int -> BatchOp -> ShowS
Show)

-- | Open a database.
--
-- The returned handle should be released with 'close'.
withDB :: MonadUnliftIO m => FilePath -> Config -> (DB -> m a) -> m a
withDB :: String -> Config -> (DB -> m a) -> m a
withDB String
path Config
config DB -> m a
f =
    Config -> (Options -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Config -> (Options -> m a) -> m a
withOptions Config
config ((Options -> m a) -> m a) -> (Options -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Options
opts_ptr ->
    Maybe Snapshot -> (ReadOpts -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe Snapshot -> (ReadOpts -> m a) -> m a
withReadOpts Maybe Snapshot
forall a. Maybe a
Nothing ((ReadOpts -> m a) -> m a) -> (ReadOpts -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ReadOpts
read_opts ->
    (WriteOpts -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WriteOpts -> m a) -> m a
withWriteOpts ((WriteOpts -> m a) -> m a) -> (WriteOpts -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \WriteOpts
write_opts ->
    m DB -> (DB -> m ()) -> (DB -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Options -> ReadOpts -> WriteOpts -> m DB
forall (m :: * -> *).
MonadUnliftIO m =>
Options -> ReadOpts -> WriteOpts -> m DB
create_db Options
opts_ptr ReadOpts
read_opts WriteOpts
write_opts) DB -> m ()
forall (m :: * -> *). MonadIO m => DB -> m ()
destroy_db DB -> m a
f
  where
    destroy_db :: DB -> m ()
destroy_db DB
db = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
        RocksDB -> IO ()
c_rocksdb_close (RocksDB -> IO ()) -> RocksDB -> IO ()
forall a b. (a -> b) -> a -> b
$ DB -> RocksDB
rocksDB DB
db
    create_db :: Options -> ReadOpts -> WriteOpts -> m DB
create_db Options
opts_ptr ReadOpts
read_opts WriteOpts
write_opts = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
createIfMissing Config
config) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Bool -> String -> m ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
path
        String -> (CString -> m DB) -> m DB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> m DB) -> m DB) -> (CString -> m DB) -> m DB
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr -> do
            RocksDB
db_ptr <- IO RocksDB -> m RocksDB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RocksDB -> m RocksDB)
-> ((ErrPtr -> IO RocksDB) -> IO RocksDB)
-> (ErrPtr -> IO RocksDB)
-> m RocksDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"open" ((ErrPtr -> IO RocksDB) -> m RocksDB)
-> (ErrPtr -> IO RocksDB) -> m RocksDB
forall a b. (a -> b) -> a -> b
$
                Options -> CString -> ErrPtr -> IO RocksDB
c_rocksdb_open Options
opts_ptr CString
path_ptr
            DB -> m DB
forall (m :: * -> *) a. Monad m => a -> m a
return DB :: RocksDB -> [ColumnFamily] -> ReadOpts -> WriteOpts -> DB
DB { rocksDB :: RocksDB
rocksDB = RocksDB
db_ptr
                      , columnFamilies :: [ColumnFamily]
columnFamilies = []
                      , readOpts :: ReadOpts
readOpts = ReadOpts
read_opts
                      , writeOpts :: WriteOpts
writeOpts = WriteOpts
write_opts
                      }

withDBCF :: MonadUnliftIO m
         => FilePath
         -> Config
         -> [(String, Config)]
         -> (DB -> m a)
         -> m a
withDBCF :: String -> Config -> [(String, Config)] -> (DB -> m a) -> m a
withDBCF String
path Config
config [(String, Config)]
cf_cfgs DB -> m a
f =
    Config -> (Options -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Config -> (Options -> m a) -> m a
withOptions Config
config ((Options -> m a) -> m a) -> (Options -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Options
opts_ptr ->
    [Config] -> ([Options] -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
[Config] -> ([Options] -> m a) -> m a
withOptionsCF (((String, Config) -> Config) -> [(String, Config)] -> [Config]
forall a b. (a -> b) -> [a] -> [b]
map (String, Config) -> Config
forall a b. (a, b) -> b
snd [(String, Config)]
cf_cfgs) (([Options] -> m a) -> m a) -> ([Options] -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \[Options]
cf_opts ->
    Maybe Snapshot -> (ReadOpts -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe Snapshot -> (ReadOpts -> m a) -> m a
withReadOpts Maybe Snapshot
forall a. Maybe a
Nothing ((ReadOpts -> m a) -> m a) -> (ReadOpts -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ReadOpts
read_opts ->
    (WriteOpts -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WriteOpts -> m a) -> m a
withWriteOpts ((WriteOpts -> m a) -> m a) -> (WriteOpts -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \WriteOpts
write_opts ->
    [String] -> ([CString] -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
[String] -> ([CString] -> m a) -> m a
withStrings (((String, Config) -> String) -> [(String, Config)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Config) -> String
forall a b. (a, b) -> a
fst [(String, Config)]
cf_cfgs) (([CString] -> m a) -> m a) -> ([CString] -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \[CString]
cf_names ->
    Int -> (ErrPtr -> m a) -> m a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
allocaArray ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((ErrPtr -> m a) -> m a) -> (ErrPtr -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ErrPtr
cf_names_array ->
    Int -> (Ptr Options -> m a) -> m a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
allocaArray ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Ptr Options -> m a) -> m a) -> (Ptr Options -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Ptr Options
cf_opts_array ->
    Int -> (Ptr ColumnFamily -> m a) -> m a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
allocaArray ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Ptr ColumnFamily -> m a) -> m a)
-> (Ptr ColumnFamily -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Ptr ColumnFamily
cf_ptrs_array ->
        m DB -> (DB -> m ()) -> (DB -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ( Options
-> [CString]
-> ErrPtr
-> [Options]
-> Ptr Options
-> ReadOpts
-> Ptr ColumnFamily
-> WriteOpts
-> m DB
forall (m :: * -> *).
MonadIO m =>
Options
-> [CString]
-> ErrPtr
-> [Options]
-> Ptr Options
-> ReadOpts
-> Ptr ColumnFamily
-> WriteOpts
-> m DB
create_db Options
opts_ptr
                            [CString]
cf_names
                            ErrPtr
cf_names_array
                            [Options]
cf_opts
                            Ptr Options
cf_opts_array
                            ReadOpts
read_opts
                            Ptr ColumnFamily
cf_ptrs_array
                            WriteOpts
write_opts
                ) DB -> m ()
forall (m :: * -> *). MonadIO m => DB -> m ()
destroy_db DB -> m a
f
  where
    create_new :: [CString] -> [Options] -> Options -> ReadOpts -> WriteOpts -> IO DB
create_new [CString]
cf_names [Options]
cf_opts Options
opts_ptr ReadOpts
read_opts WriteOpts
write_opts = do
        Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
path
        String -> (CString -> IO DB) -> IO DB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> IO DB) -> IO DB) -> (CString -> IO DB) -> IO DB
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr -> do
            RocksDB
db_ptr <- IO RocksDB -> IO RocksDB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RocksDB -> IO RocksDB)
-> ((ErrPtr -> IO RocksDB) -> IO RocksDB)
-> (ErrPtr -> IO RocksDB)
-> IO RocksDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"open" ((ErrPtr -> IO RocksDB) -> IO RocksDB)
-> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall a b. (a -> b) -> a -> b
$
                Options -> CString -> ErrPtr -> IO RocksDB
c_rocksdb_open Options
opts_ptr CString
path_ptr
            [ColumnFamily]
cfs <- [(CString, Options)]
-> ((CString, Options) -> IO ColumnFamily) -> IO [ColumnFamily]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([CString] -> [Options] -> [(CString, Options)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CString]
cf_names [Options]
cf_opts) (((CString, Options) -> IO ColumnFamily) -> IO [ColumnFamily])
-> ((CString, Options) -> IO ColumnFamily) -> IO [ColumnFamily]
forall a b. (a -> b) -> a -> b
$ \(CString
n, Options
o) ->
                String -> (ErrPtr -> IO ColumnFamily) -> IO ColumnFamily
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"create_column_family" ((ErrPtr -> IO ColumnFamily) -> IO ColumnFamily)
-> (ErrPtr -> IO ColumnFamily) -> IO ColumnFamily
forall a b. (a -> b) -> a -> b
$
                RocksDB -> Options -> CString -> ErrPtr -> IO ColumnFamily
c_rocksdb_create_column_family
                RocksDB
db_ptr Options
o CString
n
            DB -> IO DB
forall (m :: * -> *) a. Monad m => a -> m a
return DB :: RocksDB -> [ColumnFamily] -> ReadOpts -> WriteOpts -> DB
DB { rocksDB :: RocksDB
rocksDB = RocksDB
db_ptr
                      , columnFamilies :: [ColumnFamily]
columnFamilies = [ColumnFamily]
cfs
                      , readOpts :: ReadOpts
readOpts = ReadOpts
read_opts
                      , writeOpts :: WriteOpts
writeOpts = WriteOpts
write_opts
                      }
    destroy_db :: DB -> m ()
destroy_db DB
db = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        (ColumnFamily -> IO ()) -> [ColumnFamily] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ColumnFamily -> IO ()
c_rocksdb_column_family_handle_destroy (DB -> [ColumnFamily]
columnFamilies DB
db)
        RocksDB -> IO ()
c_rocksdb_close (RocksDB -> IO ()) -> RocksDB -> IO ()
forall a b. (a -> b) -> a -> b
$ DB -> RocksDB
rocksDB DB
db
    create_db :: Options
-> [CString]
-> ErrPtr
-> [Options]
-> Ptr Options
-> ReadOpts
-> Ptr ColumnFamily
-> WriteOpts
-> m DB
create_db Options
opts_ptr
              [CString]
cf_names
              ErrPtr
cf_names_array
              [Options]
cf_opts
              Ptr Options
cf_opts_array
              ReadOpts
read_opts
              Ptr ColumnFamily
cf_ptrs_array
              WriteOpts
write_opts = IO DB -> m DB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DB -> m DB) -> IO DB -> m DB
forall a b. (a -> b) -> a -> b
$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
createIfMissing Config
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
path
        [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> IO [String] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
forall (m :: * -> *). MonadIO m => String -> m [String]
listDirectory String
path IO Bool -> (Bool -> IO DB) -> IO DB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True -> [CString] -> [Options] -> Options -> ReadOpts -> WriteOpts -> IO DB
create_new [CString]
cf_names [Options]
cf_opts Options
opts_ptr ReadOpts
read_opts WriteOpts
write_opts
            Bool
False -> String -> (CString -> IO DB) -> IO DB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> IO DB) -> IO DB) -> (CString -> IO DB) -> IO DB
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr ->
                String -> (CString -> IO DB) -> IO DB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
"default" ((CString -> IO DB) -> IO DB) -> (CString -> IO DB) -> IO DB
forall a b. (a -> b) -> a -> b
$ \CString
cf_deflt_name -> do
                    ErrPtr -> [CString] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Ptr a -> [a] -> m ()
pokeArray ErrPtr
cf_names_array (CString
cf_deflt_name CString -> [CString] -> [CString]
forall a. a -> [a] -> [a]
: [CString]
cf_names)
                    Ptr Options -> [Options] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Ptr a -> [a] -> m ()
pokeArray Ptr Options
cf_opts_array (Options
opts_ptr Options -> [Options] -> [Options]
forall a. a -> [a] -> [a]
: [Options]
cf_opts)
                    RocksDB
db_ptr <- String -> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"open" ((ErrPtr -> IO RocksDB) -> IO RocksDB)
-> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall a b. (a -> b) -> a -> b
$
                        Options
-> CString
-> CInt
-> ErrPtr
-> Ptr Options
-> Ptr ColumnFamily
-> ErrPtr
-> IO RocksDB
c_rocksdb_open_column_families
                        Options
opts_ptr
                        CString
path_ptr
                        (Int -> CInt
intToCInt ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                        ErrPtr
cf_names_array
                        Ptr Options
cf_opts_array
                        Ptr ColumnFamily
cf_ptrs_array
                    [ColumnFamily]
cfs <- Int -> Ptr ColumnFamily -> IO [ColumnFamily]
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Ptr a -> m [a]
peekArray ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ptr ColumnFamily
cf_ptrs_array
                    DB -> IO DB
forall (m :: * -> *) a. Monad m => a -> m a
return DB :: RocksDB -> [ColumnFamily] -> ReadOpts -> WriteOpts -> DB
DB { rocksDB :: RocksDB
rocksDB = RocksDB
db_ptr
                              , columnFamilies :: [ColumnFamily]
columnFamilies = [ColumnFamily] -> [ColumnFamily]
forall a. [a] -> [a]
tail [ColumnFamily]
cfs
                              , readOpts :: ReadOpts
readOpts = ReadOpts
read_opts
                              , writeOpts :: WriteOpts
writeOpts = WriteOpts
write_opts
                              }

-- | Run an action with a snapshot of the database.
-- The 'DB' object is not valid after the action ends.
withSnapshot :: MonadUnliftIO m => DB -> (DB -> m a) -> m a
withSnapshot :: DB -> (DB -> m a) -> m a
withSnapshot db :: DB
db@DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr} DB -> m a
f =
    m (DB, Snapshot)
-> ((DB, Snapshot) -> m ()) -> ((DB, Snapshot) -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m (DB, Snapshot)
create_snapshot (DB, Snapshot) -> m ()
forall a. (a, Snapshot) -> m ()
release_snapshot (DB -> m a
f (DB -> m a) -> ((DB, Snapshot) -> DB) -> (DB, Snapshot) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DB, Snapshot) -> DB
forall a b. (a, b) -> a
fst)
  where
    release_snapshot :: (a, Snapshot) -> m ()
release_snapshot = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((a, Snapshot) -> IO ()) -> (a, Snapshot) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RocksDB -> Snapshot -> IO ()
c_rocksdb_release_snapshot RocksDB
db_ptr (Snapshot -> IO ())
-> ((a, Snapshot) -> Snapshot) -> (a, Snapshot) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Snapshot) -> Snapshot
forall a b. (a, b) -> b
snd
    create_snapshot :: m (DB, Snapshot)
create_snapshot = IO (DB, Snapshot) -> m (DB, Snapshot)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DB, Snapshot) -> m (DB, Snapshot))
-> IO (DB, Snapshot) -> m (DB, Snapshot)
forall a b. (a -> b) -> a -> b
$ do
        Snapshot
snap_ptr <- RocksDB -> IO Snapshot
c_rocksdb_create_snapshot RocksDB
db_ptr
        Maybe Snapshot
-> (ReadOpts -> IO (DB, Snapshot)) -> IO (DB, Snapshot)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe Snapshot -> (ReadOpts -> m a) -> m a
withReadOpts (Snapshot -> Maybe Snapshot
forall a. a -> Maybe a
Just Snapshot
snap_ptr) ((ReadOpts -> IO (DB, Snapshot)) -> IO (DB, Snapshot))
-> (ReadOpts -> IO (DB, Snapshot)) -> IO (DB, Snapshot)
forall a b. (a -> b) -> a -> b
$ \ReadOpts
read_opts ->
            (DB, Snapshot) -> IO (DB, Snapshot)
forall (m :: * -> *) a. Monad m => a -> m a
return (DB
db{readOpts :: ReadOpts
readOpts = ReadOpts
read_opts}, Snapshot
snap_ptr)

-- | Get a DB property.
getProperty :: MonadIO m => DB -> Property -> m (Maybe ByteString)
getProperty :: DB -> Property -> m (Maybe ByteString)
getProperty DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr} Property
p = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
    String
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString (Property -> String
prop Property
p) ((CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
    RocksDB -> CString -> IO CString
c_rocksdb_property_value RocksDB
db_ptr (CString -> IO CString)
-> (CString -> IO (Maybe ByteString))
-> CString
-> IO (Maybe ByteString)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    CString
val_ptr | CString
val_ptr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
            | Bool
otherwise -> do
                  Maybe ByteString
res <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
BS.packCString CString
val_ptr
                  CString -> IO ()
freeCString CString
val_ptr
                  Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
res
  where
    prop :: Property -> String
prop (NumFilesAtLevel Int
i) = String
"rocksdb.num-files-at-level" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
    prop Property
Stats               = String
"rocksdb.stats"
    prop Property
SSTables            = String
"rocksdb.sstables"

-- | Destroy the given RocksDB database.
destroy :: MonadIO m => FilePath -> Options -> m ()
destroy :: String -> Options -> m ()
destroy String
path Options
opts_ptr = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> (CString -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr ->
    String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"destroy" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> CString -> ErrPtr -> IO ()
c_rocksdb_destroy_db Options
opts_ptr CString
path_ptr

-- | Repair the given RocksDB database.
repair :: MonadIO m => FilePath -> Options -> m ()
repair :: String -> Options -> m ()
repair String
path Options
opts_ptr = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> (CString -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr ->
    String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"repair" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> CString -> ErrPtr -> IO ()
c_rocksdb_repair_db Options
opts_ptr CString
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 -> Range -> m Int64
approximateSize DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr} (ByteString
from, ByteString
to) = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO Int64) -> IO Int64
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
from ((CStringLen -> IO Int64) -> IO Int64)
-> (CStringLen -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \(CString
from_ptr, Int
flen) ->
    ByteString -> (CStringLen -> IO Int64) -> IO Int64
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
to   ((CStringLen -> IO Int64) -> IO Int64)
-> (CStringLen -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \(CString
to_ptr, Int
tlen)   ->
    [CString] -> (ErrPtr -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
[a] -> (Ptr a -> m b) -> m b
withArray [CString
from_ptr]          ((ErrPtr -> IO Int64) -> IO Int64)
-> (ErrPtr -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \ErrPtr
from_ptrs        ->
    [CSize] -> (Ptr CSize -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
[a] -> (Ptr a -> m b) -> m b
withArray [Int -> CSize
intToCSize Int
flen]   ((Ptr CSize -> IO Int64) -> IO Int64)
-> (Ptr CSize -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
flen_ptrs        ->
    [CString] -> (ErrPtr -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
[a] -> (Ptr a -> m b) -> m b
withArray [CString
to_ptr]            ((ErrPtr -> IO Int64) -> IO Int64)
-> (ErrPtr -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \ErrPtr
to_ptrs          ->
    [CSize] -> (Ptr CSize -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
[a] -> (Ptr a -> m b) -> m b
withArray [Int -> CSize
intToCSize Int
tlen]   ((Ptr CSize -> IO Int64) -> IO Int64)
-> (Ptr CSize -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
tlen_ptrs        ->
    Int -> (Ptr Word64 -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
allocaArray Int
1                 ((Ptr Word64 -> IO Int64) -> IO Int64)
-> (Ptr Word64 -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
size_ptrs        -> do
        RocksDB
-> CInt
-> ErrPtr
-> Ptr CSize
-> ErrPtr
-> Ptr CSize
-> Ptr Word64
-> IO ()
c_rocksdb_approximate_sizes RocksDB
db_ptr CInt
1
                                    ErrPtr
from_ptrs Ptr CSize
flen_ptrs
                                    ErrPtr
to_ptrs Ptr CSize
tlen_ptrs
                                    Ptr Word64
size_ptrs
        ([Int64] -> Int64) -> IO [Int64] -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int64] -> Int64
forall a. [a] -> a
head (IO [Int64] -> IO Int64) -> IO [Int64] -> IO Int64
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word64 -> IO [Word64]
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Ptr a -> m [a]
peekArray Int
1 Ptr Word64
size_ptrs IO [Word64] -> ([Word64] -> IO [Int64]) -> IO [Int64]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word64 -> IO Int64) -> [Word64] -> IO [Int64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word64 -> IO Int64
toInt64

    where
        toInt64 :: Word64 -> IO Int64
toInt64 = Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Int64) -> (Word64 -> Int64) -> Word64 -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Write a key/value pair.
put :: MonadIO m => DB -> ByteString -> ByteString -> m ()
put :: DB -> ByteString -> ByteString -> m ()
put DB
db = DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
putCommon DB
db Maybe ColumnFamily
forall a. Maybe a
Nothing

putCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> ByteString -> m ()
putCF :: DB -> ColumnFamily -> ByteString -> ByteString -> m ()
putCF DB
db ColumnFamily
cf = DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
putCommon DB
db (ColumnFamily -> Maybe ColumnFamily
forall a. a -> Maybe a
Just ColumnFamily
cf)

putCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
putCommon :: DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
putCommon DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr, writeOpts :: DB -> WriteOpts
writeOpts = WriteOpts
write_opts} Maybe ColumnFamily
mcf ByteString
key ByteString
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key   ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
value ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
val_ptr, Int
vlen) ->
        String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"put" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe ColumnFamily
mcf of
            Just ColumnFamily
cf -> RocksDB
-> WriteOpts
-> ColumnFamily
-> CString
-> CSize
-> CString
-> CSize
-> ErrPtr
-> IO ()
c_rocksdb_put_cf
                      RocksDB
db_ptr WriteOpts
write_opts ColumnFamily
cf
                      CString
key_ptr (Int -> CSize
intToCSize Int
klen)
                      CString
val_ptr (Int -> CSize
intToCSize Int
vlen)
            Maybe ColumnFamily
Nothing -> RocksDB
-> WriteOpts
-> CString
-> CSize
-> CString
-> CSize
-> ErrPtr
-> IO ()
c_rocksdb_put
                      RocksDB
db_ptr WriteOpts
write_opts
                      CString
key_ptr (Int -> CSize
intToCSize Int
klen)
                      CString
val_ptr (Int -> CSize
intToCSize Int
vlen)

-- | Read a value by key.
get :: MonadIO m => DB -> ByteString -> m (Maybe ByteString)
get :: DB -> ByteString -> m (Maybe ByteString)
get DB
db = DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
getCommon DB
db Maybe ColumnFamily
forall a. Maybe a
Nothing

getCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> m (Maybe ByteString)
getCF :: DB -> ColumnFamily -> ByteString -> m (Maybe ByteString)
getCF DB
db ColumnFamily
cf = DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
getCommon DB
db (ColumnFamily -> Maybe ColumnFamily
forall a. a -> Maybe a
Just ColumnFamily
cf)

getCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
getCommon :: DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
getCommon DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr, readOpts :: DB -> ReadOpts
readOpts = ReadOpts
read_opts} Maybe ColumnFamily
mcf ByteString
key = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
    (Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca                       ((Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
vlen_ptr -> do
        CString
val_ptr <- String -> (ErrPtr -> IO CString) -> IO CString
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"get" ((ErrPtr -> IO CString) -> IO CString)
-> (ErrPtr -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$
            case Maybe ColumnFamily
mcf of
                Just ColumnFamily
cf -> RocksDB
-> ReadOpts
-> ColumnFamily
-> CString
-> CSize
-> Ptr CSize
-> ErrPtr
-> IO CString
c_rocksdb_get_cf
                           RocksDB
db_ptr ReadOpts
read_opts ColumnFamily
cf
                           CString
key_ptr (Int -> CSize
intToCSize Int
klen) Ptr CSize
vlen_ptr
                Maybe ColumnFamily
Nothing -> RocksDB
-> ReadOpts
-> CString
-> CSize
-> Ptr CSize
-> ErrPtr
-> IO CString
c_rocksdb_get
                           RocksDB
db_ptr ReadOpts
read_opts
                           CString
key_ptr (Int -> CSize
intToCSize Int
klen) Ptr CSize
vlen_ptr
        CSize
vlen <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
vlen_ptr
        if CString
val_ptr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
            then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
            else do
                Maybe ByteString
res' <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
BS.packCStringLen (CString
val_ptr, CSize -> Int
cSizeToInt CSize
vlen)
                CString -> IO ()
freeCString CString
val_ptr
                Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
res'

delete :: MonadIO m => DB -> ByteString -> m ()
delete :: DB -> ByteString -> m ()
delete DB
db = DB -> Maybe ColumnFamily -> ByteString -> m ()
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> m ()
deleteCommon DB
db Maybe ColumnFamily
forall a. Maybe a
Nothing

deleteCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> m ()
deleteCF :: DB -> ColumnFamily -> ByteString -> m ()
deleteCF DB
db ColumnFamily
cf = DB -> Maybe ColumnFamily -> ByteString -> m ()
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> m ()
deleteCommon DB
db (ColumnFamily -> Maybe ColumnFamily
forall a. a -> Maybe a
Just ColumnFamily
cf)

-- | Delete a key/value pair.
deleteCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> m ()
deleteCommon :: DB -> Maybe ColumnFamily -> ByteString -> m ()
deleteCommon DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr, writeOpts :: DB -> WriteOpts
writeOpts = WriteOpts
write_opts} Maybe ColumnFamily
mcf ByteString
key = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
    String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"delete" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe ColumnFamily
mcf of
    Just ColumnFamily
cf -> RocksDB
-> WriteOpts -> ColumnFamily -> CString -> CSize -> ErrPtr -> IO ()
c_rocksdb_delete_cf RocksDB
db_ptr WriteOpts
write_opts ColumnFamily
cf CString
key_ptr (Int -> CSize
intToCSize Int
klen)
    Maybe ColumnFamily
Nothing -> RocksDB -> WriteOpts -> CString -> CSize -> ErrPtr -> IO ()
c_rocksdb_delete RocksDB
db_ptr WriteOpts
write_opts CString
key_ptr (Int -> CSize
intToCSize Int
klen)

-- | Perform a batch mutation.
write :: MonadIO m => DB -> [BatchOp] -> m ()
write :: DB -> [BatchOp] -> m ()
write DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr, writeOpts :: DB -> WriteOpts
writeOpts = WriteOpts
write_opts} [BatchOp]
batch = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    IO WriteBatch
-> (WriteBatch -> IO ()) -> (WriteBatch -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    IO WriteBatch
c_rocksdb_writebatch_create
    WriteBatch -> IO ()
c_rocksdb_writebatch_destroy ((WriteBatch -> IO ()) -> IO ()) -> (WriteBatch -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WriteBatch
batch_ptr -> do
        (BatchOp -> IO ()) -> [BatchOp] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WriteBatch -> BatchOp -> IO ()
batchAdd WriteBatch
batch_ptr) [BatchOp]
batch
        String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"write" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ RocksDB -> WriteOpts -> WriteBatch -> ErrPtr -> IO ()
c_rocksdb_write RocksDB
db_ptr WriteOpts
write_opts WriteBatch
batch_ptr
        -- ensure @ByteString@s (and respective shared @CStringLen@s) aren't
        -- GC'ed until here
        (BatchOp -> IO ()) -> [BatchOp] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> (BatchOp -> IO ()) -> BatchOp -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatchOp -> IO ()
forall (m :: * -> *). MonadIO m => BatchOp -> m ()
touch) [BatchOp]
batch
  where
    batchAdd :: WriteBatch -> BatchOp -> IO ()
batchAdd WriteBatch
batch_ptr (Put ByteString
key ByteString
val) =
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
val ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
val_ptr, Int
vlen) ->
            WriteBatch -> CString -> CSize -> CString -> CSize -> IO ()
c_rocksdb_writebatch_put
            WriteBatch
batch_ptr
            CString
key_ptr (Int -> CSize
intToCSize Int
klen)
            CString
val_ptr (Int -> CSize
intToCSize Int
vlen)
    batchAdd WriteBatch
batch_ptr (PutCF ColumnFamily
cf_ptr ByteString
key ByteString
val) =
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
val ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
val_ptr, Int
vlen) ->
            WriteBatch
-> ColumnFamily -> CString -> CSize -> CString -> CSize -> IO ()
c_rocksdb_writebatch_put_cf
            WriteBatch
batch_ptr
            ColumnFamily
cf_ptr
            CString
key_ptr (Int -> CSize
intToCSize Int
klen)
            CString
val_ptr (Int -> CSize
intToCSize Int
vlen)
    batchAdd WriteBatch
batch_ptr (Del ByteString
key) =
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
            WriteBatch -> CString -> CSize -> IO ()
c_rocksdb_writebatch_delete
            WriteBatch
batch_ptr
            CString
key_ptr (Int -> CSize
intToCSize Int
klen)
    batchAdd WriteBatch
batch_ptr (DelCF ColumnFamily
cf_ptr ByteString
key) =
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
            WriteBatch -> ColumnFamily -> CString -> CSize -> IO ()
c_rocksdb_writebatch_delete_cf
            WriteBatch
batch_ptr
            ColumnFamily
cf_ptr
            CString
key_ptr (Int -> CSize
intToCSize Int
klen)
    touch :: BatchOp -> m ()
touch (Put (PS ForeignPtr Word8
p Int
_ Int
_) (PS ForeignPtr Word8
p' Int
_ Int
_)) = do
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p'
    touch (PutCF ColumnFamily
_ (PS ForeignPtr Word8
p Int
_ Int
_) (PS ForeignPtr Word8
p' Int
_ Int
_)) = do
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p'
    touch (Del (PS ForeignPtr Word8
p Int
_ Int
_)) =
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p
    touch (DelCF ColumnFamily
_ (PS ForeignPtr Word8
p Int
_ Int
_)) =
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p

withStrings :: MonadUnliftIO m => [String] -> ([CString] -> m a) -> m a
withStrings :: [String] -> ([CString] -> m a) -> m a
withStrings [String]
ss [CString] -> m a
f =
    [CString] -> [String] -> m a
go [] [String]
ss
  where
    go :: [CString] -> [String] -> m a
go [CString]
acc [] = [CString] -> m a
f ([CString] -> [CString]
forall a. [a] -> [a]
reverse [CString]
acc)
    go [CString]
acc (String
x:[String]
xs) = String -> (CString -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
x ((CString -> m a) -> m a) -> (CString -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \CString
p -> [CString] -> [String] -> m a
go (CString
pCString -> [CString] -> [CString]
forall a. a -> [a] -> [a]
:[CString]
acc) [String]
xs