gdritter repos tansu / 6f70696
Added error-reporting mechanism for backends Getty Ritter 8 years ago
4 changed file(s) with 42 addition(s) and 22 deletion(s). Collapse all Expand all
1212 import qualified Data.Map.Strict as M
1313 import Data.Serialize (Serialize, encode)
1414 import Database.Tansu (Tansu)
15 import Database.Tansu.Internal (TansuDb(..))
15 import Database.Tansu.Internal
1616
1717 type Table = M.Map ByteString ByteString
1818
1919 ephemeralRunTransaction :: MVar () -> IO a -> IO a
2020 ephemeralRunTransaction lock comp = withMVar lock $ \ () -> comp
2121
22 ephemeralSet :: IORef Table -> ByteString -> ByteString -> IO ()
23 ephemeralSet table key val = modifyIORef table (M.insert key val)
22 ephemeralSet :: IORef Table -> ByteString -> ByteString -> IO (Either TansuError ())
23 ephemeralSet table key val =
24 fmap return $ modifyIORef table (M.insert key val)
2425
25 ephemeralGet :: IORef Table -> ByteString -> IO (Maybe ByteString)
26 ephemeralGet table key = M.lookup key `fmap` readIORef table
26 ephemeralGet :: IORef Table -> ByteString -> IO (Either TansuError ByteString)
27 ephemeralGet table key = do
28 rs <- M.lookup key `fmap` readIORef table
29 case rs of
30 Just x -> return (return x)
31 Nothing -> return (Left (KeyNotFound key))
2732
28 ephemeralDel :: IORef Table -> ByteString -> IO ()
29 ephemeralDel table key = modifyIORef table (M.delete key)
33 ephemeralDel :: IORef Table -> ByteString -> IO (Either TansuError ())
34 ephemeralDel table key =
35 fmap return $ modifyIORef table (M.delete key)
3036
3137 -- | An 'EphemeralDb' is just an in-memory map, with no way of saving it.
3238 -- It is intended to be used for testing Tansu code.
11 module Database.Tansu.Backend.Filesystem (withFilesystemDb) where
22
3 import Control.Exception
34 import Data.ByteString (ByteString)
45 import Data.ByteString.Base64
56 import qualified Data.ByteString.Char8 as BS
6 import Database.Tansu.Internal (TansuDb(..))
7 import Database.Tansu.Internal
78 import System.Directory ( createDirectoryIfMissing
89 , doesFileExist
910 , removeFile
1112 import System.FileLock (SharedExclusive(Exclusive), withFileLock)
1213 import System.FilePath.Posix ((</>))
1314
14 filePathSet :: FilePath -> ByteString -> ByteString -> IO ()
15 catchIO :: IO a -> IO (Either TansuError a)
16 catchIO mote = fmap return mote `catch` go
17 where go :: IOException -> IO (Either TansuError a)
18 go = return . Left . OtherError . show
19
20 filePathSet :: FilePath -> ByteString -> ByteString -> IO (Either TansuError ())
1521 filePathSet path key val = do
1622 let keyPath = path </> BS.unpack (encode key)
17 BS.writeFile keyPath val
23 catchIO $ BS.writeFile keyPath val
1824
19 filePathGet :: FilePath -> ByteString -> IO (Maybe ByteString)
25 filePathGet :: FilePath -> ByteString -> IO (Either TansuError ByteString)
2026 filePathGet path key = do
2127 let keyPath = path </> BS.unpack (encode key)
2228 exists <- doesFileExist keyPath
2329 if exists
24 then Just `fmap` BS.readFile keyPath
25 else return Nothing
30 then Right `fmap` BS.readFile keyPath
31 else return (Left (KeyNotFound key))
2632
27 filePathDel :: FilePath -> ByteString -> IO ()
33 filePathDel :: FilePath -> ByteString -> IO (Either TansuError ())
2834 filePathDel path key = do
2935 let keyPath = path </> BS.unpack (encode key)
30 removeFile keyPath
36 catchIO $ removeFile keyPath
3137
3238 filePathLock :: FilePath -> IO a -> IO a
3339 filePathLock path comp = do
2424 -- is exposed by the "Database.Tansu.Internal" module so that
2525 -- other libraries can implement new storage backends.
2626 data TansuDb = TansuDb
27 { dbSet :: ByteString -> ByteString -> IO ()
28 , dbGet :: ByteString -> IO (Maybe ByteString)
29 , dbDel :: ByteString -> IO ()
27 { dbSet :: ByteString -> ByteString -> IO (Either TansuError ())
28 , dbGet :: ByteString -> IO (Either TansuError ByteString)
29 , dbDel :: ByteString -> IO (Either TansuError ())
3030 , dbRunTransaction :: forall a. IO a -> IO a
3131 }
4343 instance Monad (Tansu k v) where
4444 Tansu x >>= f = Tansu (x >>= runTansu . f)
4545
46 propagate :: IO (Either TansuError a) -> Tansu k v a
47 propagate mote = do
48 rs <- Tansu $ inBase $ mote
49 case rs of
50 Left err -> Tansu $ raise err
51 Right x -> return x
52
4653 -- | Sets the value for a key to a value.
4754 set :: (Serialize k, Serialize v) => k -> v -> Tansu k v ()
4855 set key val = do
4956 db <- Tansu ask
50 Tansu $ inBase $ dbSet db (encode key) (encode val)
57 propagate $ dbSet db (encode key) (encode val)
5158
5259 -- | Sets the value for a key to a value. A convenience operator
5360 -- that is identical to 'set'.
7380 db <- Tansu ask
7481 result <- Tansu $ inBase $ dbGet db (encode key)
7582 case result of
76 Nothing -> return Nothing
77 Just bs -> case decode bs of
83 Left (KeyNotFound _) -> return Nothing
84 Left err -> Tansu (raise err)
85 Right bs -> case decode bs of
7886 Right val' -> return (Just val')
7987 Left err -> Tansu (raise (DecodeError err))
8088
8189 del :: (Serialize k) => k -> Tansu k v ()
8290 del key = do
8391 db <- Tansu ask
84 Tansu $ inBase $ dbDel db (encode key)
92 propagate $ dbDel db (encode key)
8593
8694 -- | Given a storage backend and a 'Tansu' computation, execute the
8795 -- sequence of 'get' and 'set' commands and produce either the value