Updated bdb backend for new tansu backend API
Getty Ritter
8 years ago
1 | 1 | module Database.Tansu.Backend.BerkeleyDb |
2 | 2 | (withBerkeleyDb) where |
3 | 3 | |
4 | import Control.Exception (catch) | |
4 | 5 | import Database.Berkeley.Db |
5 | 6 | import Data.ByteString (ByteString) |
6 | 7 | import System.Directory (createDirectoryIfMissing) |
7 | 8 | |
8 |
import Database.Tansu.Internal |
|
9 | import Database.Tansu.Internal | |
9 | 10 | |
10 |
|
|
11 | catchIO :: IO a -> IO (Either TansuError a) | |
12 | catchIO mote = fmap return mote `catch` go | |
13 | where go :: DbException -> IO (Either TansuError a) | |
14 | go = return . Left . OtherError . show | |
15 | ||
16 | bdbSet :: Db -> ByteString -> ByteString -> IO (Either TansuError ()) | |
11 | 17 | bdbSet db key val = |
12 |
|
|
18 | catchIO $ db_put [] db Nothing key val | |
13 | 19 | |
14 | bdbGet :: Db -> ByteString -> IO (Maybe ByteString) | |
15 | bdbGet db key = | |
16 | db_get [] db Nothing key | |
20 | bdbGet :: Db -> ByteString -> IO (Either TansuError ByteString) | |
21 | bdbGet db key = do | |
22 | rs <- catchIO $ db_get [] db Nothing key | |
23 | case rs of | |
24 | Right Nothing -> return (Left (KeyNotFound key)) | |
25 | Right (Just x) -> return (return x) | |
26 | Left err -> return (Left err) | |
17 | 27 | |
18 |
bdbDel :: Db -> ByteString -> IO ( |
|
28 | bdbDel :: Db -> ByteString -> IO (Either TansuError ()) | |
19 | 29 | bdbDel db key = |
20 |
|
|
30 | catchIO $ db_del [] db Nothing key | |
21 | 31 | |
22 | 32 | -- | Open or create a database at the supplied path |
23 | -- using the BerkeleyDB library. | |
24 | withBerkeleyDb :: FilePath -> (TansuDb -> IO a) -> IO a | |
33 | -- using the BerkeleyDB library. Right now, this uses | |
34 | -- a consistent set of options, but probably should | |
35 | -- become configurable at some point. | |
36 | withBerkeleyDb :: FilePath -> (TansuDb k v -> IO a) -> IO a | |
25 | 37 | withBerkeleyDb path comp = do |
26 | 38 | createDirectoryIfMissing True path |
27 | 39 | env <- dbEnv_create [] |