@@ -2,997 +2,1060 @@ module Test.Main where
22
33import Prelude
44
5−import Control.Monad.Aff (Aff, launchAff, forkAff, delay, attempt)
6−import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', modifyVar, peekVar, putVar, takeVar)
7−import Control.Monad.Aff.Console (log)
8−import Control.Monad.Eff (Eff)
9−import Control.Monad.Eff.Class (liftEff)
10−import Control.Monad.Eff.Exception (EXCEPTION, name)
11−import Control.Monad.Eff.Now (NOW, now)
12−import Data.Date as Date
13−import Data.DateTime as DateTime
14−import Data.DateTime (DateTime(..), Time(..))
15−import Data.DateTime.Instant (toDateTime)
16−import Data.Either (Either(..))
17−import Data.Enum (toEnum)
18−import Data.Maybe (Maybe(..), isNothing, maybe)
19−import Data.Array (head, drop)
20−import Data.Time.Duration (Milliseconds(..))
21−import Data.Traversable (traverse)
22−import Data.Tuple (Tuple(..), uncurry)
23−import Test.Spec (describe, describeOnly, it)
24−import Test.Spec.Assertions (shouldEqual, fail)
25−import Test.Spec.Mocha (MOCHA, runMocha)
26−
27−import Database.IndexedDB.Core
28−import Database.IndexedDB.IDBKey
29−import Database.IndexedDB.IDBCursor as IDBCursor
30−import Database.IndexedDB.IDBDatabase as IDBDatabase
31−import Database.IndexedDB.IDBFactory as IDBFactory
32−import Database.IndexedDB.IDBIndex as IDBIndex
33−import Database.IndexedDB.IDBKeyRange as IDBKeyRange
34−import Database.IndexedDB.IDBObjectStore as IDBObjectStore
35−import Database.IndexedDB.IDBTransaction as IDBTransaction
36−
5+import Data.Array (head, drop)
6+import Data.Date as Date
7+import Data.DateTime (DateTime(..), Time(..))
8+import Data.DateTime.Instant (toDateTime)
9+import Data.Either (Either(..))
10+import Data.Enum (toEnum)
11+import Data.Maybe (Maybe(..), isNothing, maybe)
12+import Data.Time.Duration (Milliseconds(..))
13+import Data.Traversable (traverse)
14+import Data.Tuple (Tuple(..), uncurry)
15+import Database.IndexedDB.Core (CursorDirection(..), Database, Index, ObjectStore, Transaction, TransactionMode(..))
16+import Database.IndexedDB.IDBCursor as IDBCursor
17+import Database.IndexedDB.IDBDatabase as IDBDatabase
18+import Database.IndexedDB.IDBFactory as IDBFactory
19+import Database.IndexedDB.IDBIndex as IDBIndex
20+import Database.IndexedDB.IDBKey (Key, none, toKey)
21+import Database.IndexedDB.IDBKeyRange as IDBKeyRange
22+import Database.IndexedDB.IDBObjectStore as IDBObjectStore
23+import Database.IndexedDB.IDBTransaction as IDBTransaction
24+import Effect (Effect)
25+import Effect.Aff (Aff, attempt, delay, forkAff, launchAff, launchAff_)
26+import Effect.Aff.AVar (AVar)
27+import Effect.Aff.AVar as AVar
28+import Effect.Class (liftEffect)
29+import Effect.Console (log)
30+import Effect.Exception (name)
31+import Effect.Now (now)
32+import Test.Spec (describe, it)
33+import Test.Spec.Assertions (shouldEqual, fail)
34+import Test.Spec.Reporter (consoleReporter)
35+import Test.Spec.Runner (runSpec)
3736
3837infixr 7 Tuple as :+:
3938
40−launchAff' :: forall a e. Aff e a -> Eff (exception :: EXCEPTION | e) Unit
41−launchAff' aff =
42− pure unit <* (launchAff aff)
39+launchAff' :: forall a. Aff a -> Effect Unit
40+launchAff' =
41+ launchAff_ <<< void
42+
43+modifyAVar :: forall a. (a -> a) -> AVar a -> Aff Unit
44+modifyAVar fn v = do
45+ val <- AVar.take v
46+ AVar.put (fn val) v
4347
44−-- main :: forall eff. Eff (now :: NOW, mocha :: MOCHA, idb :: IDB, exception :: EXCEPTION, avar :: AVAR | eff) Unit
45−main = runMocha do
46− describe "IDBFactory" do
47− let
48+main :: Effect Unit
49+main = do
50+ launchAff_ $ runSpec [ consoleReporter ] $ do
51+ describe "IDBFactory" do
52+ let
4853 tearDown name version db = do
4954 IDBDatabase.close db
5055 version' <- IDBFactory.deleteDatabase name
56+ liftEffect $ log $ show version'
5157 version' `shouldEqual` version
5258
53− it "open default" do
54− let name = "db-default"
59+ it "open default" do
60+ let
61+ name = "db-default"
5562 version = 1
56− db <- IDBFactory.open name Nothing
57− { onUpgradeNeeded : Nothing
58− , onBlocked : Nothing
59− }
60− IDBDatabase.name db `shouldEqual` name
61− tearDown name version db
62−
63+ db <- IDBFactory.open name Nothing
64+ { onUpgradeNeeded: Nothing
65+ , onBlocked: Nothing
66+ }
67+ IDBDatabase.name db `shouldEqual` name
68+ tearDown name version db
6369
64− it "open specific version" do
65− let name = "db-specific"
70+ it "open specific version" do
71+ let
72+ name = "db-specific"
6673 version = 14
67− db <- IDBFactory.open name (Just version)
68− { onUpgradeNeeded : Nothing
69− , onBlocked : Nothing
70− }
71− IDBDatabase.name db `shouldEqual` name
72− tearDown name version db
73−
74+ db <- IDBFactory.open name (Just version)
75+ { onUpgradeNeeded: Nothing
76+ , onBlocked: Nothing
77+ }
78+ IDBDatabase.name db `shouldEqual` name
79+ tearDown name version db
7480
75− it "open specific version -> close -> open latest" do
76− let name = "db-latest"
81+ it "open specific version -> close -> open latest" do
82+ let
83+ name = "db-latest"
7784 version = 14
78− db <- IDBFactory.open name (Just version)
79− { onUpgradeNeeded : Nothing
80− , onBlocked : Nothing
81− }
82− IDBDatabase.name db `shouldEqual` name
83− IDBDatabase.close db
84− db <- IDBFactory.open name Nothing
85− { onUpgradeNeeded : Nothing
86− , onBlocked : Nothing
87− }
88− tearDown name version db
89−
90− it "open + onUpgradeNeed" do
91− let name = "db-upgrade-needed"
85+ db01 <- IDBFactory.open name (Just version)
86+ { onUpgradeNeeded: Nothing
87+ , onBlocked: Nothing
88+ }
89+ IDBDatabase.name db01 `shouldEqual` name
90+ IDBDatabase.close db01
91+ db02 <- IDBFactory.open name Nothing
92+ { onUpgradeNeeded: Nothing
93+ , onBlocked: Nothing
94+ }
95+ tearDown name version db02
96+
97+ it "open + onUpgradeNeed" do
98+ let
99+ name = "db-upgrade-needed"
92100 version = 1
93101 callback (Tuple varName varVersion) db _ { oldVersion } = do
94− _ <- launchAff $ modifyVar (const $ IDBDatabase.name db) varName
95− _ <- launchAff $ modifyVar (const $ oldVersion) varVersion
102+ _ <- launchAff $ modifyAVar (const $ IDBDatabase.name db) varName
103+ _ <- launchAff $ modifyAVar (const $ oldVersion) varVersion
96104 pure unit
97− varName <- makeVar' "-"
98− varVersion <- makeVar' (-1)
99− db <- IDBFactory.open name Nothing
100− { onUpgradeNeeded : Just (callback (Tuple varName varVersion))
101− , onBlocked : Nothing
102− }
103− name' <- peekVar varName
104− version' <- peekVar varVersion
105− name' `shouldEqual` name
106− version' `shouldEqual` 0
107− tearDown name version db
108−
109− it "open + onBlocked" do
110− let name = "db-blocked"
105+ varName <- AVar.new "-"
106+ varVersion <- AVar.new (-1)
107+ db <- IDBFactory.open name Nothing
108+ { onUpgradeNeeded: Just (callback (Tuple varName varVersion))
109+ , onBlocked: Nothing
110+ }
111+ name' <- AVar.read varName
112+ version' <- AVar.read varVersion
113+ name' `shouldEqual` name
114+ version' `shouldEqual` 0
115+ tearDown name version db
116+
117+ it "open + onBlocked" do
118+ let
119+ name = "db-blocked"
111120 version = 14
112121 callback var = do
113− _ <- launchAff $ modifyVar (const $ "db-blocked") var
122+ _ <- launchAff $ modifyAVar (const $ "db-blocked") var
114123 pure unit
115124
116− var <- makeVar' "-"
117− db01 <- IDBFactory.open name Nothing
118− { onUpgradeNeeded : Nothing
119− , onBlocked : Nothing
120− }
121− _ <- forkAff do
122− delay (Milliseconds 100.0)
123− IDBDatabase.close db01
125+ var <- AVar.new "-"
126+ db01 <- IDBFactory.open name Nothing
127+ { onUpgradeNeeded: Nothing
128+ , onBlocked: Nothing
129+ }
130+ _ <- forkAff do
131+ delay (Milliseconds 100.0)
132+ IDBDatabase.close db01
124133
125− db02 <- IDBFactory.open name (Just version)
126− { onUpgradeNeeded : Nothing
127− , onBlocked : Just (callback var)
128− }
129− name' <- peekVar var
130− name' `shouldEqual` name
131− tearDown name version db02
132−
133− describe "IDBKeyRange" do
134− it "only(int)" do
135− let key = 14
134+ db02 <- IDBFactory.open name (Just version)
135+ { onUpgradeNeeded: Nothing
136+ , onBlocked: Just (callback var)
137+ }
138+ name' <- AVar.read var
139+ name' `shouldEqual` name
140+ tearDown name version db02
141+
142+ describe "IDBKeyRange" do
143+ it "only(int)" do
144+ let
145+ key = 14
136146 range = IDBKeyRange.only key
137− IDBKeyRange.includes range (toKey key) `shouldEqual` true
147+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
138148
139− it "only(string)" do
140− let key = "patate"
149+ it "only(string)" do
150+ let
151+ key = "patate"
141152 range = IDBKeyRange.only key
142− IDBKeyRange.includes range (toKey key) `shouldEqual` true
153+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
143154
144− it "only(float)" do
145− let key = 14.42
155+ it "only(float)" do
156+ let
157+ key = 14.42
146158 range = IDBKeyRange.only key
147− IDBKeyRange.includes range (toKey key) `shouldEqual` true
159+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
148160
149− it "only(date)" do
150− let mkey = DateTime
161+ it "only(date)" do
162+ let
163+ mkey = DateTime
151164 <$> (Date.canonicalDate <$> toEnum 2017 <*> toEnum 6 <*> toEnum 23)
152165 <*> (Time <$> toEnum 17 <*> toEnum 59 <*> toEnum 34 <*> toEnum 42)
153166
154− case mkey of
155− Nothing ->
156− fail "unable to create datetime"
157− Just key -> do
158− let range = IDBKeyRange.only key
159− IDBKeyRange.includes range (toKey key) `shouldEqual` true
167+ case mkey of
168+ Nothing ->
169+ fail "unable to create datetime"
170+ Just key -> do
171+ let range = IDBKeyRange.only key
172+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
160173
161− it "only([int])" do
162− let key = [14, 42]
174+ it "only([int])" do
175+ let
176+ key = [ 14, 42 ]
163177 range = IDBKeyRange.only key
164− IDBKeyRange.includes range (toKey key) `shouldEqual` true
178+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
165179
166− it "only([string])" do
167− let key = ["patate", "autruche"]
180+ it "only([string])" do
181+ let
182+ key = [ "patate", "autruche" ]
168183 range = IDBKeyRange.only key
169− IDBKeyRange.includes range (toKey key) `shouldEqual` true
184+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
170185
171− it "lowerBound(14, open)" do
172− let key = 14
173− open = true
186+ it "lowerBound(14, open)" do
187+ let
188+ key = 14
189+ open = true
174190 range = IDBKeyRange.lowerBound key open
175− IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
176− IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
177− IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false
178−
179− it "lowerBound(14, close)" do
180− let key = 14
181− open = false
191+ IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
192+ IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
193+ IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false
194+
195+ it "lowerBound(14, close)" do
196+ let
197+ key = 14
198+ open = false
182199 range = IDBKeyRange.lowerBound key open
183− IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
184− IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
185− IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false
186−
187− it "upperBound(14, open)" do
188− let key = 14
189− open = true
200+ IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
201+ IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
202+ IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false
203+
204+ it "upperBound(14, open)" do
205+ let
206+ key = 14
207+ open = true
190208 range = IDBKeyRange.upperBound key open
191− IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
192− IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
193− IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true
194−
195− it "upperBound(14, close)" do
196− let key = 14
197− open = false
209+ IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
210+ IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
211+ IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true
212+
213+ it "upperBound(14, close)" do
214+ let
215+ key = 14
216+ open = false
198217 range = IDBKeyRange.upperBound key open
199− IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
200− IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
201− IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true
202−
203− it "bound(42, 14, open, open) => Nothing" do
204− let lower = 42
205− upper = 14
218+ IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
219+ IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
220+ IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true
221+
222+ it "bound(42, 14, open, open) => Nothing" do
223+ let
224+ lower = 42
225+ upper = 14
206226 lowerOpen = true
207227 upperOpen = true
208− mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
209− isNothing mrange `shouldEqual` true
228+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
229+ isNothing mrange `shouldEqual` true
210230
211− it "bound(14, 42, open, open)" do
212− let lower = 14
213− upper = 42
231+ it "bound(14, 42, open, open)" do
232+ let
233+ lower = 14
234+ upper = 42
214235 lowerOpen = true
215236 upperOpen = true
216− mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
217− case mrange of
218− Nothing ->
219− fail "invalid range provided"
220− Just range -> do
221− IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
222− IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
223− IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
224− IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
225− IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
226− IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
227−
228− it "bound(14, 42, open, close)" do
229− let lower = 14
230− upper = 42
237+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
238+ case mrange of
239+ Nothing ->
240+ fail "invalid range provided"
241+ Just range -> do
242+ IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
243+ IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
244+ IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
245+ IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
246+ IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
247+ IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
248+
249+ it "bound(14, 42, open, close)" do
250+ let
251+ lower = 14
252+ upper = 42
231253 lowerOpen = true
232254 upperOpen = false
233− mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
234− case mrange of
235− Nothing ->
236− fail "invalid range provided"
237− Just range -> do
238− IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
239− IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
240− IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
241− IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
242− IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
243− IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
244−
245− it "bound(14, 42, close, open)" do
246− let lower = 14
247− upper = 42
255+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
256+ case mrange of
257+ Nothing ->
258+ fail "invalid range provided"
259+ Just range -> do
260+ IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
261+ IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
262+ IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
263+ IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
264+ IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
265+ IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
266+
267+ it "bound(14, 42, close, open)" do
268+ let
269+ lower = 14
270+ upper = 42
248271 lowerOpen = false
249272 upperOpen = true
250− mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
251− case mrange of
252− Nothing ->
253− fail "invalid range provided"
254− Just range -> do
255− IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
256− IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
257− IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
258− IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
259− IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
260− IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
261−
262− it "bound(14, 42, close, close)" do
263− let lower = 14
264− upper = 42
273+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
274+ case mrange of
275+ Nothing ->
276+ fail "invalid range provided"
277+ Just range -> do
278+ IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
279+ IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
280+ IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
281+ IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
282+ IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
283+ IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
284+
285+ it "bound(14, 42, close, close)" do
286+ let
287+ lower = 14
288+ upper = 42
265289 lowerOpen = false
266290 upperOpen = false
267− mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
268− case mrange of
269− Nothing ->
270− fail "invalid range provided"
271− Just range -> do
272− IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
273− IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
274− IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
275− IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
276− IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
277− IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
278−
279− it "can access attributes of a range" do
280− let range = IDBKeyRange.lowerBound 14 false
281− IDBKeyRange.lower range `shouldEqual` (Just $ toKey 14)
282− IDBKeyRange.upper range `shouldEqual` none
283− IDBKeyRange.lowerOpen range `shouldEqual` false
284− IDBKeyRange.upperOpen range `shouldEqual` true
285−
286− describe "IDBDatabase" do
287− let
291+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
292+ case mrange of
293+ Nothing ->
294+ fail "invalid range provided"
295+ Just range -> do
296+ IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
297+ IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
298+ IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
299+ IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
300+ IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
301+ IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
302+
303+ it "can access attributes of a range" do
304+ let range = IDBKeyRange.lowerBound 14 false
305+ IDBKeyRange.lower range `shouldEqual` (Just $ toKey 14)
306+ IDBKeyRange.upper range `shouldEqual` none
307+ IDBKeyRange.lowerOpen range `shouldEqual` false
308+ IDBKeyRange.upperOpen range `shouldEqual` true
309+
310+ describe "IDBDatabase" do
311+ let
288312 tearDown db = do
289313 IDBDatabase.close db
290314 _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
291315 pure unit
292316
293317 setup storeParams = do
294− let onUpgradeNeeded var db _ _ = launchAff' do
295− store <- IDBDatabase.createObjectStore db "store" storeParams
296− _ <- putVar var { db, store }
297− pure unit
298−
299− var <- makeVar
300− db <- IDBFactory.open "db" Nothing
301− { onUpgradeNeeded : Just (onUpgradeNeeded var)
302− , onBlocked : Nothing
318+ let
319+ onUpgradeNeeded var db _ _ = launchAff' do
320+ store <- IDBDatabase.createObjectStore db "store" storeParams
321+ _ <- AVar.put { db, store } var
322+ pure unit
323+
324+ var <- AVar.empty
325+ _ <- IDBFactory.open "db" Nothing
326+ { onUpgradeNeeded: Just (onUpgradeNeeded var)
327+ , onBlocked: Nothing
303328 }
304329
305− takeVar var
306−
307− it "createObjectStore (keyPath: [], autoIncrement: true)" do
308− { db, store } <- setup { keyPath: [], autoIncrement: true }
309− IDBObjectStore.name store `shouldEqual` "store"
310− IDBObjectStore.keyPath store `shouldEqual` []
311− IDBObjectStore.autoIncrement store `shouldEqual` true
312− IDBObjectStore.indexNames store `shouldEqual` []
313− tearDown db
314−
315− it "createObjectStore (keyPath: [\"patate\"], autoIncrement: true)" do
316− { db, store } <- setup { keyPath: ["patate"], autoIncrement: true }
317− IDBObjectStore.name store `shouldEqual` "store"
318− IDBObjectStore.keyPath store `shouldEqual` ["patate"]
319− IDBObjectStore.autoIncrement store `shouldEqual` true
320− IDBObjectStore.indexNames store `shouldEqual` []
321− tearDown db
322−
323− it "createObjectStore (keyPath: [\"a\", \"b\"], autoIncrement: false)" do
324− { db, store } <- setup { keyPath: ["patate", "autruche"], autoIncrement: false }
325− IDBObjectStore.name store `shouldEqual` "store"
326− IDBObjectStore.keyPath store `shouldEqual` ["patate", "autruche"]
327− IDBObjectStore.autoIncrement store `shouldEqual` false
328− IDBObjectStore.indexNames store `shouldEqual` []
329− tearDown db
330−
331− it "deleteObjectStore" do
332− let onUpgradeNeeded var db _ _ = launchAff' do
330+ AVar.take var
331+
332+ it "createObjectStore (keyPath: [], autoIncrement: true)" do
333+ { db, store } <- setup { keyPath: [], autoIncrement: true }
334+ IDBObjectStore.name store `shouldEqual` "store"
335+ IDBObjectStore.keyPath store `shouldEqual` []
336+ IDBObjectStore.autoIncrement store `shouldEqual` true
337+ IDBObjectStore.indexNames store `shouldEqual` []
338+ tearDown db
339+
340+ it "createObjectStore (keyPath: [\"patate\"], autoIncrement: true)" do
341+ { db, store } <- setup { keyPath: [ "patate" ], autoIncrement: true }
342+ IDBObjectStore.name store `shouldEqual` "store"
343+ IDBObjectStore.keyPath store `shouldEqual` [ "patate" ]
344+ IDBObjectStore.autoIncrement store `shouldEqual` true
345+ IDBObjectStore.indexNames store `shouldEqual` []
346+ tearDown db
347+
348+ it "createObjectStore (keyPath: [\"a\", \"b\"], autoIncrement: false)" do
349+ { db, store } <- setup { keyPath: [ "patate", "autruche" ], autoIncrement: false }
350+ IDBObjectStore.name store `shouldEqual` "store"
351+ IDBObjectStore.keyPath store `shouldEqual` [ "patate", "autruche" ]
352+ IDBObjectStore.autoIncrement store `shouldEqual` false
353+ IDBObjectStore.indexNames store `shouldEqual` []
354+ tearDown db
355+
356+ it "deleteObjectStore" do
357+ let
358+ onUpgradeNeeded var db _ _ = launchAff' do
333359 _ <- IDBDatabase.deleteObjectStore db "store"
334− putVar var true
335−
336− var <- makeVar
337− { db, store } <- setup IDBDatabase.defaultParameters
338− IDBDatabase.close db
339− db <- IDBFactory.open "db" (Just 999) { onUpgradeNeeded : Just (onUpgradeNeeded var)
340− , onBlocked : Nothing
341− }
342− deleted <- takeVar var
343− deleted `shouldEqual` true
344− tearDown db
345−
360+ AVar.put true var
361+
362+ var <- AVar.empty
363+ { db } <- setup IDBDatabase.defaultParameters
364+ IDBDatabase.close db
365+ db' <- IDBFactory.open "db" (Just 999)
366+ { onUpgradeNeeded: Just (onUpgradeNeeded var)
367+ , onBlocked: Nothing
368+ }
369+ deleted <- AVar.take var
370+ deleted `shouldEqual` true
371+ tearDown db'
346372
347− describe "IDBObjectStore" do
348− let
373+ describe "IDBObjectStore" do
374+ let
349375 tearDown db = do
350376 IDBDatabase.close db
351377 _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
352378 pure unit
353379
354380 setup { storeParams, onUpgradeNeeded } = do
355− let onUpgradeNeeded' var db _ _ = launchAff' do
356− store <- IDBDatabase.createObjectStore db "store" storeParams
357− liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure store)
358− putVar var { db, store }
359−
360− var <- makeVar
361− db <- IDBFactory.open "db" Nothing
362− { onUpgradeNeeded : Just (onUpgradeNeeded' var)
363− , onBlocked : Nothing
381+ let
382+ onUpgradeNeeded' var db _ _ = launchAff' do
383+ store <- IDBDatabase.createObjectStore db "store" storeParams
384+ liftEffect $ maybe (pure unit) identity (onUpgradeNeeded <*> pure db <*> pure store)
385+ AVar.put { db, store } var
386+
387+ var <- AVar.empty
388+ _ <- IDBFactory.open "db" Nothing
389+ { onUpgradeNeeded: Just (onUpgradeNeeded' var)
390+ , onBlocked: Nothing
364391 }
365392
366− takeVar var
367−
368− it "add()" do
369− date <- liftEff $ toDateTime <$> now
370− { db } <- setup
371− { storeParams: { autoIncrement: true, keyPath: [] }
372− , onUpgradeNeeded: Just $ \_ store -> launchAff' do
373− -- no key
374− key <- IDBObjectStore.add store "patate" none
375− (toKey 1) `shouldEqual` key
376−
377− -- int key
378− key <- IDBObjectStore.add store "patate" (Just 14)
379− (toKey 14) `shouldEqual` key
380−
381− -- number key
382− key <- IDBObjectStore.add store "patate" (Just 14.42)
383− (toKey 14.42) `shouldEqual` key
384−
385− -- string key
386− key <- IDBObjectStore.add store "patate" (Just "key")
387− (toKey "key") `shouldEqual` key
388−
389− -- date key
390− key <- IDBObjectStore.add store "patate" (Just date)
391− (toKey date) `shouldEqual` key
392−
393− -- array key
394− key <- IDBObjectStore.add store "patate" (Just $ toKey [14, 42])
395− (toKey [14, 42]) `shouldEqual` key
396− }
397− tearDown db
398−
399− it "clear()" do
400− { db } <- setup
401− { storeParams: IDBDatabase.defaultParameters
402− , onUpgradeNeeded: Just $ \_ store -> launchAff' do
403− key <- IDBObjectStore.add store "patate" (Just 14)
404− _ <- IDBObjectStore.clear store
405− val <- IDBObjectStore.get store (IDBKeyRange.only key)
406− val `shouldEqual` (Nothing :: Maybe String)
407− }
408− tearDown db
409−
410− it "count()" do
411− { db } <- setup
412− { storeParams: IDBDatabase.defaultParameters
413− , onUpgradeNeeded: Just $ \_ store -> launchAff' do
414− key <- IDBObjectStore.add store "patate" (Just 14)
415− key <- IDBObjectStore.add store "autruche" (Just 42)
416− n <- IDBObjectStore.count store Nothing
417− n `shouldEqual` 2
418− }
419− tearDown db
420−
421− it "getKey()" do
422− { db } <- setup
423− { storeParams: IDBDatabase.defaultParameters
424− , onUpgradeNeeded: Just $ \_ store -> launchAff' do
425− key <- IDBObjectStore.add store "patate" (Just 14)
426− mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 14)
427− mkey `shouldEqual` (Just key)
428−
429− mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 42)
430− mkey `shouldEqual` none
393+ AVar.take var
394+
395+ it "add()" do
396+ date <- liftEffect $ toDateTime <$> now
397+ { db } <- setup
398+ { storeParams: { autoIncrement: true, keyPath: [] }
399+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
400+ -- no key
401+ key <- IDBObjectStore.add store "patate" none
402+ (toKey 1) `shouldEqual` key
403+
404+ -- int key
405+ key' <- IDBObjectStore.add store "patate" (Just 14)
406+ (toKey 14) `shouldEqual` key'
407+
408+ -- number key
409+ key'' <- IDBObjectStore.add store "patate" (Just 14.42)
410+ (toKey 14.42) `shouldEqual` key''
411+
412+ -- string key
413+ key''' <- IDBObjectStore.add store "patate" (Just "key")
414+ (toKey "key") `shouldEqual` key'''
415+
416+ -- date key
417+ key'''' <- IDBObjectStore.add store "patate" (Just date)
418+ (toKey date) `shouldEqual` key''''
419+
420+ -- array key
421+ key''''' <- IDBObjectStore.add store "patate" (Just $ toKey [ 14, 42 ])
422+ (toKey [ 14, 42 ]) `shouldEqual` key'''''
423+ }
424+ tearDown db
425+
426+ it "clear()" do
427+ { db } <- setup
428+ { storeParams: IDBDatabase.defaultParameters
429+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
430+ key <- IDBObjectStore.add store "patate" (Just 14)
431+ _ <- IDBObjectStore.clear store
432+ val <- IDBObjectStore.get store (IDBKeyRange.only key)
433+ val `shouldEqual` (Nothing :: Maybe String)
431434 }
432− tearDown db
433−
434− it "getAllKeys()" do
435− { db } <- setup
436− { storeParams: IDBDatabase.defaultParameters
437− , onUpgradeNeeded: Just $ \_ store -> launchAff' do
438− key1 <- IDBObjectStore.add store "patate" (Just 14)
439− key2 <- IDBObjectStore.add store "autruche" (Just 42)
440− key3 <- IDBObjectStore.add store 14 (Just 1337)
441−
442− -- no bounds
443− keys <- IDBObjectStore.getAllKeys store Nothing Nothing
444− keys `shouldEqual` [key1, key2, key3]
445−
446− -- lower bound
447− keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 14 true) Nothing
448− keys `shouldEqual` [key2, key3]
449−
450− -- upper bound
451− keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.upperBound 42 false) Nothing
452− keys `shouldEqual` [key1, key2]
453−
454− -- count
455− keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 1 true) (Just 2)
456− keys `shouldEqual` [key1, key2]
457− }
458− tearDown db
459−
460− it "openCursor()" do
461− let cb =
462− { onSuccess : const $ pure unit
463− , onError : show >>> fail >>> launchAff'
435+ tearDown db
436+
437+ it "count()" do
438+ { db } <- setup
439+ { storeParams: IDBDatabase.defaultParameters
440+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
441+ _ <- IDBObjectStore.add store "patate" (Just 14)
442+ _ <- IDBObjectStore.add store "autruche" (Just 42)
443+ n <- IDBObjectStore.count store Nothing
444+ n `shouldEqual` 2
445+ }
446+ tearDown db
447+
448+ it "getKey()" do
449+ { db } <- setup
450+ { storeParams: IDBDatabase.defaultParameters
451+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
452+ key <- IDBObjectStore.add store "patate" (Just 14)
453+ mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 14)
454+ mkey `shouldEqual` (Just key)
455+
456+ mkey' <- IDBObjectStore.getKey store (IDBKeyRange.only 42)
457+ mkey' `shouldEqual` none
458+ }
459+ tearDown db
460+
461+ it "getAllKeys()" do
462+ { db } <- setup
463+ { storeParams: IDBDatabase.defaultParameters
464+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
465+ key1 <- IDBObjectStore.add store "patate" (Just 14)
466+ key2 <- IDBObjectStore.add store "autruche" (Just 42)
467+ key3 <- IDBObjectStore.add store 14 (Just 1337)
468+
469+ -- no bounds
470+ keys <- IDBObjectStore.getAllKeys store Nothing Nothing
471+ keys `shouldEqual` [ key1, key2, key3 ]
472+
473+ -- lower bound
474+ keys' <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 14 true) Nothing
475+ keys' `shouldEqual` [ key2, key3 ]
476+
477+ -- upper bound
478+ keys'' <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.upperBound 42 false) Nothing
479+ keys'' `shouldEqual` [ key1, key2 ]
480+
481+ -- count
482+ keys''' <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 1 true) (Just 2)
483+ keys''' `shouldEqual` [ key1, key2 ]
484+ }
485+ tearDown db
486+
487+ it "openCursor()" do
488+ let
489+ cb =
490+ { onSuccess: const $ pure unit
491+ , onError: show >>> fail >>> launchAff'
464492 , onComplete: pure unit
465493 }
466− { db } <- setup
467− { storeParams: IDBDatabase.defaultParameters
468− , onUpgradeNeeded: Just $ \_ store -> launchAff' do
469− _ <- IDBObjectStore.openCursor store Nothing Next cb
470− _ <- IDBObjectStore.openCursor store Nothing NextUnique cb
471− _ <- IDBObjectStore.openCursor store Nothing Prev cb
472− _ <- IDBObjectStore.openCursor store Nothing PrevUnique cb
473− _ <- IDBObjectStore.openCursor store (Just $ IDBKeyRange.upperBound 1 true) Next cb
474− pure unit
475− }
476− tearDown db
494+ { db } <- setup
495+ { storeParams: IDBDatabase.defaultParameters
496+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
497+ _ <- IDBObjectStore.openCursor store Nothing Next cb
498+ _ <- IDBObjectStore.openCursor store Nothing NextUnique cb
499+ _ <- IDBObjectStore.openCursor store Nothing Prev cb
500+ _ <- IDBObjectStore.openCursor store Nothing PrevUnique cb
501+ _ <- IDBObjectStore.openCursor store (Just $ IDBKeyRange.upperBound 1 true) Next cb
502+ pure unit
503+ }
504+ tearDown db
477505
478− it "openKeyCursor()" do
479− let cb =
480− { onSuccess : const $ pure unit
481− , onError : show >>> fail >>> launchAff'
506+ it "openKeyCursor()" do
507+ let
508+ cb =
509+ { onSuccess: const $ pure unit
510+ , onError: show >>> fail >>> launchAff'
482511 , onComplete: pure unit
483512 }
484− { db } <- setup
485− { storeParams: IDBDatabase.defaultParameters
486− , onUpgradeNeeded: Just $ \_ store -> launchAff' do
487− _ <- IDBObjectStore.openKeyCursor store Nothing Next cb
488− _ <- IDBObjectStore.openKeyCursor store Nothing NextUnique cb
489− _ <- IDBObjectStore.openKeyCursor store Nothing Prev cb
490− _ <- IDBObjectStore.openKeyCursor store Nothing PrevUnique cb
491− _ <- IDBObjectStore.openKeyCursor store (Just $ IDBKeyRange.lowerBound 1 true) Next cb
492− pure unit
493− }
494− tearDown db
513+ { db } <- setup
514+ { storeParams: IDBDatabase.defaultParameters
515+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
516+ _ <- IDBObjectStore.openKeyCursor store Nothing Next cb
517+ _ <- IDBObjectStore.openKeyCursor store Nothing NextUnique cb
518+ _ <- IDBObjectStore.openKeyCursor store Nothing Prev cb
519+ _ <- IDBObjectStore.openKeyCursor store Nothing PrevUnique cb
520+ _ <- IDBObjectStore.openKeyCursor store (Just $ IDBKeyRange.lowerBound 1 true) Next cb
521+ pure unit
522+ }
523+ tearDown db
495524
496− describe "IDBIndex" do
497− let
525+ describe "IDBIndex" do
526+ let
498527 tearDown db = do
499528 IDBDatabase.close db
500529 _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
501530 pure unit
502531
503− setup :: forall value e e'.
504− { storeParams :: { keyPath :: Array String, autoIncrement :: Boolean }
505− , indexParams :: { unique :: Boolean, multiEntry :: Boolean }
506− , values :: Array (Tuple value (Maybe Key))
507− , keyPath :: Array String
508− , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Eff (idb :: IDB, avar :: AVAR, exception :: EXCEPTION | e') Unit)
509− } -> Aff (idb :: IDB, avar :: AVAR | e) { db :: Database, index :: Index, store :: ObjectStore }
532+ setup
533+ :: forall value
534+ . { storeParams :: { keyPath :: Array String, autoIncrement :: Boolean }
535+ , indexParams :: { unique :: Boolean, multiEntry :: Boolean }
536+ , values :: Array (Tuple value (Maybe Key))
537+ , keyPath :: Array String
538+ , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Effect Unit)
539+ }
540+ -> Aff { db :: Database, index :: Index, store :: ObjectStore }
510541 setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
511− let onUpgradeNeeded' var db tx _ = launchAff' do
512− store <- IDBDatabase.createObjectStore db "store" storeParams
513− _ <- traverse (uncurry (IDBObjectStore.add store)) values
514− index <- IDBObjectStore.createIndex store "index" keyPath indexParams
515− liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
516− putVar var { db, index, store }
517−
518− var <- makeVar
519− db <- IDBFactory.open "db" Nothing
520− { onUpgradeNeeded : Just (onUpgradeNeeded' var)
521− , onBlocked : Nothing
542+ let
543+ onUpgradeNeeded' var db tx _ = launchAff' do
544+ store <- IDBDatabase.createObjectStore db "store" storeParams
545+ _ <- traverse (uncurry (IDBObjectStore.add store)) values
546+ index <- IDBObjectStore.createIndex store "index" keyPath indexParams
547+ liftEffect $ maybe (pure unit) identity (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
548+ AVar.put { db, index, store } var
549+
550+ var <- AVar.empty
551+ _ <- IDBFactory.open "db" Nothing
552+ { onUpgradeNeeded: Just (onUpgradeNeeded' var)
553+ , onBlocked: Nothing
522554 }
523− takeVar var
524−
525−
526− it "returns an IDBIndex and the properties are set correctly" do
527− { db, index } <- setup
528− { storeParams : IDBDatabase.defaultParameters
529− , indexParams : IDBObjectStore.defaultParameters
530− , onUpgradeNeeded : Nothing
531− , keyPath : []
532− , values : []
533− }
534− IDBIndex.name index `shouldEqual` "index"
535− IDBIndex.keyPath index `shouldEqual` []
536− IDBIndex.unique index `shouldEqual` IDBObjectStore.defaultParameters.unique
537− IDBIndex.multiEntry index `shouldEqual` IDBObjectStore.defaultParameters.multiEntry
538− tearDown db
539−
540− it "attempt to create an index that requires unique values on an object store already contains duplicates" do
541− let onAbort var = launchAff' (putVar var true)
542− txVar <- makeVar
543− dbVar <- makeVar
544− res <- attempt $ setup
545− { storeParams : IDBDatabase.defaultParameters
546− , indexParams : { unique : true
547− , multiEntry : false
548− }
549− , keyPath : ["indexedProperty"]
550− , values : [ { indexedProperty: "bar" } :+: (Just $ toKey 1)
551− , { indexedProperty: "bar" } :+: (Just $ toKey 2)
552− ]
553− , onUpgradeNeeded : Just $ \db tx _ -> launchAff' do
554− IDBTransaction.onAbort tx (onAbort txVar)
555− IDBDatabase.onAbort db (onAbort dbVar)
556− }
557− case res of
558− Right _ ->
559− fail "expected abort"
560− _ -> do
561− shouldEqual true =<< takeVar txVar
562− shouldEqual true =<< takeVar dbVar
563−
564−
565− it "the index is usable right after being made" do
566− { db } <- setup
567− { storeParams : { keyPath : ["key"]
568− , autoIncrement : false
569− }
570− , indexParams : IDBObjectStore.defaultParameters
571− , keyPath : ["indexedProperty"]
572− , values : [ { key: "key1", indexedProperty: "indexed_1" } :+: Nothing
573− , { key: "key2", indexedProperty: "indexed_2" } :+: Nothing
574− , { key: "key3", indexedProperty: "indexed_3" } :+: Nothing
575− ]
576− , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
577− val <- IDBIndex.get index (IDBKeyRange.only "indexed_2")
578− ((\r -> r.key) <$> val) `shouldEqual` (Just $ toKey "key2")
579− }
580− tearDown db
581−
582− it "empty keyPath" do
583− { db } <- setup
584− { storeParams : IDBDatabase.defaultParameters
585− , indexParams : IDBObjectStore.defaultParameters
586− , keyPath : []
587− , values : [ "object_1" :+: (Just $ toKey 1)
588− , "object_2" :+: (Just $ toKey 2)
589− , "object_3" :+: (Just $ toKey 3)
590− ]
591− , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
592− val <- IDBIndex.get index (IDBKeyRange.only "object_3")
593− val `shouldEqual` (Just "object_3")
594− }
595− tearDown db
596−
597− it "index can be valid keys [date]" do
598− date <- liftEff $ toDateTime <$> now
599− { db } <- setup
600− { storeParams : { keyPath: ["key"]
601− , autoIncrement: false
602− }
603− , indexParams : IDBObjectStore.defaultParameters
604− , keyPath : ["i"]
605− , values : [ { key: "date", i: (toKey date) } :+: Nothing
606− ]
607− , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
608− val <- IDBIndex.get index (IDBKeyRange.only date)
609− ((\r -> r.key) <$> val) `shouldEqual` (Just "date")
610− }
611− tearDown db
612−
613− it "index can be valid keys [num]" do
614− let num = 14
615− { db } <- setup
616− { storeParams : { keyPath: ["key"]
617− , autoIncrement: false
618− }
619− , indexParams : IDBObjectStore.defaultParameters
620− , keyPath : ["i"]
621− , values : [ { key: "num", i: (toKey num) } :+: Nothing
622− ]
623− , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
624− val <- IDBIndex.get index (IDBKeyRange.only num)
625− ((\r -> r.key) <$> val) `shouldEqual` (Just "num")
626− }
627− tearDown db
628−
629− it "index can be valid keys [array]" do
630− let array = ["patate", "autruche"]
631− { db } <- setup
632− { storeParams : { keyPath: ["key"]
633− , autoIncrement: false
634− }
635− , indexParams : IDBObjectStore.defaultParameters
636− , keyPath : ["i"]
637− , values : [ { key: "array", i: (toKey array) } :+: Nothing
638− ]
639− , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
640− val <- IDBIndex.get index (IDBKeyRange.only array)
641− ((\r -> r.key) <$> val) `shouldEqual` (Just "array")
642− }
643− tearDown db
644−
645− it "openKeyCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
646− res <- attempt $ setup
647− { storeParams : { keyPath: ["key"], autoIncrement: false }
648− , indexParams : IDBObjectStore.defaultParameters
649− , keyPath : ["indexedProperty"]
650− , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
651− ]
652− , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
653− let cb =
654− { onSuccess : const $ pure unit
655− , onError : show >>> fail >>> launchAff'
555+ AVar.take var
556+
557+ it "returns an IDBIndex and the properties are set correctly" do
558+ { db, index } <- setup
559+ { storeParams: IDBDatabase.defaultParameters
560+ , indexParams: IDBObjectStore.defaultParameters
561+ , onUpgradeNeeded: Nothing
562+ , keyPath: []
563+ , values: []
564+ }
565+ IDBIndex.name index `shouldEqual` "index"
566+ IDBIndex.keyPath index `shouldEqual` []
567+ IDBIndex.unique index `shouldEqual` IDBObjectStore.defaultParameters.unique
568+ IDBIndex.multiEntry index `shouldEqual` IDBObjectStore.defaultParameters.multiEntry
569+ tearDown db
570+
571+ it "attempt to create an index that requires unique values on an object store already contains duplicates" do
572+ let onAbort var = launchAff' (AVar.put true var)
573+ txVar <- AVar.empty
574+ dbVar <- AVar.empty
575+ res <- attempt $ setup
576+ { storeParams: IDBDatabase.defaultParameters
577+ , indexParams:
578+ { unique: true
579+ , multiEntry: false
580+ }
581+ , keyPath: [ "indexedProperty" ]
582+ , values:
583+ [ { indexedProperty: "bar" } :+: (Just $ toKey 1)
584+ , { indexedProperty: "bar" } :+: (Just $ toKey 2)
585+ ]
586+ , onUpgradeNeeded: Just $ \db tx _ -> launchAff' do
587+ IDBTransaction.onAbort tx (onAbort txVar)
588+ IDBDatabase.onAbort db (onAbort dbVar)
589+ }
590+ case res of
591+ Right _ ->
592+ fail "expected abort"
593+ _ -> do
594+ shouldEqual true =<< AVar.take txVar
595+ shouldEqual true =<< AVar.take dbVar
596+
597+ it "the index is usable right after being made" do
598+ { db } <- setup
599+ { storeParams:
600+ { keyPath: [ "key" ]
601+ , autoIncrement: false
602+ }
603+ , indexParams: IDBObjectStore.defaultParameters
604+ , keyPath: [ "indexedProperty" ]
605+ , values:
606+ [ { key: "key1", indexedProperty: "indexed_1" } :+: Nothing
607+ , { key: "key2", indexedProperty: "indexed_2" } :+: Nothing
608+ , { key: "key3", indexedProperty: "indexed_3" } :+: Nothing
609+ ]
610+ , onUpgradeNeeded: Just $ \_ _ index -> launchAff' do
611+ val <- IDBIndex.get index (IDBKeyRange.only "indexed_2")
612+ ((\r -> r.key) <$> val) `shouldEqual` (Just $ toKey "key2")
613+ }
614+ tearDown db
615+
616+ it "empty keyPath" do
617+ { db } <- setup
618+ { storeParams: IDBDatabase.defaultParameters
619+ , indexParams: IDBObjectStore.defaultParameters
620+ , keyPath: []
621+ , values:
622+ [ "object_1" :+: (Just $ toKey 1)
623+ , "object_2" :+: (Just $ toKey 2)
624+ , "object_3" :+: (Just $ toKey 3)
625+ ]
626+ , onUpgradeNeeded: Just $ \_ _ index -> launchAff' do
627+ val <- IDBIndex.get index (IDBKeyRange.only "object_3")
628+ val `shouldEqual` (Just "object_3")
629+ }
630+ tearDown db
631+
632+ it "index can be valid keys [date]" do
633+ date <- liftEffect $ toDateTime <$> now
634+ { db } <- setup
635+ { storeParams:
636+ { keyPath: [ "key" ]
637+ , autoIncrement: false
638+ }
639+ , indexParams: IDBObjectStore.defaultParameters
640+ , keyPath: [ "i" ]
641+ , values:
642+ [ { key: "date", i: (toKey date) } :+: Nothing
643+ ]
644+ , onUpgradeNeeded: Just $ \_ _ index -> launchAff' do
645+ val <- IDBIndex.get index (IDBKeyRange.only date)
646+ ((\r -> r.key) <$> val) `shouldEqual` (Just "date")
647+ }
648+ tearDown db
649+
650+ it "index can be valid keys [num]" do
651+ let num = 14
652+ { db } <- setup
653+ { storeParams:
654+ { keyPath: [ "key" ]
655+ , autoIncrement: false
656+ }
657+ , indexParams: IDBObjectStore.defaultParameters
658+ , keyPath: [ "i" ]
659+ , values:
660+ [ { key: "num", i: (toKey num) } :+: Nothing
661+ ]
662+ , onUpgradeNeeded: Just $ \_ _ index -> launchAff' do
663+ val <- IDBIndex.get index (IDBKeyRange.only num)
664+ ((\r -> r.key) <$> val) `shouldEqual` (Just "num")
665+ }
666+ tearDown db
667+
668+ it "index can be valid keys [array]" do
669+ let array = [ "patate", "autruche" ]
670+ { db } <- setup
671+ { storeParams:
672+ { keyPath: [ "key" ]
673+ , autoIncrement: false
674+ }
675+ , indexParams: IDBObjectStore.defaultParameters
676+ , keyPath: [ "i" ]
677+ , values:
678+ [ { key: "array", i: (toKey array) } :+: Nothing
679+ ]
680+ , onUpgradeNeeded: Just $ \_ _ index -> launchAff' do
681+ val <- IDBIndex.get index (IDBKeyRange.only array)
682+ ((\r -> r.key) <$> val) `shouldEqual` (Just "array")
683+ }
684+ tearDown db
685+
686+ it "openKeyCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
687+ res <- attempt $ setup
688+ { storeParams: { keyPath: [ "key" ], autoIncrement: false }
689+ , indexParams: IDBObjectStore.defaultParameters
690+ , keyPath: [ "indexedProperty" ]
691+ , values:
692+ [ { key: 14, indexedProperty: "patate" } :+: Nothing
693+ ]
694+ , onUpgradeNeeded: Just $ \db tx index -> launchAff' do
695+ let
696+ cb =
697+ { onSuccess: const $ pure unit
698+ , onError: show >>> fail >>> launchAff'
656699 , onComplete: pure unit
657700 }
658− IDBTransaction.onAbort tx (pure unit)
659− IDBDatabase.onAbort db (pure unit)
660− IDBTransaction.abort tx
661− cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
662− case cursor of
663− Right _ -> fail "expected InvalidStateError"
664− Left err -> name err `shouldEqual` "InvalidStateError"
665− }
666− case res of
667− Right _ -> fail "expected InvalidStateError"
668− _ -> pure unit
669−
670− it "openKeyCursor() - throw TransactionInactiveError on aborted transaction" do
671− { db } <- setup
672− { storeParams : { keyPath: ["key"], autoIncrement: false }
673− , indexParams : IDBObjectStore.defaultParameters
674− , keyPath : ["indexedProperty"]
675− , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
676− ]
677− , onUpgradeNeeded : Nothing
678− }
679− let cb =
680− { onSuccess : const $ pure unit
681− , onError : show >>> fail >>> launchAff'
701+ IDBTransaction.onAbort tx (pure unit)
702+ IDBDatabase.onAbort db (pure unit)
703+ IDBTransaction.abort tx
704+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
705+ case cursor of
706+ Right _ -> fail "expected InvalidStateError"
707+ Left err -> name err `shouldEqual` "InvalidStateError"
708+ }
709+ case res of
710+ Right _ -> fail "expected InvalidStateError"
711+ _ -> pure unit
712+
713+ it "openKeyCursor() - throw TransactionInactiveError on aborted transaction" do
714+ { db } <- setup
715+ { storeParams: { keyPath: [ "key" ], autoIncrement: false }
716+ , indexParams: IDBObjectStore.defaultParameters
717+ , keyPath: [ "indexedProperty" ]
718+ , values:
719+ [ { key: 14, indexedProperty: "patate" } :+: Nothing
720+ ]
721+ , onUpgradeNeeded: Nothing
722+ }
723+ let
724+ cb =
725+ { onSuccess: const $ pure unit
726+ , onError: show >>> fail >>> launchAff'
682727 , onComplete: pure unit
683728 }
684− tx <- IDBDatabase.transaction db ["store"] ReadOnly
685− store <- IDBTransaction.objectStore tx "store"
686− index <- IDBObjectStore.index store "index"
687− IDBTransaction.onAbort tx (pure unit)
688− IDBTransaction.abort tx
689− cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
690− case cursor of
691− Right _ -> fail "expected TransactionInactiveError"
692− Left err -> name err `shouldEqual` "TransactionInactiveError"
693−
694− tearDown db
695−
696− it "openKeyCursor() - throw InvalidStateError when the index is deleted" do
697− { db } <- setup
698− { storeParams : { keyPath: ["key"], autoIncrement: false }
699− , indexParams : IDBObjectStore.defaultParameters
700− , keyPath : ["indexedProperty"]
701− , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
702− ]
703− , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
704− let cb =
705− { onSuccess : const $ pure unit
706− , onError : show >>> fail >>> launchAff'
729+ tx <- IDBDatabase.transaction db [ "store" ] ReadOnly
730+ store <- IDBTransaction.objectStore tx "store"
731+ index <- IDBObjectStore.index store "index"
732+ IDBTransaction.onAbort tx (pure unit)
733+ IDBTransaction.abort tx
734+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
735+ case cursor of
736+ Right _ -> fail "expected TransactionInactiveError"
737+ Left err -> name err `shouldEqual` "TransactionInactiveError"
738+
739+ tearDown db
740+
741+ it "openKeyCursor() - throw InvalidStateError when the index is deleted" do
742+ { db } <- setup
743+ { storeParams: { keyPath: [ "key" ], autoIncrement: false }
744+ , indexParams: IDBObjectStore.defaultParameters
745+ , keyPath: [ "indexedProperty" ]
746+ , values:
747+ [ { key: 14, indexedProperty: "patate" } :+: Nothing
748+ ]
749+ , onUpgradeNeeded: Just $ \_ tx index -> launchAff' do
750+ let
751+ cb =
752+ { onSuccess: const $ pure unit
753+ , onError: show >>> fail >>> launchAff'
707754 , onComplete: pure unit
708755 }
709− store <- IDBTransaction.objectStore tx "store"
710− IDBObjectStore.deleteIndex store "index"
711− cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
712− case cursor of
713− Right _ -> fail "expected InvalidStateError"
714− Left err -> name err `shouldEqual` "InvalidStateError"
715− }
716−
717− tearDown db
718−
719− it "openCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
720− res <- attempt $ setup
721− { storeParams : { keyPath: ["key"], autoIncrement: false }
722− , indexParams : IDBObjectStore.defaultParameters
723− , keyPath : ["indexedProperty"]
724− , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
725− ]
726− , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
727− let cb =
728− { onSuccess : const $ pure unit
729− , onError : show >>> fail >>> launchAff'
756+ store <- IDBTransaction.objectStore tx "store"
757+ IDBObjectStore.deleteIndex store "index"
758+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
759+ case cursor of
760+ Right _ -> fail "expected InvalidStateError"
761+ Left err -> name err `shouldEqual` "InvalidStateError"
762+ }
763+
764+ tearDown db
765+
766+ it "openCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
767+ res <- attempt $ setup
768+ { storeParams: { keyPath: [ "key" ], autoIncrement: false }
769+ , indexParams: IDBObjectStore.defaultParameters
770+ , keyPath: [ "indexedProperty" ]
771+ , values:
772+ [ { key: 14, indexedProperty: "patate" } :+: Nothing
773+ ]
774+ , onUpgradeNeeded: Just $ \db tx index -> launchAff' do
775+ let
776+ cb =
777+ { onSuccess: const $ pure unit
778+ , onError: show >>> fail >>> launchAff'
730779 , onComplete: pure unit
731780 }
732− IDBTransaction.onAbort tx (pure unit)
733− IDBDatabase.onAbort db (pure unit)
734− IDBTransaction.abort tx
735− cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
736− case cursor of
737− Right _ -> fail "expected InvalidStateError"
738− Left err -> name err `shouldEqual` "InvalidStateError"
739− }
740− case res of
741− Right _ -> fail "expected InvalidStateError"
742− _ -> pure unit
743−
744− it "openCursor() - throw TransactionInactiveError on aborted transaction" do
745− { db } <- setup
746− { storeParams : { keyPath: ["key"], autoIncrement: false }
747− , indexParams : IDBObjectStore.defaultParameters
748− , keyPath : ["indexedProperty"]
749− , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
750− ]
751− , onUpgradeNeeded : Nothing
752− }
753− let cb =
754− { onSuccess : const $ pure unit
755− , onError : show >>> fail >>> launchAff'
781+ IDBTransaction.onAbort tx (pure unit)
782+ IDBDatabase.onAbort db (pure unit)
783+ IDBTransaction.abort tx
784+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
785+ case cursor of
786+ Right _ -> fail "expected InvalidStateError"
787+ Left err -> name err `shouldEqual` "InvalidStateError"
788+ }
789+ case res of
790+ Right _ -> fail "expected InvalidStateError"
791+ _ -> pure unit
792+
793+ it "openCursor() - throw TransactionInactiveError on aborted transaction" do
794+ { db } <- setup
795+ { storeParams: { keyPath: [ "key" ], autoIncrement: false }
796+ , indexParams: IDBObjectStore.defaultParameters
797+ , keyPath: [ "indexedProperty" ]
798+ , values:
799+ [ { key: 14, indexedProperty: "patate" } :+: Nothing
800+ ]
801+ , onUpgradeNeeded: Nothing
802+ }
803+ let
804+ cb =
805+ { onSuccess: const $ pure unit
806+ , onError: show >>> fail >>> launchAff'
756807 , onComplete: pure unit
757808 }
758− tx <- IDBDatabase.transaction db ["store"] ReadOnly
759− store <- IDBTransaction.objectStore tx "store"
760− index <- IDBObjectStore.index store "index"
761− IDBTransaction.onAbort tx (pure unit)
762− IDBTransaction.abort tx
763− cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
764− case cursor of
765− Right _ -> fail "expected TransactionInactiveError"
766− Left err -> name err `shouldEqual` "TransactionInactiveError"
767−
768− tearDown db
769−
770− it "openCursor() - throw InvalidStateError when the index is deleted" do
771− { db } <- setup
772− { storeParams : { keyPath: ["key"], autoIncrement: false }
773− , indexParams : IDBObjectStore.defaultParameters
774− , keyPath : ["indexedProperty"]
775− , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
776− ]
777− , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
778− let cb =
779− { onSuccess : const $ pure unit
780− , onError : show >>> fail >>> launchAff'
809+ tx <- IDBDatabase.transaction db [ "store" ] ReadOnly
810+ store <- IDBTransaction.objectStore tx "store"
811+ index <- IDBObjectStore.index store "index"
812+ IDBTransaction.onAbort tx (pure unit)
813+ IDBTransaction.abort tx
814+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
815+ case cursor of
816+ Right _ -> fail "expected TransactionInactiveError"
817+ Left err -> name err `shouldEqual` "TransactionInactiveError"
818+
819+ tearDown db
820+
821+ it "openCursor() - throw InvalidStateError when the index is deleted" do
822+ { db } <- setup
823+ { storeParams: { keyPath: [ "key" ], autoIncrement: false }
824+ , indexParams: IDBObjectStore.defaultParameters
825+ , keyPath: [ "indexedProperty" ]
826+ , values:
827+ [ { key: 14, indexedProperty: "patate" } :+: Nothing
828+ ]
829+ , onUpgradeNeeded: Just $ \db tx index -> launchAff' do
830+ let
831+ cb =
832+ { onSuccess: const $ pure unit
833+ , onError: show >>> fail >>> launchAff'
781834 , onComplete: pure unit
782835 }
783− store <- IDBTransaction.objectStore tx "store"
784− IDBObjectStore.deleteIndex store "index"
785− cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
786− case cursor of
787− Right _ -> fail "expected InvalidStateError"
788− Left err -> name err `shouldEqual` "InvalidStateError"
789− }
790−
791− tearDown db
792−
793− it "getKey() - multiEntry - adding keys" do
794− { db } <- setup
795− { storeParams : IDBDatabase.defaultParameters
796− , indexParams : { unique: false, multiEntry: true }
797− , keyPath : ["name"]
798− , values : [ { name: ["patate", "autruche"] } :+: (Just $ toKey 1)
799− , { name: ["bob"] } :+: (Just $ toKey 2)
800− ]
801− , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
802− key <- IDBIndex.getKey index (IDBKeyRange.only "patate")
803− key `shouldEqual` (Just $ toKey 1)
804−
805− key <- IDBIndex.getKey index (IDBKeyRange.only "autruche")
806− key `shouldEqual` (Just $ toKey 1)
807−
808− key <- IDBIndex.getKey index (IDBKeyRange.only "bob")
809− key `shouldEqual` (Just $ toKey 2)
810− }
811− tearDown db
812−
813−
814− it "get() - returns the record with the first key in the range" do
815− { db } <- setup
816− { storeParams : { keyPath: ["key"], autoIncrement: false }
817− , indexParams : IDBObjectStore.defaultParameters
818− , keyPath : ["indexedProperty"]
819− , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
820− , { key: 42, indexedProperty: "autruche" } :+: Nothing
821− , { key: 1337, indexedProperty: "baguette" } :+: Nothing
822− ]
823− , onUpgradeNeeded : Nothing
824− }
825−
826− tx <- IDBDatabase.transaction db ["store"] ReadOnly
827− store <- IDBTransaction.objectStore tx "store"
828− index <- IDBObjectStore.index store "index"
829− val <- IDBIndex.get index (IDBKeyRange.lowerBound "autruche" false)
830− ((\r -> r.key) <$> val) `shouldEqual` (Just 42)
831−
832− tearDown db
833−
834− describe "IDBCursor" do
835− let
836+ store <- IDBTransaction.objectStore tx "store"
837+ IDBObjectStore.deleteIndex store "index"
838+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
839+ case cursor of
840+ Right _ -> fail "expected InvalidStateError"
841+ Left err -> name err `shouldEqual` "InvalidStateError"
842+ }
843+
844+ tearDown db
845+
846+ it "getKey() - multiEntry - adding keys" do
847+ { db } <- setup
848+ { storeParams: IDBDatabase.defaultParameters
849+ , indexParams: { unique: false, multiEntry: true }
850+ , keyPath: [ "name" ]
851+ , values:
852+ [ { name: [ "patate", "autruche" ] } :+: (Just $ toKey 1)
853+ , { name: [ "bob" ] } :+: (Just $ toKey 2)
854+ ]
855+ , onUpgradeNeeded: Just $ \_ _ index -> launchAff' do
856+ key <- IDBIndex.getKey index (IDBKeyRange.only "patate")
857+ key `shouldEqual` (Just $ toKey 1)
858+
859+ key' <- IDBIndex.getKey index (IDBKeyRange.only "autruche")
860+ key' `shouldEqual` (Just $ toKey 1)
861+
862+ key'' <- IDBIndex.getKey index (IDBKeyRange.only "bob")
863+ key'' `shouldEqual` (Just $ toKey 2)
864+ }
865+ tearDown db
866+
867+ it "get() - returns the record with the first key in the range" do
868+ { db } <- setup
869+ { storeParams: { keyPath: [ "key" ], autoIncrement: false }
870+ , indexParams: IDBObjectStore.defaultParameters
871+ , keyPath: [ "indexedProperty" ]
872+ , values:
873+ [ { key: 14, indexedProperty: "patate" } :+: Nothing
874+ , { key: 42, indexedProperty: "autruche" } :+: Nothing
875+ , { key: 1337, indexedProperty: "baguette" } :+: Nothing
876+ ]
877+ , onUpgradeNeeded: Nothing
878+ }
879+
880+ tx <- IDBDatabase.transaction db [ "store" ] ReadOnly
881+ store <- IDBTransaction.objectStore tx "store"
882+ index <- IDBObjectStore.index store "index"
883+ val <- IDBIndex.get index (IDBKeyRange.lowerBound "autruche" false)
884+ ((\r -> r.key) <$> val) `shouldEqual` (Just 42)
885+
886+ tearDown db
887+
888+ describe "IDBCursor" do
889+ let
836890 tearDown db = do
837891 IDBDatabase.close db
838892 _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
839893 pure unit
840894
841− setup :: forall value e e'.
842− { storeParams :: { keyPath :: Array String, autoIncrement :: Boolean }
843− , indexParams :: { unique :: Boolean, multiEntry :: Boolean }
844− , values :: Array (Tuple value (Maybe Key))
845− , keyPath :: Array String
846− , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Eff (idb :: IDB, avar :: AVAR, exception :: EXCEPTION | e') Unit)
847− } -> Aff (idb :: IDB, avar :: AVAR | e) { db :: Database, index :: Index, store :: ObjectStore }
895+ setup
896+ :: forall value
897+ . { storeParams :: { keyPath :: Array String, autoIncrement :: Boolean }
898+ , indexParams :: { unique :: Boolean, multiEntry :: Boolean }
899+ , values :: Array (Tuple value (Maybe Key))
900+ , keyPath :: Array String
901+ , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Effect Unit)
902+ }
903+ -> Aff { db :: Database, index :: Index, store :: ObjectStore }
848904 setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
849− let onUpgradeNeeded' var db tx _ = launchAff' do
850− store <- IDBDatabase.createObjectStore db "store" storeParams
851− _ <- traverse (uncurry (IDBObjectStore.add store)) values
852− index <- IDBObjectStore.createIndex store "index" keyPath indexParams
853− liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
854− putVar var { db, index, store }
855−
856− var <- makeVar
857− db <- IDBFactory.open "db" Nothing
858− { onUpgradeNeeded : Just (onUpgradeNeeded' var)
859− , onBlocked : Nothing
905+ let
906+ onUpgradeNeeded' var db tx _ = launchAff' do
907+ store <- IDBDatabase.createObjectStore db "store" storeParams
908+ _ <- traverse (uncurry (IDBObjectStore.add store)) values
909+ index <- IDBObjectStore.createIndex store "index" keyPath indexParams
910+ liftEffect $ maybe (pure unit) identity (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
911+ AVar.put { db, index, store } var
912+
913+ var <- AVar.empty
914+ db <- IDBFactory.open "db" Nothing
915+ { onUpgradeNeeded: Just (onUpgradeNeeded' var)
916+ , onBlocked: Nothing
860917 }
861− takeVar var
862−
863− it "continue() - iterate to the next record" do
864− { db } <- setup
865− { storeParams : IDBDatabase.defaultParameters
866− , indexParams : IDBObjectStore.defaultParameters
867− , keyPath : []
868− , values : [ "cupcake" :+: (Just $ toKey 4)
869− , "pancake" :+: (Just $ toKey 2)
870− , "pie" :+: (Just $ toKey 1)
871− , "pie" :+: (Just $ toKey 3)
872− ]
873− , onUpgradeNeeded: Nothing
874− }
875− let cb vdone vvals =
918+ AVar.take var
919+
920+ it "continue() - iterate to the next record" do
921+ { db } <- setup
922+ { storeParams: IDBDatabase.defaultParameters
923+ , indexParams: IDBObjectStore.defaultParameters
924+ , keyPath: []
925+ , values:
926+ [ "cupcake" :+: (Just $ toKey 4)
927+ , "pancake" :+: (Just $ toKey 2)
928+ , "pie" :+: (Just $ toKey 1)
929+ , "pie" :+: (Just $ toKey 3)
930+ ]
931+ , onUpgradeNeeded: Nothing
932+ }
933+ let
934+ cb vdone vvals =
876935 { onComplete: launchAff' do
877− putVar vdone unit
936+ AVar.put unit vdone
878937
879− , onError: \error -> launchAff' do
938+ , onError: \error -> launchAff' do
880939 fail $ "unexpected error: " <> show error
881940
882941 , onSuccess: \cursor -> launchAff' do
883− vals <- takeVar vvals
942+ vals <- AVar.take vvals
884943 pure (IDBCursor.value cursor) >>= shouldEqual (maybe "" _.v $ head vals)
885− IDBCursor.primaryKey cursor >>= shouldEqual (maybe (toKey 0) _.k $ head vals)
886− putVar vvals (drop 1 vals)
944+ IDBCursor.primaryKey cursor >>= shouldEqual (maybe (toKey 0) _.k $ head vals)
945+ AVar.put (drop 1 vals) vvals
887946 IDBCursor.continue cursor none
888947 }
889− vdone <- makeVar
890− vvals <- makeVar'
891− [ { v: "pie" , k: toKey 1 }
892− , { v: "pancake", k: toKey 2 }
893− , { v: "pie" , k: toKey 3 }
894− , { v: "cupcake", k: toKey 4 }
895− ]
896− tx <- IDBDatabase.transaction db ["store"] ReadOnly
897− store <- IDBTransaction.objectStore tx "store"
898− IDBObjectStore.openCursor store Nothing Next (cb vdone vvals)
899− takeVar vdone
900− tearDown db
901−
902− it "continue() - attempt to iterate in the wrong direction" do
903− { db } <- setup
904− { storeParams : IDBDatabase.defaultParameters
905− , indexParams : IDBObjectStore.defaultParameters
906− , keyPath : []
907− , values : [ "cupcake" :+: (Just $ toKey 4)
908− , "pancake" :+: (Just $ toKey 2)
909− , "pie" :+: (Just $ toKey 1)
910− , "pie" :+: (Just $ toKey 3)
911− ]
912− , onUpgradeNeeded: Nothing
913− }
914− let cb vdone =
948+ vdone <- AVar.empty
949+ vvals <- AVar.new
950+ [ { v: "pie", k: toKey 1 }
951+ , { v: "pancake", k: toKey 2 }
952+ , { v: "pie", k: toKey 3 }
953+ , { v: "cupcake", k: toKey 4 }
954+ ]
955+ tx <- IDBDatabase.transaction db [ "store" ] ReadOnly
956+ store <- IDBTransaction.objectStore tx "store"
957+ IDBObjectStore.openCursor store Nothing Next (cb vdone vvals)
958+ AVar.take vdone
959+ tearDown db
960+
961+ it "continue() - attempt to iterate in the wrong direction" do
962+ { db } <- setup
963+ { storeParams: IDBDatabase.defaultParameters
964+ , indexParams: IDBObjectStore.defaultParameters
965+ , keyPath: []
966+ , values:
967+ [ "cupcake" :+: (Just $ toKey 4)
968+ , "pancake" :+: (Just $ toKey 2)
969+ , "pie" :+: (Just $ toKey 1)
970+ , "pie" :+: (Just $ toKey 3)
971+ ]
972+ , onUpgradeNeeded: Nothing
973+ }
974+ let
975+ cb vdone =
915976 { onComplete: launchAff' do
916977 fail $ "shouldn't complete"
917978
918− , onError: \error -> launchAff' do
979+ , onError: \error -> launchAff' do
919980 fail $ "unexpected error: " <> show error
920981
921982 , onSuccess: \cursor -> launchAff' do
922983 res <- attempt $ IDBCursor.continue cursor (Just 1)
923984 case res of
924− Left err -> do
985+ Left err -> do
925986 name err `shouldEqual` "DataError"
926− putVar vdone unit
987+ AVar.put unit vdone
927988 Right _ -> do
928989 fail "expected continue to fail"
929990 }
930− vdone <- makeVar
931− tx <- IDBDatabase.transaction db ["store"] ReadOnly
932− store <- IDBTransaction.objectStore tx "store"
933− IDBObjectStore.openCursor store Nothing Next (cb vdone)
934− takeVar vdone
935− tearDown db
936−
937−
938− it "advance() - iterate cursor number of times specified by count" do
939− { db } <- setup
940− { storeParams : { keyPath: ["pKey"], autoIncrement: false }
941− , indexParams : IDBObjectStore.defaultParameters
942− , keyPath : []
943− , values : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
944− , { pKey: "pkey_1", iKey: "ikey_1" } :+: Nothing
945− , { pKey: "pkey_2", iKey: "ikey_2" } :+: Nothing
946− , { pKey: "pkey_3", iKey: "ikey_3" } :+: Nothing
947− ]
948− , onUpgradeNeeded: Nothing
949− }
950− let cb vdone vjump =
991+ vdone <- AVar.empty
992+ tx <- IDBDatabase.transaction db [ "store" ] ReadOnly
993+ store <- IDBTransaction.objectStore tx "store"
994+ IDBObjectStore.openCursor store Nothing Next (cb vdone)
995+ AVar.take vdone
996+ tearDown db
997+
998+ it "advance() - iterate cursor number of times specified by count" do
999+ { db } <- setup
1000+ { storeParams: { keyPath: [ "pKey" ], autoIncrement: false }
1001+ , indexParams: IDBObjectStore.defaultParameters
1002+ , keyPath: []
1003+ , values:
1004+ [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
1005+ , { pKey: "pkey_1", iKey: "ikey_1" } :+: Nothing
1006+ , { pKey: "pkey_2", iKey: "ikey_2" } :+: Nothing
1007+ , { pKey: "pkey_3", iKey: "ikey_3" } :+: Nothing
1008+ ]
1009+ , onUpgradeNeeded: Nothing
1010+ }
1011+ let
1012+ cb vdone vjump =
9511013 { onComplete: launchAff' do
952− putVar vdone unit
1014+ AVar.put unit vdone
9531015
954− , onError: \error -> launchAff' do
1016+ , onError: \error -> launchAff' do
9551017 fail $ "unexpected error: " <> show error
9561018
9571019 , onSuccess: \cursor -> launchAff' do
958− jump <- takeVar vjump
959− if jump
960− then do
961− IDBCursor.advance cursor 3
962− else do
963− let value = IDBCursor.value cursor
964− value.pKey `shouldEqual` "pkey_3"
965− value.iKey `shouldEqual` "ikey_3"
966− IDBCursor.continue cursor none
967− putVar vjump false
1020+ jump <- AVar.take vjump
1021+ if jump then do
1022+ IDBCursor.advance cursor 3
1023+ else do
1024+ let value = IDBCursor.value cursor
1025+ value.pKey `shouldEqual` "pkey_3"
1026+ value.iKey `shouldEqual` "ikey_3"
1027+ IDBCursor.continue cursor none
1028+ AVar.put false vjump
9681029 }
969− vdone <- makeVar
970− vjump <- makeVar' true
971− tx <- IDBDatabase.transaction db ["store"] ReadOnly
972− store <- IDBTransaction.objectStore tx "store"
973− IDBObjectStore.openCursor store Nothing Next (cb vdone vjump)
974− takeVar vdone
975− tearDown db
976−
977− it "delete() - remove a record from the object store" do
978− { db } <- setup
979− { storeParams : { keyPath: ["pKey"], autoIncrement: false }
980− , indexParams : IDBObjectStore.defaultParameters
981− , keyPath : []
982− , values : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
983− , { pKey: "pkey_1", iKey: "ikey_1" } :+: Nothing
984− , { pKey: "pkey_2", iKey: "ikey_2" } :+: Nothing
985− , { pKey: "pkey_3", iKey: "ikey_3" } :+: Nothing
986− ]
987− , onUpgradeNeeded: Nothing
988− }
989− let cb vdone store =
1030+ vdone <- AVar.empty
1031+ vjump <- AVar.new true
1032+ tx <- IDBDatabase.transaction db [ "store" ] ReadOnly
1033+ store <- IDBTransaction.objectStore tx "store"
1034+ IDBObjectStore.openCursor store Nothing Next (cb vdone vjump)
1035+ AVar.take vdone
1036+ tearDown db
1037+
1038+ it "delete() - remove a record from the object store" do
1039+ { db } <- setup
1040+ { storeParams: { keyPath: [ "pKey" ], autoIncrement: false }
1041+ , indexParams: IDBObjectStore.defaultParameters
1042+ , keyPath: []
1043+ , values:
1044+ [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
1045+ , { pKey: "pkey_1", iKey: "ikey_1" } :+: Nothing
1046+ , { pKey: "pkey_2", iKey: "ikey_2" } :+: Nothing
1047+ , { pKey: "pkey_3", iKey: "ikey_3" } :+: Nothing
1048+ ]
1049+ , onUpgradeNeeded: Nothing
1050+ }
1051+ let
1052+ cb vdone store =
9901053 { onComplete: launchAff' do
9911054 mval <- map _.pKey <$> IDBIndex.get store (IDBKeyRange.only "pkey_0")
9921055 mval `shouldEqual` (Nothing :: Maybe String)
993− putVar vdone unit
1056+ AVar.put unit vdone
9941057
995− , onError: \error -> launchAff' do
1058+ , onError: \error -> launchAff' do
9961059 fail $ "unexpected error: " <> show error
9971060
9981061 , onSuccess: \cursor -> launchAff' do
@@ -1001,29 +1064,31 @@ main = runMocha do
10011064 IDBCursor.delete cursor
10021065 IDBCursor.advance cursor 4
10031066 }
1004− vdone <- makeVar
1005− tx <- IDBDatabase.transaction db ["store"] ReadWrite
1006− store <- IDBTransaction.objectStore tx "store"
1007− IDBObjectStore.openCursor store Nothing Next (cb vdone store)
1008− takeVar vdone
1009− tearDown db
1010−
1011− it "update() - modify a record in the object store" do
1012− { db } <- setup
1013− { storeParams : { keyPath: ["pKey"], autoIncrement: false }
1014− , indexParams : IDBObjectStore.defaultParameters
1015− , keyPath : []
1016− , values : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
1017− ]
1018− , onUpgradeNeeded: Nothing
1019− }
1020− let cb vdone store =
1067+ vdone <- AVar.empty
1068+ tx <- IDBDatabase.transaction db [ "store" ] ReadWrite
1069+ store <- IDBTransaction.objectStore tx "store"
1070+ IDBObjectStore.openCursor store Nothing Next (cb vdone store)
1071+ AVar.take vdone
1072+ tearDown db
1073+
1074+ it "update() - modify a record in the object store" do
1075+ { db } <- setup
1076+ { storeParams: { keyPath: [ "pKey" ], autoIncrement: false }
1077+ , indexParams: IDBObjectStore.defaultParameters
1078+ , keyPath: []
1079+ , values:
1080+ [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
1081+ ]
1082+ , onUpgradeNeeded: Nothing
1083+ }
1084+ let
1085+ cb vdone store =
10211086 { onComplete: launchAff' do
10221087 mval <- map _.iKey <$> IDBIndex.get store (IDBKeyRange.only "pkey_0")
10231088 mval `shouldEqual` (Just "patate")
1024− putVar vdone unit
1089+ AVar.put unit vdone
10251090
1026− , onError: \error -> launchAff' do
1091+ , onError: \error -> launchAff' do
10271092 fail $ "unexpected error: " <> show error
10281093
10291094 , onSuccess: \cursor -> launchAff' do
@@ -1033,27 +1098,29 @@ main = runMocha do
10331098 key `shouldEqual` toKey "pkey_0"
10341099 IDBCursor.advance cursor 4
10351100 }
1036− vdone <- makeVar
1037− tx <- IDBDatabase.transaction db ["store"] ReadWrite
1038− store <- IDBTransaction.objectStore tx "store"
1039− IDBObjectStore.openCursor store Nothing Next (cb vdone store)
1040− takeVar vdone
1041− tearDown db
1042−
1043− it "update() - throw ReadOnlyError after update on ReadOnly transaction" do
1044− { db } <- setup
1045− { storeParams : { keyPath: ["pKey"], autoIncrement: false }
1046− , indexParams : IDBObjectStore.defaultParameters
1047− , keyPath : []
1048− , values : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
1049− ]
1050− , onUpgradeNeeded: Nothing
1051− }
1052− let cb vdone =
1101+ vdone <- AVar.empty
1102+ tx <- IDBDatabase.transaction db [ "store" ] ReadWrite
1103+ store <- IDBTransaction.objectStore tx "store"
1104+ IDBObjectStore.openCursor store Nothing Next (cb vdone store)
1105+ AVar.take vdone
1106+ tearDown db
1107+
1108+ it "update() - throw ReadOnlyError after update on ReadOnly transaction" do
1109+ { db } <- setup
1110+ { storeParams: { keyPath: [ "pKey" ], autoIncrement: false }
1111+ , indexParams: IDBObjectStore.defaultParameters
1112+ , keyPath: []
1113+ , values:
1114+ [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
1115+ ]
1116+ , onUpgradeNeeded: Nothing
1117+ }
1118+ let
1119+ cb vdone =
10531120 { onComplete: launchAff' do
10541121 fail $ "shouldn't complete"
10551122
1056− , onError: \error -> launchAff' do
1123+ , onError: \error -> launchAff' do
10571124 fail $ "unexpected error: " <> show error
10581125
10591126 , onSuccess: \cursor -> launchAff' do
@@ -1061,13 +1128,14 @@ main = runMocha do
10611128 case res of
10621129 Left err -> do
10631130 name err `shouldEqual` "ReadOnlyError"
1064− putVar vdone unit
1131+ AVar.put unit vdone
10651132 Right _ ->
10661133 fail $ "expected ReadOnlyError"
10671134 }
1068− vdone <- makeVar
1069− tx <- IDBDatabase.transaction db ["store"] ReadOnly
1070− store <- IDBTransaction.objectStore tx "store"
1071− IDBObjectStore.openCursor store Nothing Next (cb vdone)
1072− takeVar vdone
1073− tearDown db
1135+ vdone <- AVar.empty
1136+ tx <- IDBDatabase.transaction db [ "store" ] ReadOnly
1137+ store <- IDBTransaction.objectStore tx "store"
1138+ IDBObjectStore.openCursor store Nothing Next (cb vdone)
1139+ AVar.take vdone
1140+ tearDown db
1141+