{-# LANGUAGE LambdaCase #-}
module Database.RocksDB.Iterator
( Iterator
, withIter
, withIterCF
, iterEntry
, iterFirst
, iterGetError
, iterKey
, iterLast
, iterNext
, iterPrev
, iterSeek
, iterValid
, iterValue
) where
import Control.Monad (when)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Unsafe as BU
import Database.RocksDB.C
import Database.RocksDB.Internal
import Foreign
import Foreign.C.Error (throwErrnoIfNull)
import Foreign.C.String (CString, peekCString)
import Foreign.C.Types (CSize)
import UnliftIO
withIter :: MonadUnliftIO m => DB -> (Iterator -> m a) -> m a
withIter :: DB -> (Iterator -> m a) -> m a
withIter DB
db = DB -> Maybe ColumnFamily -> (Iterator -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> Maybe ColumnFamily -> (Iterator -> m a) -> m a
withIterCommon DB
db Maybe ColumnFamily
forall a. Maybe a
Nothing
withIterCF :: MonadUnliftIO m => DB -> ColumnFamily -> (Iterator -> m a) -> m a
withIterCF :: DB -> ColumnFamily -> (Iterator -> m a) -> m a
withIterCF DB
db ColumnFamily
cf = DB -> Maybe ColumnFamily -> (Iterator -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
DB -> Maybe ColumnFamily -> (Iterator -> m a) -> m a
withIterCommon DB
db (ColumnFamily -> Maybe ColumnFamily
forall a. a -> Maybe a
Just ColumnFamily
cf)
withIterCommon :: MonadUnliftIO m
=> DB
-> Maybe ColumnFamily
-> (Iterator -> m a)
-> m a
withIterCommon :: DB -> Maybe ColumnFamily -> (Iterator -> m a) -> m a
withIterCommon DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
rocks_db, readOpts :: DB -> ReadOpts
readOpts = ReadOpts
read_opts} Maybe ColumnFamily
mcf =
m Iterator -> (Iterator -> m ()) -> (Iterator -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m Iterator
create_iterator Iterator -> m ()
destroy_iterator
where
destroy_iterator :: Iterator -> m ()
destroy_iterator = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Iterator -> IO ()) -> Iterator -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iterator -> IO ()
c_rocksdb_iter_destroy
create_iterator :: m Iterator
create_iterator = IO Iterator -> m Iterator
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Iterator -> m Iterator) -> IO Iterator -> m Iterator
forall a b. (a -> b) -> a -> b
$
String -> IO Iterator -> IO Iterator
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull String
"create_iterator" (IO Iterator -> IO Iterator) -> IO Iterator -> IO Iterator
forall a b. (a -> b) -> a -> b
$ case Maybe ColumnFamily
mcf of
Just ColumnFamily
cf -> RocksDB -> ReadOpts -> ColumnFamily -> IO Iterator
c_rocksdb_create_iterator_cf RocksDB
rocks_db ReadOpts
read_opts ColumnFamily
cf
Maybe ColumnFamily
Nothing -> RocksDB -> ReadOpts -> IO Iterator
c_rocksdb_create_iterator RocksDB
rocks_db ReadOpts
read_opts
iterValid :: MonadIO m => Iterator -> m Bool
iterValid :: Iterator -> m Bool
iterValid Iterator
iter_ptr = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
CUChar
x <- Iterator -> IO CUChar
c_rocksdb_iter_valid Iterator
iter_ptr
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar
x CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
/= CUChar
0)
iterSeek :: MonadIO m => Iterator -> ByteString -> m ()
iterSeek :: Iterator -> ByteString -> m ()
iterSeek Iterator
iter_ptr 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
$ \(Ptr CChar
key_ptr, Int
klen) ->
Iterator -> Ptr CChar -> CSize -> IO ()
c_rocksdb_iter_seek Iterator
iter_ptr Ptr CChar
key_ptr (Int -> CSize
intToCSize Int
klen)
iterFirst :: MonadIO m => Iterator -> m ()
iterFirst :: Iterator -> m ()
iterFirst = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Iterator -> IO ()) -> Iterator -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iterator -> IO ()
c_rocksdb_iter_seek_to_first
iterLast :: MonadIO m => Iterator -> m ()
iterLast :: Iterator -> m ()
iterLast = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Iterator -> IO ()) -> Iterator -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iterator -> IO ()
c_rocksdb_iter_seek_to_last
iterNext :: MonadIO m => Iterator -> m ()
iterNext :: Iterator -> m ()
iterNext Iterator
iter_ptr = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
CUChar
valid <- Iterator -> IO CUChar
c_rocksdb_iter_valid Iterator
iter_ptr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUChar
valid CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
/= CUChar
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Iterator -> IO ()
c_rocksdb_iter_next Iterator
iter_ptr
iterPrev :: MonadIO m => Iterator -> m ()
iterPrev :: Iterator -> m ()
iterPrev Iterator
iter_ptr = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
CUChar
valid <- Iterator -> IO CUChar
c_rocksdb_iter_valid Iterator
iter_ptr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUChar
valid CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
/= CUChar
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Iterator -> IO ()
c_rocksdb_iter_prev Iterator
iter_ptr
iterKey :: MonadIO m => Iterator -> m (Maybe ByteString)
iterKey :: Iterator -> m (Maybe ByteString)
iterKey = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> (Iterator -> IO (Maybe ByteString))
-> Iterator
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Iterator
-> (Iterator -> Ptr CSize -> IO (Ptr CChar))
-> IO (Maybe ByteString))
-> (Iterator -> Ptr CSize -> IO (Ptr CChar))
-> Iterator
-> IO (Maybe ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Iterator
-> (Iterator -> Ptr CSize -> IO (Ptr CChar))
-> IO (Maybe ByteString)
iterString Iterator -> Ptr CSize -> IO (Ptr CChar)
c_rocksdb_iter_key
iterValue :: MonadIO m => Iterator -> m (Maybe ByteString)
iterValue :: Iterator -> m (Maybe ByteString)
iterValue = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> (Iterator -> IO (Maybe ByteString))
-> Iterator
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Iterator
-> (Iterator -> Ptr CSize -> IO (Ptr CChar))
-> IO (Maybe ByteString))
-> (Iterator -> Ptr CSize -> IO (Ptr CChar))
-> Iterator
-> IO (Maybe ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Iterator
-> (Iterator -> Ptr CSize -> IO (Ptr CChar))
-> IO (Maybe ByteString)
iterString Iterator -> Ptr CSize -> IO (Ptr CChar)
c_rocksdb_iter_value
iterEntry :: MonadIO m => Iterator -> m (Maybe (ByteString, ByteString))
iterEntry :: Iterator -> m (Maybe (ByteString, ByteString))
iterEntry Iterator
iter = IO (Maybe (ByteString, ByteString))
-> m (Maybe (ByteString, ByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (ByteString, ByteString))
-> m (Maybe (ByteString, ByteString)))
-> IO (Maybe (ByteString, ByteString))
-> m (Maybe (ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ do
Maybe ByteString
mkey <- Iterator -> IO (Maybe ByteString)
forall (m :: * -> *). MonadIO m => Iterator -> m (Maybe ByteString)
iterKey Iterator
iter
Maybe ByteString
mval <- Iterator -> IO (Maybe ByteString)
forall (m :: * -> *). MonadIO m => Iterator -> m (Maybe ByteString)
iterValue Iterator
iter
Maybe (ByteString, ByteString)
-> IO (Maybe (ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ByteString, ByteString)
-> IO (Maybe (ByteString, ByteString)))
-> Maybe (ByteString, ByteString)
-> IO (Maybe (ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ (,) (ByteString -> ByteString -> (ByteString, ByteString))
-> Maybe ByteString
-> Maybe (ByteString -> (ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mkey Maybe (ByteString -> (ByteString, ByteString))
-> Maybe ByteString -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ByteString
mval
iterGetError :: MonadIO m => Iterator -> m (Maybe ByteString)
iterGetError :: Iterator -> m (Maybe ByteString)
iterGetError Iterator
iter_ptr = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> ((Ptr (Ptr CChar) -> IO (Maybe ByteString))
-> IO (Maybe ByteString))
-> (Ptr (Ptr CChar) -> IO (Maybe ByteString))
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr (Ptr CChar) -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CChar) -> IO (Maybe ByteString))
-> m (Maybe ByteString))
-> (Ptr (Ptr CChar) -> IO (Maybe ByteString))
-> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
err_ptr -> do
Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
err_ptr Ptr CChar
forall a. Ptr a
nullPtr
Iterator -> Ptr (Ptr CChar) -> IO ()
c_rocksdb_iter_get_error Iterator
iter_ptr Ptr (Ptr CChar)
err_ptr
Ptr CChar
erra <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
err_ptr
if Ptr CChar
erra Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
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
String
err <- Ptr CChar -> IO String
peekCString Ptr CChar
erra
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
BC.pack String
err)
iterString :: Iterator
-> (Iterator -> Ptr CSize -> IO CString)
-> IO (Maybe ByteString)
iterString :: Iterator
-> (Iterator -> Ptr CSize -> IO (Ptr CChar))
-> IO (Maybe ByteString)
iterString Iterator
iter_ptr Iterator -> Ptr CSize -> IO (Ptr CChar)
f =
Iterator -> IO CUChar
c_rocksdb_iter_valid Iterator
iter_ptr IO CUChar
-> (CUChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CUChar
0 -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
CUChar
_ -> (Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO 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
len_ptr ->
Iterator -> Ptr CSize -> IO (Ptr CChar)
f Iterator
iter_ptr Ptr CSize
len_ptr IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr CChar
ptr ->
if Ptr CChar
ptr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
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
CSize
len <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
len_ptr
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 (Ptr CChar
ptr, CSize -> Int
cSizeToInt CSize
len)