git.iko.soy/rowtype-yoga/purescript-vault
on master help sign in
Improved test suite, bugfix, and new `adjust` function
78dece8Nick Saunders
src/Data/Vault.purs+6−1
compare with master
unifiedsplit
@@ -1,6 +1,7 @@
1module Data.Vault
1module Data.Vault
2 ( Vault
2 ( Vault
3 , Key
3 , Key
4+ , adjust
4 , empty
5 , empty
5 , newKey
6 , newKey
6 , insert
7 , insert
@@ -17,7 +18,7 @@ import Effect.Ref (Ref)
17import Effect.Ref as Ref
18import Effect.Ref as Ref
18
19
19import Data.Function.Uncurried as Fn
20import Data.Function.Uncurried as Fn
20−import Data.Maybe (Maybe(..))
21+import Data.Maybe (Maybe(..), fromMaybe)
21import Data.Vault.Internal as V
22import Data.Vault.Internal as V
22
23
23-- | A persistent store for values of arbitrary types.
24-- | A persistent store for values of arbitrary types.
@@ -45,6 +46,10 @@ newKey = do
45insert :: forall a. Key a -> a -> Vault -> Vault
46insert :: forall a. Key a -> a -> Vault -> Vault
46insert (Key k ref) a (Vault m) = Vault (Fn.runFn3 V.insert k (Ref.write (Just a) ref) m)
47insert (Key k ref) a (Vault m) = Vault (Fn.runFn3 V.insert k (Ref.write (Just a) ref) m)
47
48
49+-- | Modify the value corresponding to the specified key by applying the specified function.
50+adjust :: forall a. (a -> a) -> Key a -> Vault -> Vault
51+adjust f k m = fromMaybe m $ lookup k m >>= \x -> pure $ insert k (f x) m
52+
48-- | Delete a key from the vault.
53-- | Delete a key from the vault.
49delete :: forall a. Key a -> Vault -> Vault
54delete :: forall a. Key a -> Vault -> Vault
50delete (Key k _) (Vault m) = Vault (Fn.runFn2 V.delete k m)
55delete (Key k _) (Vault m) = Vault (Fn.runFn2 V.delete k m)
src/Data/Vault/Internal.js+1−1
@@ -43,7 +43,7 @@ export function union(m, n) {
43 }
43 }
44 var k2 = Object.getOwnPropertySymbols(m);
44 var k2 = Object.getOwnPropertySymbols(m);
45 for (var j = 0, length = k2.length; j < length; j++) {
45 for (var j = 0, length = k2.length; j < length; j++) {
46− result[k2[j]] = n[k2[j]];
46+ result[k2[j]] = m[k2[j]];
47 }
47 }
48 return result;
48 return result;
49}
49}
test.dhall+2−2
@@ -2,5 +2,5 @@ let conf = ./spago.dhall
2
2
3in conf // {
3in conf // {
4 sources = conf.sources # ["test/**/*.purs"],
4 sources = conf.sources # ["test/**/*.purs"],
5− dependencies = conf.dependencies # ["console"]
5+ dependencies = conf.dependencies # ["aff", "console", "spec"]
6−}
6+}
test/Main.purs+73−34
@@ -1,41 +1,80 @@
1module Test.Main where
1module Test.Main where
2
2
3import Prelude
3import Prelude
4−import Effect (Effect)
5−import Effect.Console (log)
6
4
7−import Data.Vault as V
8import Data.Maybe (Maybe(..))
5import Data.Maybe (Maybe(..))
9−
6+import Data.Vault as Vault
10−itemKeyInt :: Effect (V.Key Int)
7+import Effect (Effect)
11−itemKeyInt = V.newKey
8+import Effect.Aff (launchAff_)
12−
9+import Effect.Class (liftEffect)
13−itemKeyString :: Effect (V.Key String)
10+import Test.Spec (describe, it)
14−itemKeyString = V.newKey
11+import Test.Spec.Assertions (shouldEqual)
15−
12+import Test.Spec.Reporter (consoleReporter)
16−testCreateAndGet :: Effect Unit
13+import Test.Spec.Runner (runSpec)
17−testCreateAndGet = do
18− k1 <- itemKeyString
19− k2 <- itemKeyInt
20− let m1 = V.insert k1 "vault" V.empty
21− v1 = V.lookup k1 m1
22− v2 = V.lookup k2 m1
23− when (v1 /= Just "vault") (log "Failed getting value from Vault")
24− when (v2 /= Nothing) (log "Non existing value should return Nothing")
25−
26−testCreateAndDelete :: Effect Unit
27−testCreateAndDelete = do
28− k <- itemKeyInt
29− let m1 = V.insert k 1 V.empty
30− v1 = V.lookup k m1
31− m2 = V.delete k m1
32− v2 = V.lookup k m2
33− when (v1 == v2) $ log "Deleted item should return Nothing"
34
14
35main :: Effect Unit
15main :: Effect Unit
36−main = do
16+main =
37− log "Create new Vault Item"
17+ launchAff_ $
38− testCreateAndGet
18+ runSpec [ consoleReporter ] do
39−
19+ it "inserts an item" do
40− log "Crate new Vault Item and Delete"
20+ let s0 = Vault.empty
41− testCreateAndDelete
21+ k <- liftEffect Vault.newKey
22+ let
23+ v = { foo: 1 }
24+ s1 = Vault.insert k v s0
25+ Vault.lookup k s1 `shouldEqual` pure v
26+ it "adjusts an item" do
27+ let s0 = Vault.empty
28+ k <- liftEffect Vault.newKey
29+ let
30+ v0 = { foo: 1 }
31+ s1 = Vault.insert k v0 s0
32+ s2 = Vault.adjust (\r -> r { foo = r.foo + 1 }) k s1
33+ Vault.lookup k s2 `shouldEqual` pure { foo: 2 }
34+ it "deletes an item" do
35+ let s0 = Vault.empty
36+ k <- liftEffect Vault.newKey
37+ let
38+ s1 = Vault.insert k 1 s0
39+ s2 = Vault.delete k s1
40+ Vault.lookup k s2 `shouldEqual` Nothing
41+ it "merges two vaults" do
42+ k <- liftEffect Vault.newKey
43+ l <- liftEffect Vault.newKey
44+ let
45+ a = Vault.insert k 1 Vault.empty
46+ b = Vault.empty # Vault.insert k 2 # Vault.insert l 3
47+ c = Vault.union a b
48+ Vault.lookup k c `shouldEqual` pure 1
49+ Vault.lookup l c `shouldEqual` pure 3
50+ describe "on insert" do
51+ it "does not affect other items" do
52+ k <- liftEffect Vault.newKey
53+ let
54+ s0 = Vault.empty
55+ s1 = Vault.insert k "foo" s0
56+ k' <- liftEffect Vault.newKey
57+ let s2 = Vault.insert k' 3 s1
58+ Vault.lookup k s2 `shouldEqual` pure "foo"
59+ describe "on adjust" do
60+ it "does not affect other items" do
61+ k <- liftEffect Vault.newKey
62+ let
63+ s0 = Vault.empty
64+ s1 = Vault.insert k "foo" s0
65+ k' <- liftEffect Vault.newKey
66+ let
67+ s2 = Vault.insert k' "hi" s1
68+ s3 = Vault.adjust (_ <> "!") k' s2
69+ Vault.lookup k s3 `shouldEqual` pure "foo"
70+ describe "on delete" do
71+ it "does not affect other items" do
72+ k <- liftEffect Vault.newKey
73+ let
74+ s0 = Vault.empty
75+ s1 = Vault.insert k "foo" s0
76+ k' <- liftEffect Vault.newKey
77+ let
78+ s2 = Vault.insert k' "hi" s1
79+ s3 = Vault.delete k' s2
80+ Vault.lookup k s3 `shouldEqual` pure "foo"