{-|
Module      : Mdbx.API
Copyright   : (c) 2021 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Thin wrappers over the low level API to provide MonadIO support and exception
based error handling.
-}
{-# LANGUAGE FlexibleContexts #-}

module Mdbx.API (
  -- Keys
  keyCmp,
  -- Env
  envOpen,
  envClose,
  -- Txn
  txnBegin,
  txnCommit,
  txnAbort,
  -- Dbi
  dbiOpen,
  dbiClose,
  -- Val
  itemPut,
  itemGet,
  itemDel,
  -- Cursor
  cursorOpen,
  cursorClose,
  cursorPut,
  cursorDel,
  cursorFirst,
  cursorLast,
  cursorAt,
  cursorRange,
  cursorNext,
  cursorPrev,
  cursorMove
) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Fail (MonadFail)

import Mdbx.FFI

{-|
Compares two keys and returns -1, 0 or 1 if key1 is lower, equal or greater than
key2.
-}
keyCmp
  :: MonadIO m
  => MdbxTxn
  -> MdbxDbi
  -> MdbxVal
  -> MdbxVal
  -> m Int
keyCmp :: MdbxTxn -> MdbxDbi -> MdbxVal -> MdbxVal -> m Int
keyCmp MdbxTxn
txn MdbxDbi
dbi MdbxVal
key1 MdbxVal
key2 = IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxTxn -> MdbxDbi -> MdbxVal -> MdbxVal -> IO Int
mdbx_cmp MdbxTxn
txn MdbxDbi
dbi MdbxVal
key1 MdbxVal
key2

-- | Opens an environment.
envOpen
  :: (MonadIO m, MonadFail m)
  => String
  -> [MdbxEnvFlags]
  -> m MdbxEnv
envOpen :: String -> [MdbxEnvFlags] -> m MdbxEnv
envOpen String
path [MdbxEnvFlags]
flags = do
  (Int
retCreate, MdbxEnv
env) <- IO (Int, MdbxEnv) -> m (Int, MdbxEnv)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Int, MdbxEnv)
mdbx_env_create
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
retCreate
  Int
retOpen <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxEnv -> String -> [MdbxEnvFlags] -> MdbxDbi -> IO Int
mdbx_env_open MdbxEnv
env String
path [MdbxEnvFlags]
flags MdbxDbi
0o644
  MdbxEnv -> Int -> m MdbxEnv
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError MdbxEnv
env Int
retOpen

-- | Close an environment.
envClose
  :: (MonadIO m, MonadFail m)
  => MdbxEnv
  -> m ()
envClose :: MdbxEnv -> m ()
envClose MdbxEnv
env = do
  Int
ret <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxEnv -> IO Int
mdbx_env_close MdbxEnv
env
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
ret

-- | Begins a transaction.
txnBegin
  :: (MonadIO m, MonadFail m)
  => MdbxEnv
  -> Maybe MdbxTxn
  -> [MdbxTxnFlags]
  -> m MdbxTxn
txnBegin :: MdbxEnv -> Maybe MdbxTxn -> [MdbxTxnFlags] -> m MdbxTxn
txnBegin MdbxEnv
env Maybe MdbxTxn
parent [MdbxTxnFlags]
flags = do
  (Int
ret, MdbxTxn
txn) <- IO (Int, MdbxTxn) -> m (Int, MdbxTxn)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, MdbxTxn) -> m (Int, MdbxTxn))
-> IO (Int, MdbxTxn) -> m (Int, MdbxTxn)
forall a b. (a -> b) -> a -> b
$ MdbxEnv -> Maybe MdbxTxn -> [MdbxTxnFlags] -> IO (Int, MdbxTxn)
mdbx_txn_begin MdbxEnv
env Maybe MdbxTxn
parent [MdbxTxnFlags]
flags
  MdbxTxn -> Int -> m MdbxTxn
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError MdbxTxn
txn Int
ret

-- | Commits a transaction.
txnCommit
  :: (MonadIO m, MonadFail m)
  => MdbxTxn
  -> m ()
txnCommit :: MdbxTxn -> m ()
txnCommit MdbxTxn
txn = do
  Int
