Haddocks for everything!
Getty Ritter
8 years ago
| 1 | 1 | module Database.Tansu.Backend.Ephemeral |
| 2 |
( |
|
| 2 | ( EphemeralDb | |
| 3 | , withEphemeralDb | |
| 4 | , withNewEphemeralDb | |
| 5 | , createEphemeralDb | |
| 6 | ) where | |
| 3 | 7 | |
| 4 | 8 | import Control.Concurrent.MVar |
| 5 | 9 | import Data.ByteString (ByteString) |
| 6 | 10 | import Data.IORef |
| 11 | import Data.Map.Strict (Map) | |
| 7 | 12 | import qualified Data.Map.Strict as M |
| 13 | import Data.Serialize (Serialize, encode) | |
| 14 | import Database.Tansu (Tansu) | |
| 8 | 15 | import Database.Tansu.Internal (TansuDb(..)) |
| 9 | 16 | |
| 10 | 17 | type Table = M.Map ByteString ByteString |
| 18 | 25 | ephemeralGet :: IORef Table -> ByteString -> IO (Maybe ByteString) |
| 19 | 26 | ephemeralGet table key = M.lookup key `fmap` readIORef table |
| 20 | 27 | |
| 21 | withEphemeralDb :: (TansuDb -> IO a) -> IO a | |
| 22 | withEphemeralDb comp = do | |
| 28 | -- | An 'EphemeralDb' is just an in-memory map, with no way of saving it. | |
| 29 | -- It is intended to be used for testing Tansu code. | |
| 30 | newtype EphemeralDb = EDB { fromEDB :: Table } | |
| 31 | ||
| 32 | -- | Create an in-memory table to use for testing. | |
| 33 | createEphemeralDb :: (Serialize k, Serialize v) => [(k, v)] -> EphemeralDb | |
| 34 | createEphemeralDb ls = EDB (M.fromList [ (encode k, encode v) | (k, v) <- ls ]) | |
| 35 | ||
| 36 | -- | Run a 'Tansu' operation with an empty in-memory table. | |
| 37 | withNewEphemeralDb :: (TansuDb -> IO a) -> IO a | |
| 38 | withNewEphemeralDb = withEphemeralDb $ EDB M.empty | |
| 39 | ||
| 40 | -- | Run a 'Tansu' operation with an existing in-memory table. | |
| 41 | withEphemeralDb :: EphemeralDb -> (TansuDb -> IO a) -> IO a | |
| 42 | withEphemeralDb init comp = do | |
| 23 | 43 | lock <- newMVar () |
| 24 |
table <- newIORef |
|
| 44 | table <- newIORef (fromEDB init) | |
| 25 | 45 | comp $ TansuDb |
| 26 | 46 | { dbRunTransaction = ephemeralRunTransaction lock |
| 27 | 47 | , dbSet = ephemeralSet table |
| 25 | 25 | filePathLock path comp = do |
| 26 | 26 | withFileLock (path </> ".lock") Exclusive (const comp) |
| 27 | 27 | |
| 28 | -- | Use a local directory as a key-value store. Each key-value | |
| 29 | -- pair is represented as a file whose filename is the | |
| 30 | -- Base64-encoded serialized key, and whose content is the | |
| 31 | -- raw serialized value. Locking is done using the | |
| 32 | -- @.lock@ file in the specified directory, but note that | |
| 33 | -- file locking is not a guaranteed way of ensuring exclusion, | |
| 34 | -- and that the files themselves are not locked in any way. | |
| 28 | 35 | withFilesystemDb :: FilePath -> (TansuDb -> IO a) -> IO a |
| 29 | 36 | withFilesystemDb path comp = do |
| 30 | 37 | createDirectoryIfMissing True path |
| 6 | 6 | |
| 7 | 7 | import Data.ByteString (ByteString) |
| 8 | 8 | |
| 9 | -- | The 'TansuError' type enumerates the possible errors that | |
| 10 | -- can arise in the process of running a sequence of database | |
| 11 | -- accesses. Backends should attempt to use the most informative | |
| 12 | -- error available, but the 'OtherError' constructor is provided | |
| 13 | -- as a catch-all if none of the other constructors are | |
| 14 | -- descriptive of the error in question. | |
| 9 | 15 | data TansuError |
| 10 | 16 | = KeyNotFound ByteString |
| 11 | 17 | | DecodeError String |
| 18 | | AccessError String | |
| 19 | | OtherError String | |
| 12 | 20 | deriving (Eq, Show) |
| 13 | 21 | |
| 22 | -- | The data representation of a Tansu backend. Users of the library | |
| 23 | -- should treat this as an abstract type, but the full definition | |
| 24 | -- is exposed by the "Database.Tansu.Internal" module so that | |
| 25 | -- other libraries can implement new storage backends. | |
| 14 | 26 | data TansuDb = TansuDb |
| 15 | 27 | { dbSet :: ByteString -> ByteString -> IO () |
| 16 | 28 | , dbGet :: ByteString -> IO (Maybe ByteString) |
| 1 |
module Database.Tansu ( |
|
| 1 | module Database.Tansu ( -- * The 'Tansu' monad | |
| 2 | Tansu | |
| 2 | 3 | , TansuDb |
| 3 | 4 | , TansuError(..) |
| 5 | -- * 'Tansu' Operations | |
| 4 | 6 | , get |
| 5 | 7 | , getMb |
| 6 | 8 | , set |
| 22 | 24 | |
| 23 | 25 | type TansuM a = ReaderT TansuDb (ExceptionT TansuError IO) a |
| 24 | 26 | |
| 27 | -- | The 'Tansu' type is a monad which represents some sequence | |
| 28 | -- of 'get' and 'set' operations. Ideally, backends should | |
| 29 | -- make some guarantee about the atomicity of a given | |
| 30 | -- 'Tansu' computation, but you should consult the documentation | |
| 31 | -- about a given backend to make sure that holds. | |
| 25 | 32 | newtype Tansu a = Tansu { runTansu :: TansuM a } |
| 26 | 33 | |
| 27 | 34 | instance Functor Tansu where |
| 34 | 41 | instance Monad Tansu where |
| 35 | 42 | Tansu x >>= f = Tansu (x >>= runTansu . f) |
| 36 | 43 | |
| 44 | -- | Sets the value for a key to a value. | |
| 37 | 45 | set :: (Serialize k, Serialize v) => k -> v -> Tansu () |
| 38 | 46 | set key val = do |
| 39 | 47 | db <- Tansu ask |
| 40 | 48 | Tansu $ inBase $ dbSet db (encode key) (encode val) |
| 41 | 49 | |
| 50 | -- | Sets the value for a key to a value. A convenience operator | |
| 51 | -- that is identical to 'set'. | |
| 42 | 52 | (=:) :: (Serialize k, Serialize v) => k -> v -> Tansu () |
| 43 | 53 | (=:) = set |
| 44 | 54 | |
| 55 | -- | Gets a value for a given key. The resulting 'Tansu' computation | |
| 56 | -- will fail if the key is not present in the storage backend. | |
| 45 | 57 | get :: (Serialize k, Serialize v) => k -> Tansu v |
| 46 | 58 | get key = do |
| 47 | 59 | result <- getMb key |
| 49 | 61 | Just val -> return val |
| 50 | 62 | Nothing -> Tansu (raise (KeyNotFound (encode key))) |
| 51 | 63 | |
| 64 | -- | Gets a value for a given key. If the key is not present, this | |
| 65 | -- computation will return 'Nothing' instead. Other errors, such | |
| 66 | -- as problems decoding the serialized value or difficulties | |
| 67 | -- communicating with the storage backend, will still cause the | |
| 68 | -- 'Tansu' computation to fail. | |
| 52 | 69 | getMb :: (Serialize k, Serialize v) => k -> Tansu (Maybe v) |
| 53 | 70 | getMb key = do |
| 54 | 71 | db <- Tansu ask |
| 59 | 76 | Right val' -> return (Just val') |
| 60 | 77 | Left err -> Tansu (raise (DecodeError err)) |
| 61 | 78 | |
| 79 | -- | Given a storage backend and a 'Tansu' computation, execute the | |
| 80 | -- sequence of 'get' and 'set' commands and produce either the value | |
| 81 | -- or the error encountered while running the computation. | |
| 62 | 82 | run :: TansuDb -> Tansu a -> IO (Either TansuError a) |
| 63 | 83 | run db (Tansu comp) = |
| 64 | 84 | dbRunTransaction db (runExceptionT (runReaderT db comp)) |