Commit 6f70696a124c07273e5dcea7c12f912790624e35 - tansu

+13

-7

Database/Tansu/Backend/Ephemeral.hs less more

12	12	import qualified Data.Map.Strict as M
13	13	import Data.Serialize (Serialize, encode)
14	14	import Database.Tansu (Tansu)
15		import Database.Tansu.Internal ~~(TansuDb(..))~~
	15	import Database.Tansu.Internal
16	16
17	17	type Table = M.Map ByteString ByteString
18	18
19	19	ephemeralRunTransaction :: MVar () -> IO a -> IO a
20	20	ephemeralRunTransaction lock comp = withMVar lock $ \ () -> comp
21	21
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)
24	25
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))
27	32
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)
30	36
31	37	-- \| An 'EphemeralDb' is just an in-memory map, with no way of saving it.
32	38	-- It is intended to be used for testing Tansu code.

+14

-8

Database/Tansu/Backend/Filesystem.hs less more

1	1	module Database.Tansu.Backend.Filesystem (withFilesystemDb) where
2	2
	3	import Control.Exception
3	4	import Data.ByteString (ByteString)
4	5	import Data.ByteString.Base64
5	6	import qualified Data.ByteString.Char8 as BS
6		import Database.Tansu.Internal ~~(TansuDb(..))~~
	7	import Database.Tansu.Internal
7	8	import System.Directory ( createDirectoryIfMissing
8	9	, doesFileExist
9	10	, removeFile

11	12	import System.FileLock (SharedExclusive(Exclusive), withFileLock)
12	13	import System.FilePath.Posix ((</>))
13	14
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 ())
15	21	filePathSet path key val = do
16	22	let keyPath = path </> BS.unpack (encode key)
17		BS.writeFile keyPath val
	23	catchIO $ BS.writeFile keyPath val
18	24
19		filePathGet :: FilePath -> ByteString -> IO (~~Maybe~~ ByteString)
	25	filePathGet :: FilePath -> ByteString -> IO (Either TansuError ByteString)
20	26	filePathGet path key = do
21	27	let keyPath = path </> BS.unpack (encode key)
22	28	exists <- doesFileExist keyPath
23	29	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))
26	32
27		filePathDel :: FilePath -> ByteString -> IO ()
	33	filePathDel :: FilePath -> ByteString -> IO (Either TansuError ())
28	34	filePathDel path key = do
29	35	let keyPath = path </> BS.unpack (encode key)
30		removeFile keyPath
	36	catchIO $ removeFile keyPath
31	37
32	38	filePathLock :: FilePath -> IO a -> IO a
33	39	filePathLock path comp = do

+3

-3

Database/Tansu/Internal.hs less more

24	24	-- is exposed by the "Database.Tansu.Internal" module so that
25	25	-- other libraries can implement new storage backends.
26	26	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 ())
30	30	, dbRunTransaction :: forall a. IO a -> IO a
31	31	}

+12

-4

Database/Tansu.hs less more

43	43	instance Monad (Tansu k v) where
44	44	Tansu x >>= f = Tansu (x >>= runTansu . f)
45	45
	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
46	53	-- \| Sets the value for a key to a value.
47	54	set :: (Serialize k, Serialize v) => k -> v -> Tansu k v ()
48	55	set key val = do
49	56	db <- Tansu ask
50		~~Tansu $ inBas~~e $ dbSet db (encode key) (encode val)
	57	propagate $ dbSet db (encode key) (encode val)
51	58
52	59	-- \| Sets the value for a key to a value. A convenience operator
53	60	-- that is identical to 'set'.

73	80	db <- Tansu ask
74	81	result <- Tansu $ inBase $ dbGet db (encode key)
75	82	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
78	86	Right val' -> return (Just val')
79	87	Left err -> Tansu (raise (DecodeError err))
80	88
81	89	del :: (Serialize k) => k -> Tansu k v ()
82	90	del key = do
83	91	db <- Tansu ask
84		~~Tansu $ inBas~~e $ dbDel db (encode key)
	92	propagate $ dbDel db (encode key)
85	93
86	94	-- \| Given a storage backend and a 'Tansu' computation, execute the
87	95	-- sequence of 'get' and 'set' commands and produce either the value