module Lmdb.Multimap
(
lookupValues
, insert
, dupsert
) where
import Prelude hiding (last,lookup)
import Foreign.Ptr (Ptr)
import Lmdb.Internal
import Lmdb.Types
import Foreign.Storable
import Database.LMDB.Raw
import Data.Word
import Control.Monad.Trans.Class
import Pipes (yield, Producer')
import Pipes.Core (respond,Server',(\>\),(/>/),(>+>),(>~>),request,pull,push)
import Foreign.Marshal.Alloc (allocaBytes,alloca)
import Foreign.C.Types (CSize(..))
import Control.Monad
lookupFirstValue :: MultiCursor e k v -> k -> IO (Maybe v)
lookupFirstValue mc k = getValueWithKey MDB_SET_KEY (downgradeCursor mc) k
lookupValues :: MultiCursor e k v -> k -> Producer' v IO ()
lookupValues cur k = do
m <- lift $ lookupFirstValue cur k
case m of
Nothing -> return ()
Just v -> do
yield v
forwardValues cur
forwardValues :: MultiCursor e k v -> Producer' v IO ()
forwardValues cur = if isFixed
then error "implement dupfixed value iteration"
else forwardValuesStandard cur
where
isFixed = case multiCursorDatabaseSettings cur of
MultiDatabaseSettings _ _ _ _ encVal _ -> isEncodingDupFixed encVal
forwardValuesStandard :: MultiCursor e k v -> Producer' v IO ()
forwardValuesStandard (MultiCursor cur dbs) = go where
go = do
m <- lift $ withKVPtrsNoInit $ \keyPtr valPtr -> do
success <- mdb_cursor_get_X MDB_NEXT_DUP cur keyPtr valPtr
decodeOne (getDecoding $ multiDatabaseSettingsDecodeValue dbs) success valPtr
case m of
Nothing -> return ()
Just v -> yield v >> go
insert :: MultiCursor 'ReadWrite k v -> k -> v -> IO ()
insert cur k v = do
insertInternalCursorNeutral noDupDataFlags (Right $ downgradeCursor cur) k v
return ()
dupsert :: MultiCursor 'ReadWrite k v -> k -> v -> IO ()
dupsert cur k v = do
insertInternalCursorNeutral noWriteFlags (Right $ downgradeCursor cur) k v
return ()