Commit 8c3cab23b29108e0b4c29c1968cbdcf8e2cb0919 - tansu

+5

-6

Database/Tansu/Backend/Ephemeral.hs less more

10	10	import Data.IORef
11	11	import Data.Map.Strict (Map)
12	12	import qualified Data.Map.Strict as M
13		import Data.Serialize (Serialize, encode)
14	13	import Database.Tansu (Tansu)
15	14	import Database.Tansu.Internal
16	15
17		type Table = M.Map ByteString ByteString
	16	type Table = Map ByteString ByteString
18	17
19	18	ephemeralRunTransaction :: MVar () -> IO a -> IO a
20	19	ephemeralRunTransaction lock comp = withMVar lock $ \ () -> comp

39	38	newtype EphemeralDb = EDB { fromEDB :: Table }
40	39
41	40	-- \| Create an in-memory table to use for testing.
42		createEphemeralDb :: (Serialize k, Serialize v) => [(k, v)] -> EphemeralDb
43		createEphemeralDb ls = EDB (M.fromList [ (encode k, encode v) \| (k, v) <- ls ])
	41	createEphemeralDb :: [(ByteString, ByteString)] -> EphemeralDb
	42	createEphemeralDb = EDB . M.fromList
44	43
45	44	-- \| Run a 'Tansu' operation with an empty in-memory table.
46		withNewEphemeralDb :: (TansuDb ~~k v~~ -> IO a) -> IO a
	45	withNewEphemeralDb :: (TansuDb -> IO a) -> IO a
47	46	withNewEphemeralDb = withEphemeralDb $ EDB M.empty
48	47
49	48	-- \| Run a 'Tansu' operation with an existing in-memory table.
50		withEphemeralDb :: EphemeralDb -> (TansuDb ~~k v~~ -> IO a) -> IO a
	49	withEphemeralDb :: EphemeralDb -> (TansuDb -> IO a) -> IO a
51	50	withEphemeralDb init comp = do
52	51	lock <- newMVar ()
53	52	table <- newIORef (fromEDB init)

+71

-0

