Reflected key/value types into Tansu monad type
Getty Ritter
8 years ago
31 | 31 | -- make some guarantee about the atomicity of a given |
32 | 32 | -- 'Tansu' computation, but you should consult the documentation |
33 | 33 | -- about a given backend to make sure that holds. |
34 |
newtype Tansu |
|
34 | newtype Tansu k v a = Tansu { runTansu :: TansuM a } | |
35 | 35 | |
36 |
instance Functor |
|
36 | instance Functor (Tansu k v) where | |
37 | 37 | fmap f (Tansu t) = Tansu (fmap f t) |
38 | 38 | |
39 |
instance Applicative |
|
39 | instance Applicative (Tansu k v) where | |
40 | 40 | pure = Tansu . pure |
41 | 41 | Tansu f <*> Tansu x = Tansu (f <*> x) |
42 | 42 | |
43 |
instance Monad |
|
43 | instance Monad (Tansu k v) where | |
44 | 44 | Tansu x >>= f = Tansu (x >>= runTansu . f) |
45 | 45 | |
46 | 46 | -- | Sets the value for a key to a value. |
47 |
set :: (Serialize k, Serialize v) => k -> v -> Tansu |
|
47 | set :: (Serialize k, Serialize v) => k -> v -> Tansu k v () | |
48 | 48 | set key val = do |
49 | 49 | db <- Tansu ask |
50 | 50 | Tansu $ inBase $ dbSet db (encode key) (encode val) |
51 | 51 | |
52 | 52 | -- | Sets the value for a key to a value. A convenience operator |
53 | 53 | -- that is identical to 'set'. |
54 |
(=:) :: (Serialize k, Serialize v) => k -> v -> Tansu |
|
54 | (=:) :: (Serialize k, Serialize v) => k -> v -> Tansu k v () | |
55 | 55 | (=:) = set |
56 | 56 | |
57 | 57 | -- | Gets a value for a given key. The resulting 'Tansu' computation |
58 | 58 | -- will fail if the key is not present in the storage backend. |
59 |
get :: (Serialize k, Serialize v) => k -> Tansu |
|
59 | get :: (Serialize k, Serialize v) => k -> Tansu k v v | |
60 | 60 | get key = do |
61 | 61 | result <- getMb key |
62 | 62 | case result of |
68 | 68 | -- as problems decoding the serialized value or difficulties |
69 | 69 | -- communicating with the storage backend, will still cause the |
70 | 70 | -- 'Tansu' computation to fail. |
71 |
getMb :: (Serialize k, Serialize v) => k -> Tansu |
|
71 | getMb :: (Serialize k, Serialize v) => k -> Tansu k v (Maybe v) | |
72 | 72 | getMb key = do |
73 | 73 | db <- Tansu ask |
74 | 74 | result <- Tansu $ inBase $ dbGet db (encode key) |
78 | 78 | Right val' -> return (Just val') |
79 | 79 | Left err -> Tansu (raise (DecodeError err)) |
80 | 80 | |
81 |
del :: (Serialize k) => k -> Tansu |
|
81 | del :: (Serialize k) => k -> Tansu k v () | |
82 | 82 | del key = do |
83 | 83 | db <- Tansu ask |
84 | 84 | Tansu $ inBase $ dbDel db (encode key) |
86 | 86 | -- | Given a storage backend and a 'Tansu' computation, execute the |
87 | 87 | -- sequence of 'get' and 'set' commands and produce either the value |
88 | 88 | -- or the error encountered while running the computation. |
89 |
run :: TansuDb -> Tansu |
|
89 | run :: TansuDb -> Tansu k v a -> IO (Either TansuError a) | |
90 | 90 | run db (Tansu comp) = |
91 | 91 | dbRunTransaction db (runExceptionT (runReaderT db comp)) |
28 | 28 | main :: IO () |
29 | 29 | main = withFilesystemDb "sample.db" $ \ db -> do |
30 | 30 | run db $ do |
31 | "alex" =: Person "alex" 33 | |
32 | "blake" =: Person "blake" 22 | |
31 | "alex" =: Person "Alex" 33 | |
32 | "blake" =: Person "Blake" 22 | |
33 | 33 | |
34 | 34 | Right age <- run db (age `fmap` get "blake") |
35 | 35 | putStrLn $ "Blake's age is " ++ show age |
41 | 41 | the `Serialize` typeclass from the |
42 | 42 | [`cereal`](https://hackage.haskell.org/package/cereal) |
43 | 43 | library. No type information is saved in the key-value store, so care must |
44 | be taken to ensure that the correct deserializer is being used when a value | |
45 | is extracted from the backing store. | |
44 | be taken to ensure that the correct types are used in creating a `Tansu` | |
45 | computation. | |
46 | 46 | |
47 | 47 | A value of type `TansuDb` represents a given key-value mapping. The only |
48 | 48 | way to interact with a `TansuDb` is by running a `Tansu` command, which |
53 | 53 | |
54 | 54 | ~~~.haskell |
55 | 55 | -- set a key to a value |
56 |
set :: (Serialize k, Serialize v) => k -> v -> Tansu |
|
56 | set :: (Serialize k, Serialize v) => k -> v -> Tansu k v () | |
57 | 57 | |
58 | 58 | -- infix alias for set |
59 |
(=:) :: (Serialize k, Serialize v) => k -> v -> Tansu |
|
59 | (=:) :: (Serialize k, Serialize v) => k -> v -> Tansu k v () | |
60 | 60 | |
61 | 61 | -- get a value, failing if it does not exist |
62 |
get :: (Serialize k, Serialize v) => k -> Tansu |
|
62 | get :: (Serialize k, Serialize v) => k -> Tansu k v v | |
63 | 63 | |
64 | 64 | -- get a value, returning Nothing if it does not exist |
65 |
getMb :: (Serialize k, Serialize v) => k -> Tansu |
|
65 | getMb :: (Serialize k, Serialize v) => k -> Tansu k v (Maybe v) | |
66 | 66 | |
67 | 67 | -- remove a key and its associated value |
68 |
del :: (Serialize k) => k -> Tansu |
|
68 | del :: (Serialize k) => k -> Tansu k v () | |
69 | 69 | |
70 | 70 | -- run a Tansu computation |
71 |
run :: TansuDb -> Tansu |
|
71 | run :: TansuDb -> Tansu k v a -> IO (Either TansuError a) | |
72 | 72 | ~~~ |
73 | 73 | |
74 | 74 | A value of type `TansuDb` should be supplied by a _backend_, which can |