git.iko.soy/rowtype-yoga/purescript-vault
on master help sign in
initial commit
ff9fe2cJulien Chandra
.gitignorenew file+8
compare with master
unifiedsplit
@@ -0,0 +1,8 @@
1+/bower_components/
2+/node_modules/
3+/.pulp-cache/
4+/output/
5+/generated-docs/
6+/.psc*
7+/.purs*
8+/.psa*
bower.jsonnew file+18
@@ -0,0 +1,18 @@
1+{
2+ "name": "purescript-vault",
3+ "ignore": [
4+ "**/.*",
5+ "node_modules",
6+ "bower_components",
7+ "output"
8+ ],
9+ "dependencies": {
10+ "purescript-prelude": "^3.1.0",
11+ "purescript-maps": "^3.5.1",
12+ "purescript-refs": "^3.0.0"
13+ },
14+ "devDependencies": {
15+ "purescript-psci-support": "^3.0.0",
16+ "purescript-console": "^3.0.0"
17+ }
18+}
src/Data/Vault.pursnew file+65
@@ -0,0 +1,65 @@
1+module Data.Vault
2+ ( Vault
3+ , Key
4+ , empty
5+ , newKey
6+ , insert
7+ , lookup
8+ , delete
9+ ) where
10+
11+import Prelude
12+
13+import Control.Monad.Eff (Eff)
14+import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
15+import Control.Monad.Eff.Ref (REF, Ref, newRef, writeRef, modifyRef')
16+
17+import Data.Map as M
18+import Data.Maybe (Maybe(..))
19+import Data.Newtype (class Newtype, over)
20+import Data.Vault.Internal (Unique, newUnique)
21+
22+newtype Vault = Vault (M.Map Unique Item)
23+
24+data Key a = Key Unique (Item' a)
25+
26+type Item = Eff (ref :: REF) Unit
27+
28+type Item' a = Ref (Maybe a)
29+
30+-- | The empty vault
31+empty :: Vault
32+empty = Vault M.empty
33+
34+newKey :: forall eff a. Eff (ref :: REF | eff) (Key a)
35+newKey = do
36+ k <- newUnique
37+ ref <- newRef Nothing
38+ pure $ Key k ref
39+
40+insert :: forall a. Key a -> a -> Vault -> Vault
41+insert (Key k ref) a = over Vault $ M.insert k (writeRef ref (Just a))
42+
43+delete :: forall a. Key a -> Vault -> Vault
44+delete (Key k _) = over Vault $ M.delete k
45+
46+lookup :: forall eff a. Key a -> Vault -> Eff (ref :: REF | eff) (Maybe a)
47+lookup (Key k ref) (Vault m) = case M.lookup k m of
48+ Nothing -> pure Nothing
49+ Just act -> do
50+ _ <- coerceVaultItem act
51+ modifyRef' ref rollItem
52+
53+coerceVaultItem :: forall eff a. Eff (ref :: REF) a -> Eff (ref :: REF | eff) a
54+coerceVaultItem = unsafeCoerceEff
55+
56+rollItem :: forall a. Maybe a -> { state :: Maybe a, value :: Maybe a }
57+rollItem a = { state: Nothing, value: a }
58+
59+derive instance newtypeVault :: Newtype Vault _
60+
61+instance eqKey :: Eq (Key a) where
62+ eq (Key a _) (Key b _) = a == b
63+
64+instance ordKey :: Ord (Key a) where
65+ compare (Key a _) (Key b _) = compare a b
src/Data/Vault/Internal.pursnew file+27
@@ -0,0 +1,27 @@
1+module Data.Vault.Internal
2+ ( Unique
3+ , newUnique
4+ ) where
5+
6+import Prelude
7+
8+import Control.Monad.Eff (Eff)
9+import Control.Monad.Eff.Unsafe (unsafePerformEff)
10+import Control.Monad.Eff.Ref (REF, Ref, newRef, modifyRef')
11+
12+-- | Store as Number, so it can handle 53-bit signed integer
13+newtype Unique = Unique Number
14+
15+derive newtype instance eqUnique :: Eq Unique
16+derive newtype instance ordUnique :: Ord Unique
17+
18+uniqueSource :: Ref Number
19+uniqueSource = unsafePerformEff $ newRef 0.00
20+
21+incrementSource :: Number -> { state :: Number, value :: Number }
22+incrementSource x = { state: x + one, value: x}
23+
24+newUnique :: forall eff. Eff (ref :: REF | eff) Unique
25+newUnique = do
26+ r <- modifyRef' uniqueSource incrementSource
27+ pure $ Unique r
test/Main.pursnew file+43
@@ -0,0 +1,43 @@
1+module Test.Main where
2+
3+import Prelude
4+import Control.Monad.Eff (Eff)
5+import Control.Monad.Eff.Console (CONSOLE, log)
6+import Control.Monad.Eff.Ref (REF)
7+
8+import Data.Vault as V
9+import Data.Maybe (Maybe(..))
10+
11+itemKeyInt :: forall eff. Eff (ref :: REF | eff) (V.Key Int)
12+itemKeyInt = V.newKey
13+
14+itemKeyString :: forall eff. Eff (ref :: REF | eff) (V.Key String)
15+itemKeyString = V.newKey
16+
17+testCreateAndGet :: forall eff. Eff (console :: CONSOLE, ref :: REF | eff) Unit
18+testCreateAndGet = do
19+ k1 <- itemKeyString
20+ k2 <- itemKeyInt
21+ let m1 = V.insert k1 "vault" V.empty
22+ v1 <- V.lookup k1 m1
23+ when (v1 /= Just "vault") (log "Failed getting value from Vault")
24+ v2 <- V.lookup k2 m1
25+ when (v2 /= Nothing) (log "Non existing value should return Nothing")
26+
27+testCreateAndDelete :: forall eff. Eff (console :: CONSOLE, ref :: REF | eff) Unit
28+testCreateAndDelete = do
29+ k <- itemKeyInt
30+ let m1 = V.insert k 1 V.empty
31+ v1 <- V.lookup k m1
32+ let m2 = V.delete k m1
33+ v2 <- V.lookup k m2
34+ when (v1 == v2) do
35+ log "Deleted item should return Nothing"
36+
37+main :: forall eff. Eff (console :: CONSOLE, ref :: REF | eff) Unit
38+main = do
39+ log "Create new Vault Item"
40+ testCreateAndGet
41+
42+ log "Crate new Vault Item and Delete"
43+ testCreateAndDelete