Database/Tansu/Backend/Filesystem/Raw.hs less more

	1	{-# LANGUAGE ViewPatterns #-}
	2
	3	module Database.Tansu.Backend.Filesystem.Raw (withRawFilesystemDb) where
	4
	5	import Control.Exception
	6	import Data.ByteString (ByteString)
	7	import qualified Data.ByteString.Char8 as BS
	8	import Database.Tansu.Internal
	9	import System.Directory ( createDirectoryIfMissing
	10	, doesFileExist
	11	, removeFile
	12	)
	13	import System.FileLock ( SharedExclusive(Exclusive)
	14	, withFileLock
	15	)
	16	import System.FilePath ((</>), isValid)
	17
	18	catchIO :: IO a -> IO (Either TansuError a)
	19	catchIO mote = fmap return mote `catch` go
	20	where go :: IOException -> IO (Either TansuError a)
	21	go = return . Left . OtherError . show
	22
	23	filePathSet :: FilePath -> ByteString -> ByteString -> IO (Either TansuError ())
	24	filePathSet path bsKey val = do
	25	let key = BS.unpack bsKey
	26	keyPath = path </> key
	27	if not (isValid key)
	28	then return (Left (OtherError ("Invalid file name: " ++ key)))
	29	else do
	30	let keyPath = path </> key
	31	catchIO $ BS.writeFile keyPath val
	32
	33	filePathGet :: FilePath -> ByteString -> IO (Either TansuError ByteString)
	34	filePathGet path bsKey = do
	35	let key = BS.unpack bsKey
	36	keyPath = path </> key
	37	if not (isValid key)
	38	then return (Left (OtherError ("Invalid file name: " ++ key)))
	39	else do
	40	exists <- doesFileExist keyPath
	41	if exists
	42	then Right `fmap` BS.readFile keyPath
	43	else return (Left (KeyNotFound bsKey))
	44
	45	filePathDel :: FilePath -> ByteString -> IO (Either TansuError ())
	46	filePathDel path bsKey = do
	47	let key = BS.unpack bsKey
	48	keyPath = path </> key
	49	if not (isValid key)
	50	then return (Left (OtherError ("Invalid file name: " ++ key)))
	51	else catchIO $ removeFile keyPath
	52
	53	filePathLock :: FilePath -> IO a -> IO a
	54	filePathLock path comp = do
	55	withFileLock (path </> ".lock") Exclusive (const comp)
	56
	57	-- \| Use a local directory as a key-value store. Each key-value
	58	-- pair is represented as a file whose filename is the
	59	-- Base64-encoded serialized key, and whose content is the
	60	-- raw serialized value. Locking is done using the
	61	-- @.lock@ file in the specified directory, but note that
	62	-- file locking is not a guaranteed way of ensuring exclusion,
	63	-- and that the files themselves are not locked in any way.
	64	withRawFilesystemDb :: FilePath -> (TansuDb -> IO a) -> IO a
	65	withRawFilesystemDb path comp = do
	66	createDirectoryIfMissing True path
	67	comp $ TansuDb { dbSet = filePathSet path
	68	, dbGet = filePathGet path
	69	, dbDel = filePathDel path
	70	, dbRunTransaction = filePathLock path
	71	}

+1

-1

Database/Tansu/Backend/Filesystem.hs less more

46	46	-- @.lock@ file in the specified directory, but note that
47	47	-- file locking is not a guaranteed way of ensuring exclusion,
48	48	-- and that the files themselves are not locked in any way.
49		withFilesystemDb :: FilePath -> (TansuDb ~~k v~~ -> IO a) -> IO a
	49	withFilesystemDb :: FilePath -> (TansuDb -> IO a) -> IO a
50	50	withFilesystemDb path comp = do
51	51	createDirectoryIfMissing True path
52	52	comp $ TansuDb { dbSet = filePathSet path

+1

-3

Database/Tansu/Internal.hs less more

23	23	-- should treat this as an abstract type, but the full definition
24	24	-- is exposed by the "Database.Tansu.Internal" module so that
25	25	-- other libraries can implement new storage backends.
26		--
27		-- A given instantiation of the database will have
28		data TansuDb ~~k v~~ = TansuDb
	26	data TansuDb = TansuDb
29	27	{ dbSet :: ByteString -> ByteString -> IO (Either TansuError ())
30	28	, dbGet :: ByteString -> IO (Either TansuError ByteString)
31	29	, dbDel :: ByteString -> IO (Either TansuError ())

+20

-51

Database/Tansu.hs less more

16	16
17	17	import Data.ByteString (ByteString)
18	18	import Data.Serialize (Serialize, encode, decode)
19		import MonadLib ( ReaderT
20		, ExceptionT
21		, ask
22		, raise
23		, inBase
24		, runExceptionT
25		, runReaderT
26		)
	19	import MonadLib (raise, try)
	20	import Database.Tansu.Monad
27	21	import Database.Tansu.Internal
28	22
29		type TansuM k v a = ReaderT (TansuDb k v) (ExceptionT TansuError IO) a
	23	newtype Tansu a = Tansu { runTansu :: TansuM a }
30	24
31		-- \| The 'Tansu' type is a monad which represents some sequence
32		-- of 'get' and 'set' operations. Ideally, backends should
33		-- make some guarantee about the atomicity of a given
34		-- 'Tansu' computation, but you should consult the documentation
35		-- about a given backend to make sure that holds.
36		newtype Tansu k v a = Tansu { runTansu :: TansuM k v a }
37
38		instance Functor (Tansu k v) where
	25	instance Functor Tansu where
39	26	fmap f (Tansu t) = Tansu (fmap f t)
40	27
41		instance Applicative ~~(Tansu k v)~~ where
	28	instance Applicative Tansu where
42	29	pure = Tansu . pure
43	30	Tansu f <> Tansu x = Tansu (f <> x)
44	31
45		instance Monad ~~(Tansu k v)~~ where
	32	instance Monad Tansu where
46	33	Tansu x >>= f = Tansu (x >>= runTansu . f)
47	34
48		propagate :: IO (Either TansuError a) -> Tansu k v a
49		propagate mote = do
50		rs <- Tansu $ inBase $ mote
51		case rs of
52		Left err -> Tansu $ raise err
53		Right x -> return x
54
55	35	-- \| Sets the value for a key to a value.
56		set :: (Serialize k, Serialize v) => k -> v -> Tansu k v ()
57		set key val = do
58		db <- Tansu ask
59		propagate $ dbSet db (encode key) (encode val)
	36	set :: ByteString -> ByteString -> Tansu ()
	37	set key val = Tansu $ setInternal key val
60	38
61	39	-- \| Sets the value for a key to a value. A convenience operator
62	40	-- that is identical to 'set'.
63		(=:) :: ~~(Serialize k, Serialize v) => k -> v -> Tansu k v~~ ()
	41	(=:) :: ByteString -> ByteString -> Tansu ()
64	42	(=:) = set
65	43
66	44	-- \| Gets a value for a given key. The resulting 'Tansu' computation
67	45	-- will fail if the key is not present in the storage backend.
68		get :: (Serialize k, Serialize v) => k -> Tansu k v v
69		get key = do
70		result <- getMb key
71		case result of
72		Just val -> return val
73		Nothing -> Tansu (raise (KeyNotFound (encode key)))
	46	get :: ByteString -> Tansu ByteString
	47	get key = Tansu $ getInternal key
74	48
75	49	-- \| Gets a value for a given key. If the key is not present, this
76	50	-- computation will return 'Nothing' instead. Other errors, such
77	51	-- as problems decoding the serialized value or difficulties
78	52	-- communicating with the storage backend, will still cause the
79	53	-- 'Tansu' computation to fail.
80		getMb :: ~~(Serialize k, Serialize v) => k -> Tansu k v (Maybe v~~)
	54	getMb :: ByteString -> Tansu (Maybe ByteString)
81	55	getMb key = do
82		db <- Tansu ask
83		result <- Tansu $ inBase $ dbGet db (encode key)
84		~~case result of~~
	56	rs <- Tansu $ try $ runTansu $ get key
	57	case rs of
85	58	Left (KeyNotFound _) -> return Nothing
86	59	Left err -> Tansu (raise err)
87		Right bs -> case decode bs of
88		Right val' -> return (Just val')
89		~~Left err -> Tansu (raise (DecodeError err)~~)
	60	Right val -> return (Just val)
90	61
91		del :: (Serialize k) => k -> Tansu k v ()
92		del key = do
93		db <- Tansu ask
94		propagate $ dbDel db (encode key)
	62	-- \| Delete a key.
	63	del :: ByteString -> Tansu ()
	64	del key = Tansu $ delInternal key
95	65
96	66	-- \| Given a storage backend and a 'Tansu' computation, execute the
97	67	-- sequence of 'get' and 'set' commands and produce either the value
98	68	-- or the error encountered while running the computation.
99		run :: TansuDb k v -> Tansu k v a -> IO (Either TansuError a)
100		run db (Tansu comp) =
101		~~dbRunTransaction db (runExceptionT (runReaderT db comp)~~)
	69	run :: TansuDb -> Tansu a -> IO (Either TansuError a)
	70	run db (Tansu mote) = runInternal db mote

+20

-19

README.md less more

5	5	in part or in total at any time.
6	6
7	7	The Tansu library is a minimal API for storing and recalling data in
8		key-value storage backends. The Tansu library does not intend to be useful
9		for working with pre-existing data, as it makes assumptions about the
10		formatting of keys and values.
	8	key-value storage backends. It is designed for new applications that
	9	have flexibility in terms of how they store information, as it may
	10	not provide the appropriate tools for working with data in existing
	11	key-value store backends.
11	12
12	13	## Example
13	14

19	20	import Data.Serialize (Serialize)
20	21	import GHC.Generics (Generic)
21	22
22		import Database.Tansu ~~((=:), get, run~~)
	23	import Database.Tansu.Serialize ((=:), get, runS, serialized)
23	24	import Database.Tansu.Backend.Filesystem (withFilesystemDb)
24	25
25	26	data Person = Person { name :: String, age :: Int }
26	27	deriving (Eq, Show, Generic, Serialize)
27	28
28	29	main :: IO ()
29		main = withFilesystemDb "sample.db" $ \ db -> do
30		run db $ do
	30	main = withFilesystemDb "sample.db" $ serialized $ \ db -> do
	31	runS db $ do
31	32	"alex" =: Person "Alex" 33
32	33	"blake" =: Person "Blake" 22
33	34

37	38
38	39	## Use
39	40
40		The Tansu API is very small and simple. All keys and values must implement
41		the `Serialize` typeclass from the
42		[`cereal`](https://hackage.haskell.org/package/cereal)
43		library. No type information is saved in the key-value store, so care must
44		be taken to ensure that the correct types are used in creating a `Tansu`
45		computation.
	41	The `tansu` library exposes two near-identical APIs: the API
	42	in `Database.Tansu` allows you to store and write strict `ByteString`
	43	values, while the API in `Database.Tansu.Serialize` uses the typeclasses
	44	associated with the `cereal` library to allow a wider range of types to
	45	function as keys and values. The two libraries are otherwise very
	46	similar.
46	47
47	48	A value of type `TansuDb` represents a given key-value mapping. The only
48	49	way to interact with a `TansuDb` is by running a `Tansu` command, which

53	54
54	55	~~~.haskell
55	56	-- set a key to a value
56		set :: ~~(Serialize k, Serialize v) => k -> v -> Tansu k v~~ ()
	57	set :: ByteString -> ByteString -> Tansu ()
57	58
58	59	-- infix alias for set
59		(=:) :: ~~(Serialize k, Serialize v) => k -> v -> Tansu k v~~ ()
	60	(=:) :: ByteString -> ByteString -> Tansu ()
60	61
61	62	-- get a value, failing if it does not exist
62		get :: ~~(Serialize k, Serialize v) => k -> Tansu k v v~~
	63	get :: ByteString -> Tansu ByteString
63	64
64	65	-- get a value, returning Nothing if it does not exist
65		getMb :: ~~(Serialize k, Serialize v) => k -> Tansu k v (Maybe v~~)
	66	getMb :: ByteString -> Tansu (Maybe ByteString)
66	67
67	68	-- remove a key and its associated value
68		del :: ~~(Serialize k) => k -> Tansu k v~~ ()
	69	del :: ByteString -> Tansu ()
69	70
70	71	-- run a Tansu computation
71		run :: TansuDb ~~k v -> Tansu k v~~ a -> IO (Either TansuError a)
	72	run :: TansuDb -> Tansu a -> IO (Either TansuError a)
72	73	~~~
73	74
74	75	A value of type `TansuDb` should be supplied by a _backend_, which can

91	92	and the initial plan for the _tansu_ library was for it to be a convenient
92	93	API wrapper over the [Kyoto Cabinet](http://fallabs.com/kyotocabinet/)
93	94	library, but it has since become a generic wrapper over various
94		key-value mapping backends. ~~It is still a kind of storage system.~~
	95	key-value mapping backends.

+11

-5

sample1/Main.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2
1	3	module Main where
2	4
3	5	import Control.Monad (void)
4	6	import Database.Tansu
	7	import Database.Tansu.Backend.Ephemeral
5	8	import Database.Tansu.Backend.Filesystem
6		import Database.Tansu.Backend.~~Ephemeral~~
	9	import Database.Tansu.Backend.Filesystem.Raw
7	10
8	11	main :: IO ()
9	12	main = do
10	13	putStrLn "Testing filesystem db"
11		withFilesystemDb "sample.db" sample
	14	withFilesystemDb "sample-fs.db" sample
	15
	16	putStrLn "Testing raw filesystem db"
	17	withRawFilesystemDb "sample-raw.db" sample
12	18
13	19	putStrLn "Testing ephemeral db"
14	20	withNewEphemeralDb sample
15	21
16		sample :: TansuDb ~~String String~~ -> IO ()
	22	sample :: TansuDb -> IO ()
17	23	sample db = do
18	24	putStrLn "Populating test database"
19	25	run db $ do

25	31	putStr "looking up key 'three': "
26	32	rs <- run db $ get "three"
27	33	case rs of
28		Right val -> p~~utStrLn~~ val
	34	Right val -> print val
29	35	Left _ -> putStrLn "...not in the database."
30	36
31	37	putStr "looking up key 'five': "
32	38	rs <- run db $ get "five"
33	39	case rs of
34		Right val -> p~~utStrLn~~ val
	40	Right val -> print val
35	41	Left _ -> putStrLn "...not in the database."

+26

-5

tansu.cabal less more

6	6	license-file: LICENSE
7	7	author: Getty Ritter
8	8	maintainer: gettylefou@gmail.com
9		-- copyright:
	9	copyright: © 2016 Getty Ritter
10	10	category: Database
11	11	build-type: Simple
12	12	extra-source-files: ChangeLog.md
13	13	cabal-version: >=1.10
14	14
	15	source-repository head
	16	type: git
	17	location: git://github.com/aisamanra/tansu.git
	18
	19	flag build-examples
	20	description: Build example applications
	21	default: False
	22
15	23	library
16	24	exposed-modules: Database.Tansu,
17	25	Database.Tansu.Internal,
18		Database.Tansu.~~RawString~~,
	26	Database.Tansu.Serialize,
	27	Database.Tansu.Backend.Ephemeral,
19	28	Database.Tansu.Backend.Filesystem,
20		Database.Tansu.Backend.~~Ephemeral~~
	29	Database.Tansu.Backend.Filesystem.Raw
	30	other-modules: Database.Tansu.Monad
21	31	build-depends: base >=4.8 && <4.9,
22	32	bytestring,
23	33	cereal,

30	40	filelock
31	41	default-language: Haskell2010
32	42
33		executable sample
	43	executable sample1
	44	if !flag(build-examples)
	45	buildable: False
34	46	main-is: Main.hs
35	47	build-depends: base, tansu
36		hs-source-dirs: sample
	48	hs-source-dirs: sample1
37	49	default-language: Haskell2010
	50
	51
	52	executable sample2
	53	if !flag(build-examples)
	54	buildable: False
	55	main-is: Main.hs
	56	build-depends: base, tansu, cereal
	57	hs-source-dirs: sample2
	58	default-language: Haskell2010