ret <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxTxn -> IO Int
mdbx_txn_commit MdbxTxn
txn
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
ret

-- | Aborts a transaction.
txnAbort
  :: (MonadIO m, MonadFail m)
  => MdbxTxn
  -> m ()
txnAbort :: MdbxTxn -> m ()
txnAbort MdbxTxn
txn = do
  Int
ret <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxTxn -> IO Int
mdbx_txn_abort MdbxTxn
txn
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
ret

-- | Opens a database (table).
dbiOpen
  :: (MonadIO m, MonadFail m)
  => MdbxEnv
  -> Maybe String
  -> [MdbxDbFlags]
  -> m MdbxDbi
dbiOpen :: MdbxEnv -> Maybe String -> [MdbxDbFlags] -> m MdbxDbi
dbiOpen MdbxEnv
env Maybe String
name [MdbxDbFlags]
flags = do
  MdbxTxn
txn <- MdbxEnv -> Maybe MdbxTxn -> [MdbxTxnFlags] -> m MdbxTxn
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
MdbxEnv -> Maybe MdbxTxn -> [MdbxTxnFlags] -> m MdbxTxn
txnBegin MdbxEnv
env Maybe MdbxTxn
forall a. Maybe a
Nothing []
  (Int
ret, MdbxDbi
dbi) <- IO (Int, MdbxDbi) -> m (Int, MdbxDbi)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, MdbxDbi) -> m (Int, MdbxDbi))
-> IO (Int, MdbxDbi) -> m (Int, MdbxDbi)
forall a b. (a -> b) -> a -> b
$ MdbxTxn -> Maybe String -> [MdbxDbFlags] -> IO (Int, MdbxDbi)
mdbx_dbi_open MdbxTxn
txn Maybe String
name [MdbxDbFlags]
flags
  MdbxTxn -> m ()
forall (m :: * -> *). (MonadIO m, MonadFail m) => MdbxTxn -> m ()
txnAbort MdbxTxn
txn
  MdbxDbi -> Int -> m MdbxDbi
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError MdbxDbi
dbi Int
ret

-- | Closes a database.
dbiClose
  :: (MonadIO m, MonadFail m)
  => MdbxEnv
  -> MdbxDbi
  -> m ()
dbiClose :: MdbxEnv -> MdbxDbi -> m ()
dbiClose MdbxEnv
env MdbxDbi
dbi = do
  Int
ret <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxEnv -> MdbxDbi -> IO Int
mdbx_dbi_close MdbxEnv
env MdbxDbi
dbi
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
ret

-- | Returns the value associated to the given key, if any.
itemGet
  :: (MonadIO m, MonadFail m)
  => MdbxTxn
  -> MdbxDbi
  -> MdbxVal
  -> m (Maybe MdbxVal)
itemGet :: MdbxTxn -> MdbxDbi -> MdbxVal -> m (Maybe MdbxVal)
itemGet MdbxTxn
txn MdbxDbi
db MdbxVal
key = do
  (Int
ret, MdbxVal
val) <- IO (Int, MdbxVal) -> m (Int, MdbxVal)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, MdbxVal) -> m (Int, MdbxVal))
-> IO (Int, MdbxVal) -> m (Int, MdbxVal)
forall a b. (a -> b) -> a -> b
$ MdbxTxn -> MdbxDbi -> MdbxVal -> IO (Int, MdbxVal)
mdbx_get MdbxTxn
txn MdbxDbi
db MdbxVal
key
  if Int
ret Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== MdbxError -> Int
forall a. Enum a => a -> Int
fromEnum MdbxError
MdbxNotfound
    then Maybe MdbxVal -> m (Maybe MdbxVal)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MdbxVal
forall a. Maybe a
Nothing
    else Maybe MdbxVal -> Int -> m (Maybe MdbxVal)
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError (MdbxVal -> Maybe MdbxVal
forall a. a -> Maybe a
Just MdbxVal
val) Int
ret

-- | Saves the provided key/value pair.
itemPut
  :: (MonadIO m, MonadFail m)
  => MdbxTxn
  -> MdbxDbi
  -> MdbxVal
  -> MdbxVal
  -> [MdbxPutFlags]
  -> m ()
