diff options
| author | Marc Sunet <jeannekamikaze@gmail.com> | 2012-08-09 13:32:25 +0200 |
|---|---|---|
| committer | Marc Sunet <jeannekamikaze@gmail.com> | 2012-08-09 13:32:25 +0200 |
| commit | 741f99212e6521c1dd4c2e62012028fc17d52ff1 (patch) | |
| tree | abab6e467cd49314527442146208849b342962c0 | |
| parent | 7848936cc460da48173bee59ff8b882be3dacd0e (diff) | |
Added withElement, setElement, and made Store a Functor
| -rw-r--r-- | Spear/Sys/Store.hs | 21 |
1 files changed, 21 insertions, 0 deletions
diff --git a/Spear/Sys/Store.hs b/Spear/Sys/Store.hs index 65381ca..3c1e720 100644 --- a/Spear/Sys/Store.hs +++ b/Spear/Sys/Store.hs | |||
| @@ -8,6 +8,8 @@ module Spear.Sys.Store | |||
| 8 | , storeFree | 8 | , storeFree |
| 9 | , storeFreel | 9 | , storeFreel |
| 10 | , element | 10 | , element |
| 11 | , setElement | ||
| 12 | , withElement | ||
| 11 | ) | 13 | ) |
| 12 | where | 14 | where |
| 13 | 15 | ||
| @@ -29,6 +31,10 @@ data Store a = Store | |||
| 29 | deriving Show | 31 | deriving Show |
| 30 | 32 | ||
| 31 | 33 | ||
| 34 | instance Functor Store where | ||
| 35 | fmap f (Store objects last) = Store (fmap (fmap f) objects) last | ||
| 36 | |||
| 37 | |||
| 32 | -- | Create an empty store. | 38 | -- | Create an empty store. |
| 33 | emptyStore :: Store a | 39 | emptyStore :: Store a |
| 34 | emptyStore = Store V.empty (-1) | 40 | emptyStore = Store V.empty (-1) |
| @@ -135,6 +141,21 @@ element :: Index -> Store a -> Maybe a | |||
| 135 | element index (Store objects _) = objects V.! index | 141 | element index (Store objects _) = objects V.! index |
| 136 | 142 | ||
| 137 | 143 | ||
| 144 | -- | Set the element in the given slot. | ||
| 145 | setElement :: Index -> a -> Store a -> Store a | ||
| 146 | setElement index elem s = s { objects = objects s // [(index,Just elem)] } | ||
| 147 | |||
| 148 | |||
| 149 | -- | Apply a function to the element in the given slot. | ||
| 150 | withElement :: Index -> Store a -> (a -> a) -> Store a | ||
| 151 | withElement index store f = store { objects = objects' } | ||
| 152 | where | ||
| 153 | objects' = objects store // [(index, obj')] | ||
| 154 | obj' = case element index store of | ||
| 155 | Nothing -> Nothing | ||
| 156 | Just x -> Just $ f x | ||
| 157 | |||
| 158 | |||
| 138 | -- test | 159 | -- test |
| 139 | test :: IO () | 160 | test :: IO () |
| 140 | test = evalStateT test' emptyStore | 161 | test = evalStateT test' emptyStore |
