gdritter repos tansu-berkeleydb / master Database / Tansu / Backend / BerkeleyDb.hs
master

Tree @master (Download .tar.gz)

BerkeleyDb.hs @master

0a9fba4
 
28f58b7
f9d1a2d
28f58b7
 
 
 
f9d1a2d
28f58b7
f9d1a2d
 
 
 
 
 
28f58b7
f9d1a2d
28f58b7
f9d1a2d
 
 
 
 
 
 
28f58b7
f9d1a2d
7292948
f9d1a2d
7292948
0a9fba4
f9d1a2d
 
 
 
28f58b7
 
 
 
 
 
14309c0
 
7292948
14309c0
 
28f58b7
 
 
module Database.Tansu.Backend.BerkeleyDb
         (withBerkeleyDb) where

import Control.Exception (catch)
import Database.Berkeley.Db
import Data.ByteString (ByteString)
import System.Directory (createDirectoryIfMissing)

import Database.Tansu.Internal

catchIO :: IO a -> IO (Either TansuError a)
catchIO mote = fmap return mote `catch` go
  where go :: DbException -> IO (Either TansuError a)
        go = return . Left . OtherError . show

bdbSet :: Db -> ByteString -> ByteString -> IO (Either TansuError ())
bdbSet db key val =
  catchIO $ db_put [] db Nothing key val

bdbGet :: Db -> ByteString -> IO (Either TansuError ByteString)
bdbGet db key = do
  rs <- catchIO $ db_get [] db Nothing key
  case rs of
    Right Nothing  -> return (Left (KeyNotFound key))
    Right (Just x) -> return (return x)
    Left err       -> return (Left err)

bdbDel :: Db -> ByteString -> IO (Either TansuError ())
bdbDel db key =
  catchIO $ db_del [] db Nothing key

-- | Open or create a database at the supplied path
--   using the BerkeleyDB library. Right now, this uses
--   a consistent set of options, but probably should
--   become configurable at some point.
withBerkeleyDb :: FilePath -> (TansuDb k v -> IO a) -> IO a
withBerkeleyDb path comp = do
  createDirectoryIfMissing True path
  env <- dbEnv_create []
  dbEnv_open [DB_CREATE,DB_INIT_MPOOL,DB_INIT_TXN] 0 env path
  db <- db_create [] env
  db_open [DB_CREATE] DB_HASH 0 db Nothing path Nothing
  result <- comp $ TansuDb { dbGet = bdbGet db
                           , dbSet = bdbSet db
                           , dbDel = bdbDel db
                           , dbRunTransaction = id
                           }
  db_close [] db
  dbEnv_close [] env
  return result