itemPut :: MdbxTxn -> MdbxDbi -> MdbxVal -> MdbxVal -> [MdbxPutFlags] -> m ()
itemPut MdbxTxn
txn MdbxDbi
db MdbxVal
key MdbxVal
val [MdbxPutFlags]
flags = do
  Int
ret <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxTxn
-> MdbxDbi -> MdbxVal -> MdbxVal -> [MdbxPutFlags] -> IO Int
mdbx_put MdbxTxn
txn MdbxDbi
db MdbxVal
key MdbxVal
val [MdbxPutFlags]
flags
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
ret

-- | Deletes the value associated with the given key, if any.
itemDel
  :: (MonadIO m, MonadFail m)
  => MdbxTxn
  -> MdbxDbi
  -> MdbxVal
  -> Maybe MdbxVal
  -> m ()
itemDel :: MdbxTxn -> MdbxDbi -> MdbxVal -> Maybe MdbxVal -> m ()
itemDel MdbxTxn
txn MdbxDbi
db MdbxVal
key Maybe MdbxVal
mval = do
  Int
ret <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxTxn -> MdbxDbi -> MdbxVal -> Maybe MdbxVal -> IO Int
mdbx_del MdbxTxn
txn MdbxDbi
db MdbxVal
key Maybe MdbxVal
mval
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
ret

-- | Opens a cursor.
cursorOpen
  :: (MonadIO m, MonadFail m)
  => MdbxTxn
  -> MdbxDbi
  -> m MdbxCursor
cursorOpen :: MdbxTxn -> MdbxDbi -> m MdbxCursor
cursorOpen MdbxTxn
txn MdbxDbi
dbi = do
  (Int
ret, MdbxCursor
cur) <- IO (Int, MdbxCursor) -> m (Int, MdbxCursor)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, MdbxCursor) -> m (Int, MdbxCursor))
-> IO (Int, MdbxCursor) -> m (Int, MdbxCursor)
forall a b. (a -> b) -> a -> b
$ MdbxTxn -> MdbxDbi -> IO (Int, MdbxCursor)
mdbx_cursor_open MdbxTxn
txn MdbxDbi
dbi
  MdbxCursor -> Int -> m MdbxCursor
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError MdbxCursor
cur Int
ret

-- | Closes a cursor.
cursorClose
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> m ()
cursorClose :: MdbxCursor -> m ()
cursorClose MdbxCursor
cur = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MdbxCursor -> IO ()
mdbx_cursor_close MdbxCursor
cur

-- | Stores the provided value at the given key, positioning the cursor on it.
cursorPut
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> MdbxVal
  -> MdbxVal
  -> [MdbxPutFlags]
  -> m ()
cursorPut :: MdbxCursor -> MdbxVal -> MdbxVal -> [MdbxPutFlags] -> m ()
cursorPut MdbxCursor
cur MdbxVal
key MdbxVal
val [MdbxPutFlags]
flags = do
  Int
ret <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxCursor -> MdbxVal -> MdbxVal -> [MdbxPutFlags] -> IO Int
mdbx_cursor_put MdbxCursor
cur MdbxVal
key MdbxVal
val [MdbxPutFlags]
flags
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
ret

-- | Deletes the value at the current position.
cursorDel
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> [MdbxPutFlags]
  -> m ()
cursorDel :: MdbxCursor -> [MdbxPutFlags] -> m ()
cursorDel MdbxCursor
cur [MdbxPutFlags]
flags = do
  Int
ret <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MdbxCursor -> [MdbxPutFlags] -> IO Int
mdbx_cursor_del MdbxCursor
cur [MdbxPutFlags]
flags
  () -> Int -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError () Int
ret

-- | Moves to the first key on the database.
cursorFirst
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> m (Maybe (MdbxVal, MdbxVal))
cursorFirst :: MdbxCursor -> m (Maybe (MdbxVal, MdbxVal))
cursorFirst MdbxCursor
cur = MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
cursorMove MdbxCursor
cur MdbxVal
emptyMdbxVal MdbxCursorOp
MdbxFirst

-- | Moves to the last key on the database.
cursorLast
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> m (Maybe (MdbxVal, MdbxVal))
cursorLast :: MdbxCursor -> m (Maybe (MdbxVal, MdbxVal))
cursorLast MdbxCursor
cur = MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
cursorMove MdbxCursor
cur MdbxVal
emptyMdbxVal MdbxCursorOp
MdbxLast

-- | Moves to the given key.
cursorAt
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> MdbxVal
  -> m (Maybe (MdbxVal, MdbxVal))
cursorAt :: MdbxCursor -> MdbxVal -> m (Maybe (MdbxVal, MdbxVal))
cursorAt MdbxCursor
cur MdbxVal
key = MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
cursorMove MdbxCursor
cur MdbxVal
key MdbxCursorOp
MdbxSetKey

-- | Moves to the given key or first greater than it. Useful for searching.
cursorRange
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> MdbxVal
  -> m (Maybe (MdbxVal, MdbxVal))
cursorRange :: MdbxCursor -> MdbxVal -> m (Maybe (MdbxVal, MdbxVal))
cursorRange MdbxCursor
cur MdbxVal
key = MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
cursorMove MdbxCursor
cur MdbxVal
key MdbxCursorOp
MdbxSetRange

-- | Moves to the next key.
cursorNext
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> m (Maybe (MdbxVal, MdbxVal))
cursorNext :: MdbxCursor -> m (Maybe (MdbxVal, MdbxVal))
cursorNext MdbxCursor
cur = MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
cursorMove MdbxCursor
cur MdbxVal
emptyMdbxVal MdbxCursorOp
MdbxNext

-- | Moves to the previous key.
cursorPrev
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> m (Maybe (MdbxVal, MdbxVal))
cursorPrev :: MdbxCursor -> m (Maybe (MdbxVal, MdbxVal))
cursorPrev MdbxCursor
cur = MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
cursorMove MdbxCursor
cur MdbxVal
emptyMdbxVal MdbxCursorOp
MdbxPrev

-- | Moves the cursor using the provided operation.
cursorMove
  :: (MonadIO m, MonadFail m)
  => MdbxCursor
  -> MdbxVal
  -> MdbxCursorOp
  -> m (Maybe (MdbxVal, MdbxVal))
cursorMove :: MdbxCursor
-> MdbxVal -> MdbxCursorOp -> m (Maybe (MdbxVal, MdbxVal))
cursorMove MdbxCursor
cur MdbxVal
baseKey MdbxCursorOp
op = do
  (Int
ret, MdbxVal
key, MdbxVal
val) <- IO (Int, MdbxVal, MdbxVal) -> m (Int, MdbxVal, MdbxVal)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, MdbxVal, MdbxVal) -> m (Int, MdbxVal, MdbxVal))
-> IO (Int, MdbxVal, MdbxVal) -> m (Int, MdbxVal, MdbxVal)
forall a b. (a -> b) -> a -> b
$ MdbxCursor -> MdbxVal -> MdbxCursorOp -> IO (Int, MdbxVal, MdbxVal)
mdbx_cursor_get MdbxCursor
cur MdbxVal
baseKey MdbxCursorOp
op
  if Int
ret Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== MdbxError -> Int
forall a. Enum a => a -> Int
fromEnum MdbxError
MdbxNotfound
    then Maybe (MdbxVal, MdbxVal) -> m (Maybe (MdbxVal, MdbxVal))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MdbxVal, MdbxVal)
forall a. Maybe a
Nothing
    else Maybe (MdbxVal, MdbxVal) -> Int -> m (Maybe (MdbxVal, MdbxVal))
forall (m :: * -> *) a. (MonadIO m, MonadFail m) => a -> Int -> m a
checkError ((MdbxVal, MdbxVal) -> Maybe (MdbxVal, MdbxVal)
forall a. a -> Maybe a
Just (MdbxVal
key, MdbxVal
val)) Int
ret

-- Helpers
checkError
  :: (MonadIO m, MonadFail m)
  => a
  -> Int
  -> m a
checkError :: a -> Int -> m a
checkError a
val Int
0 = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
checkError a
_ Int
code = do
  String
msg <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ Int -> IO String
mdbx_strerror Int
code
  String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg