@@ -2,1060 +2,995 @@ module Test.Main where
22
33import Prelude
44
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)
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, message)
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
3636
37−infixr 7 Tuple as :+:
3837
39−launchAff' :: forall a. Aff a -> Effect Unit
40−launchAff' =
41− launchAff_ <<< void
38+infixr 7 Tuple as :+:
4239
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
40+launchAff' :: forall a e. Aff e a -> Eff (exception :: EXCEPTION | e) Unit
41+launchAff' aff =
42+ pure unit <* (launchAff aff)
4743
48−main :: Effect Unit
49−main = do
50− launchAff_ $ runSpec [ consoleReporter ] $ do
51− describe "IDBFactory" do
52− let
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
5348 tearDown name version db = do
5449 IDBDatabase.close db
5550 version' <- IDBFactory.deleteDatabase name
56− liftEffect $ log $ show version'
5751 version' `shouldEqual` version
5852
59− it "open default" do
60− let
61− name = "db-default"
53+ it "open default" do
54+ let name = "db-default"
6255 version = 1
63− db <- IDBFactory.open name Nothing
64− { onUpgradeNeeded: Nothing
65− , onBlocked: Nothing
66− }
67− IDBDatabase.name db `shouldEqual` name
68− tearDown name version db
56+ db <- IDBFactory.open name Nothing
57+ { onUpgradeNeeded : Nothing
58+ , onBlocked : Nothing
59+ }
60+ IDBDatabase.name db `shouldEqual` name
61+ tearDown name version db
6962
70− it "open specific version" do
71− let
72− name = "db-specific"
73− version = 14
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
8063
81− it "open specific version -> close -> open latest" do
82− let
83− name = "db-latest"
64+ it "open specific version" do
65+ let name = "db-specific"
8466 version = 14
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
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
9673
97− it "open + onUpgradeNeed" do
98− let
99− name = "db-upgrade-needed"
74+
75+ it "open specific version -> close -> open latest" do
76+ let name = "db-latest"
77+ 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+
91+ it "open + onUpgradeNeed" do
92+ let name = "db-upgrade-needed"
10093 version = 1
101− callback (Tuple varName varVersion) db _ { oldVersion } = do
102− _ <- launchAff $ modifyAVar (const $ IDBDatabase.name db) varName
103− _ <- launchAff $ modifyAVar (const $ oldVersion) varVersion
94+ callback var db _ = do
95+ _ <- launchAff $ modifyVar (const $ IDBDatabase.name db) var
10496 pure unit
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"
97+ var <- makeVar' "-"
98+ db <- IDBFactory.open name Nothing
99+ { onUpgradeNeeded : Just (callback var)
100+ , onBlocked : Nothing
101+ }
102+ name <- peekVar var
103+ name `shouldEqual` name
104+ tearDown name version db
105+
106+
107+ it "open + onBlocked" do
108+ let name = "db-blocked"
120109 version = 14
121110 callback var = do
122− _ <- launchAff $ modifyAVar (const $ "db-blocked") var
111+ _ <- launchAff $ modifyVar (const $ "db-blocked") var
123112 pure unit
124113
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
114+ var <- makeVar' "-"
115+ db01 <- IDBFactory.open name Nothing
116+ { onUpgradeNeeded : Nothing
117+ , onBlocked : Nothing
118+ }
119+ _ <- forkAff do
120+ delay (Milliseconds 100.0)
121+ IDBDatabase.close db01
133122
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
123+ db02 <- IDBFactory.open name (Just version)
124+ { onUpgradeNeeded : Nothing
125+ , onBlocked : Just (callback var)
126+ }
127+ name <- peekVar var
128+ name `shouldEqual` name
129+ tearDown name version db02
130+
131+ describe "IDBKeyRange" do
132+ it "only(int)" do
133+ let key = 14
146134 range = IDBKeyRange.only key
147− IDBKeyRange.includes range (toKey key) `shouldEqual` true
135+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
148136
149− it "only(string)" do
150− let
151− key = "patate"
137+ it "only(string)" do
138+ let key = "patate"
152139 range = IDBKeyRange.only key
153− IDBKeyRange.includes range (toKey key) `shouldEqual` true
140+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
154141
155− it "only(float)" do
156− let
157− key = 14.42
142+ it "only(float)" do
143+ let key = 14.42
158144 range = IDBKeyRange.only key
159− IDBKeyRange.includes range (toKey key) `shouldEqual` true
145+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
160146
161− it "only(date)" do
162− let
163− mkey = DateTime
147+ it "only(date)" do
148+ let mkey = DateTime
164149 <$> (Date.canonicalDate <$> toEnum 2017 <*> toEnum 6 <*> toEnum 23)
165150 <*> (Time <$> toEnum 17 <*> toEnum 59 <*> toEnum 34 <*> toEnum 42)
166151
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
152+ case mkey of
153+ Nothing ->
154+ fail "unable to create datetime"
155+ Just key -> do
156+ let range = IDBKeyRange.only key
157+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
173158
174− it "only([int])" do
175− let
176− key = [ 14, 42 ]
159+ it "only([int])" do
160+ let key = [14, 42]
177161 range = IDBKeyRange.only key
178− IDBKeyRange.includes range (toKey key) `shouldEqual` true
162+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
179163
180− it "only([string])" do
181− let
182− key = [ "patate", "autruche" ]
164+ it "only([string])" do
165+ let key = ["patate", "autruche"]
183166 range = IDBKeyRange.only key
184− IDBKeyRange.includes range (toKey key) `shouldEqual` true
167+ IDBKeyRange.includes range (toKey key) `shouldEqual` true
185168
186− it "lowerBound(14, open)" do
187− let
188− key = 14
189− open = true
169+ it "lowerBound(14, open)" do
170+ let key = 14
171+ open = true
190172 range = IDBKeyRange.lowerBound key open
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
173+ IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
174+ IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
175+ IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false
176+
177+ it "lowerBound(14, close)" do
178+ let key = 14
179+ open = false
199180 range = IDBKeyRange.lowerBound key open
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
181+ IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
182+ IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
183+ IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false
184+
185+ it "upperBound(14, open)" do
186+ let key = 14
187+ open = true
208188 range = IDBKeyRange.upperBound key open
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
189+ IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
190+ IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
191+ IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true
192+
193+ it "upperBound(14, close)" do
194+ let key = 14
195+ open = false
217196 range = IDBKeyRange.upperBound key open
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
197+ IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
198+ IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
199+ IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true
200+
201+ it "bound(42, 14, open, open) => Nothing" do
202+ let lower = 42
203+ upper = 14
226204 lowerOpen = true
227205 upperOpen = true
228− mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
229− isNothing mrange `shouldEqual` true
206+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
207+ isNothing mrange `shouldEqual` true
230208
231− it "bound(14, 42, open, open)" do
232− let
233− lower = 14
234− upper = 42
209+ it "bound(14, 42, open, open)" do
210+ let lower = 14
211+ upper = 42
235212 lowerOpen = true
236213 upperOpen = true
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
214+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
215+ case mrange of
216+ Nothing ->
217+ fail "invalid range provided"
218+ Just range -> do
219+ IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
220+ IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
221+ IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
222+ IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
223+ IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
224+ IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
225+
226+ it "bound(14, 42, open, close)" do
227+ let lower = 14
228+ upper = 42
253229 lowerOpen = true
254230 upperOpen = false
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
231+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
232+ case mrange of
233+ Nothing ->
234+ fail "invalid range provided"
235+ Just range -> do
236+ IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
237+ IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
238+ IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
239+ IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
240+ IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
241+ IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
242+
243+ it "bound(14, 42, close, open)" do
244+ let lower = 14
245+ upper = 42
271246 lowerOpen = false
272247 upperOpen = true
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
248+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
249+ case mrange of
250+ Nothing ->
251+ fail "invalid range provided"
252+ Just range -> do
253+ IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
254+ IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
255+ IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
256+ IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
257+ IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
258+ IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
259+
260+ it "bound(14, 42, close, close)" do
261+ let lower = 14
262+ upper = 42
289263 lowerOpen = false
290264 upperOpen = false
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
265+ mrange = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
266+ case mrange of
267+ Nothing ->
268+ fail "invalid range provided"
269+ Just range -> do
270+ IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
271+ IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
272+ IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
273+ IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
274+ IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
275+ IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
276+
277+ it "can access attributes of a range" do
278+ let range = IDBKeyRange.lowerBound 14 false
279+ IDBKeyRange.lower range `shouldEqual` (Just $ toKey 14)
280+ IDBKeyRange.upper range `shouldEqual` none
281+ IDBKeyRange.lowerOpen range `shouldEqual` false
282+ IDBKeyRange.upperOpen range `shouldEqual` true
283+
284+ describe "IDBDatabase" do
285+ let
312286 tearDown db = do
313287 IDBDatabase.close db
314288 _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
315289 pure unit
316290
317291 setup storeParams = do
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
292+ let onUpgradeNeeded var db _ = launchAff' do
293+ store <- IDBDatabase.createObjectStore db "store" storeParams
294+ _ <- putVar var { db, store }
295+ pure unit
296+
297+ var <- makeVar
298+ db <- IDBFactory.open "db" Nothing
299+ { onUpgradeNeeded : Just (onUpgradeNeeded var)
300+ , onBlocked : Nothing
328301 }
329302
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
303+ takeVar var
304+
305+ it "createObjectStore (keyPath: [], autoIncrement: true)" do
306+ { db, store } <- setup { keyPath: [], autoIncrement: true }
307+ IDBObjectStore.name store `shouldEqual` "store"
308+ IDBObjectStore.keyPath store `shouldEqual` []
309+ IDBObjectStore.autoIncrement store `shouldEqual` true
310+ IDBObjectStore.indexNames store `shouldEqual` []
311+ tearDown db
312+
313+ it "createObjectStore (keyPath: [\"patate\"], autoIncrement: true)" do
314+ { db, store } <- setup { keyPath: ["patate"], autoIncrement: true }
315+ IDBObjectStore.name store `shouldEqual` "store"
316+ IDBObjectStore.keyPath store `shouldEqual` ["patate"]
317+ IDBObjectStore.autoIncrement store `shouldEqual` true
318+ IDBObjectStore.indexNames store `shouldEqual` []
319+ tearDown db
320+
321+ it "createObjectStore (keyPath: [\"a\", \"b\"], autoIncrement: false)" do
322+ { db, store } <- setup { keyPath: ["patate", "autruche"], autoIncrement: false }
323+ IDBObjectStore.name store `shouldEqual` "store"
324+ IDBObjectStore.keyPath store `shouldEqual` ["patate", "autruche"]
325+ IDBObjectStore.autoIncrement store `shouldEqual` false
326+ IDBObjectStore.indexNames store `shouldEqual` []
327+ tearDown db
328+
329+ it "deleteObjectStore" do
330+ let onUpgradeNeeded var db _ = launchAff' do
359331 _ <- IDBDatabase.deleteObjectStore db "store"
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'
332+ putVar var true
333+
334+ var <- makeVar
335+ { db, store } <- setup IDBObjectStore.defaultParameters
336+ IDBDatabase.close db
337+ db <- IDBFactory.open "db" (Just 999) { onUpgradeNeeded : Just (onUpgradeNeeded var)
338+ , onBlocked : Nothing
339+ }
340+ deleted <- takeVar var
341+ deleted `shouldEqual` true
342+ tearDown db
372343
373− describe "IDBObjectStore" do
374− let
344+
345+ describe "IDBObjectStore" do
346+ let
375347 tearDown db = do
376348 IDBDatabase.close db
377349 _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
378350 pure unit
379351
380352 setup { storeParams, onUpgradeNeeded } = do
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
353+ let onUpgradeNeeded' var db _ = launchAff' do
354+ store <- IDBDatabase.createObjectStore db "store" storeParams
355+ liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure store)
356+ putVar var { db, store }
357+
358+ var <- makeVar
359+ db <- IDBFactory.open "db" Nothing
360+ { onUpgradeNeeded : Just (onUpgradeNeeded' var)
361+ , onBlocked : Nothing
391362 }
392363
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)
364+ takeVar var
365+
366+ it "add()" do
367+ date <- liftEff $ toDateTime <$> now
368+ { db } <- setup
369+ { storeParams: { autoIncrement: true, keyPath: [] }
370+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
371+ -- no key
372+ key <- IDBObjectStore.add store "patate" none
373+ (toKey 1) `shouldEqual` key
374+
375+ -- int key
376+ key <- IDBObjectStore.add store "patate" (Just 14)
377+ (toKey 14) `shouldEqual` key
378+
379+ -- number key
380+ key <- IDBObjectStore.add store "patate" (Just 14.42)
381+ (toKey 14.42) `shouldEqual` key
382+
383+ -- string key
384+ key <- IDBObjectStore.add store "patate" (Just "key")
385+ (toKey "key") `shouldEqual` key
386+
387+ -- date key
388+ key <- IDBObjectStore.add store "patate" (Just date)
389+ (toKey date) `shouldEqual` key
390+
391+ -- array key
392+ key <- IDBObjectStore.add store "patate" (Just $ toKey [14, 42])
393+ (toKey [14, 42]) `shouldEqual` key
394+ }
395+ tearDown db
396+
397+ it "clear()" do
398+ { db } <- setup
399+ { storeParams: IDBObjectStore.defaultParameters
400+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
401+ key <- IDBObjectStore.add store "patate" (Just 14)
402+ _ <- IDBObjectStore.clear store
403+ val <- IDBObjectStore.get store (IDBKeyRange.only key)
404+ val `shouldEqual` (Nothing :: Maybe String)
405+ }
406+ tearDown db
407+
408+ it "count()" do
409+ { db } <- setup
410+ { storeParams: IDBObjectStore.defaultParameters
411+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
412+ key <- IDBObjectStore.add store "patate" (Just 14)
413+ key <- IDBObjectStore.add store "autruche" (Just 42)
414+ n <- IDBObjectStore.count store Nothing
415+ n `shouldEqual` 2
416+ }
417+ tearDown db
418+
419+ it "getKey()" do
420+ { db } <- setup
421+ { storeParams: IDBObjectStore.defaultParameters
422+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
423+ key <- IDBObjectStore.add store "patate" (Just 14)
424+ mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 14)
425+ mkey `shouldEqual` (Just key)
426+
427+ mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 42)
428+ mkey `shouldEqual` none
434429 }
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'
430+ tearDown db
431+
432+ it "getAllKeys()" do
433+ { db } <- setup
434+ { storeParams: IDBObjectStore.defaultParameters
435+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
436+ key1 <- IDBObjectStore.add store "patate" (Just 14)
437+ key2 <- IDBObjectStore.add store "autruche" (Just 42)
438+ key3 <- IDBObjectStore.add store 14 (Just 1337)
439+
440+ -- no bounds
441+ keys <- IDBObjectStore.getAllKeys store Nothing Nothing
442+ keys `shouldEqual` [key1, key2, key3]
443+
444+ -- lower bound
445+ keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 14 true) Nothing
446+ keys `shouldEqual` [key2, key3]
447+
448+ -- upper bound
449+ keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.upperBound 42 false) Nothing
450+ keys `shouldEqual` [key1, key2]
451+
452+ -- count
453+ keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 1 true) (Just 2)
454+ keys `shouldEqual` [key1, key2]
455+ }
456+ tearDown db
457+
458+ it "openCursor()" do
459+ let cb =
460+ { onSuccess : const $ pure unit
461+ , onError : show >>> fail >>> launchAff'
492462 , onComplete: pure unit
493463 }
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
464+ { db } <- setup
465+ { storeParams: IDBObjectStore.defaultParameters
466+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
467+ _ <- IDBObjectStore.openCursor store Nothing Next cb
468+ _ <- IDBObjectStore.openCursor store Nothing NextUnique cb
469+ _ <- IDBObjectStore.openCursor store Nothing Prev cb
470+ _ <- IDBObjectStore.openCursor store Nothing PrevUnique cb
471+ _ <- IDBObjectStore.openCursor store (Just $ IDBKeyRange.upperBound 1 true) Next cb
472+ pure unit
473+ }
474+ tearDown db
505475
506− it "openKeyCursor()" do
507− let
508− cb =
509− { onSuccess: const $ pure unit
510− , onError: show >>> fail >>> launchAff'
476+ it "openKeyCursor()" do
477+ let cb =
478+ { onSuccess : const $ pure unit
479+ , onError : show >>> fail >>> launchAff'
511480 , onComplete: pure unit
512481 }
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
482+ { db } <- setup
483+ { storeParams: IDBObjectStore.defaultParameters
484+ , onUpgradeNeeded: Just $ \_ store -> launchAff' do
485+ _ <- IDBObjectStore.openKeyCursor store Nothing Next cb
486+ _ <- IDBObjectStore.openKeyCursor store Nothing NextUnique cb
487+ _ <- IDBObjectStore.openKeyCursor store Nothing Prev cb
488+ _ <- IDBObjectStore.openKeyCursor store Nothing PrevUnique cb
489+ _ <- IDBObjectStore.openKeyCursor store (Just $ IDBKeyRange.lowerBound 1 true) Next cb
490+ pure unit
491+ }
492+ tearDown db
524493
525− describe "IDBIndex" do
526− let
494+ describe "IDBIndex" do
495+ let
527496 tearDown db = do
528497 IDBDatabase.close db
529498 _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
530499 pure unit
531500
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 }
501+ setup :: forall value e e'.
502+ { storeParams :: { keyPath :: Array String, autoIncrement :: Boolean }
503+ , indexParams :: { unique :: Boolean, multiEntry :: Boolean }
504+ , values :: Array (Tuple value (Maybe Key))
505+ , keyPath :: Array String
506+ , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Eff (idb :: IDB, avar :: AVAR, exception :: EXCEPTION | e') Unit)
507+ } -> Aff (idb :: IDB, avar :: AVAR | e) { db :: Database, index :: Index, store :: ObjectStore }
541508 setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
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
509+ let onUpgradeNeeded' var db tx = launchAff' do
510+ store <- IDBDatabase.createObjectStore db "store" storeParams
511+ _ <- traverse (uncurry (IDBObjectStore.add store)) values
512+ index <- IDBObjectStore.createIndex store "index" keyPath indexParams
513+ liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
514+ putVar var { db, index, store }
515+
516+ var <- makeVar
517+ db <- IDBFactory.open "db" Nothing
518+ { onUpgradeNeeded : Just (onUpgradeNeeded' var)
519+ , onBlocked : Nothing
554520 }
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'
521+ takeVar var
522+
523+
524+ it "returns an IDBIndex and the properties are set correctly" do
525+ { db, index } <- setup
526+ { storeParams : IDBObjectStore.defaultParameters
527+ , indexParams : IDBIndex.defaultParameters
528+ , onUpgradeNeeded : Nothing
529+ , keyPath : []
530+ , values : []
531+ }
532+ IDBIndex.name index `shouldEqual` "index"
533+ IDBIndex.keyPath index `shouldEqual` []
534+ IDBIndex.unique index `shouldEqual` IDBIndex.defaultParameters.unique
535+ IDBIndex.multiEntry index `shouldEqual` IDBIndex.defaultParameters.multiEntry
536+ tearDown db
537+
538+ it "attempt to create an index that requires unique values on an object store already contains duplicates" do
539+ let onAbort var = launchAff' (putVar var true)
540+ txVar <- makeVar
541+ dbVar <- makeVar
542+ res <- attempt $ setup
543+ { storeParams : IDBObjectStore.defaultParameters
544+ , indexParams : { unique : true
545+ , multiEntry : false
546+ }
547+ , keyPath : ["indexedProperty"]
548+ , values : [ { indexedProperty: "bar" } :+: (Just $ toKey 1)
549+ , { indexedProperty: "bar" } :+: (Just $ toKey 2)
550+ ]
551+ , onUpgradeNeeded : Just $ \db tx _ -> launchAff' do
552+ IDBTransaction.onAbort tx (onAbort txVar)
553+ IDBDatabase.onAbort db (onAbort dbVar)
554+ }
555+ case res of
556+ Right _ ->
557+ fail "expected abort"
558+ _ -> do
559+ shouldEqual true =<< takeVar txVar
560+ shouldEqual true =<< takeVar dbVar
561+
562+
563+ it "the index is usable right after being made" do
564+ { db } <- setup
565+ { storeParams : { keyPath : ["key"]
566+ , autoIncrement : false
567+ }
568+ , indexParams : IDBIndex.defaultParameters
569+ , keyPath : ["indexedProperty"]
570+ , values : [ { key: "key1", indexedProperty: "indexed_1" } :+: Nothing
571+ , { key: "key2", indexedProperty: "indexed_2" } :+: Nothing
572+ , { key: "key3", indexedProperty: "indexed_3" } :+: Nothing
573+ ]
574+ , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
575+ val <- IDBIndex.get index (IDBKeyRange.only "indexed_2")
576+ ((\r -> r.key) <$> val) `shouldEqual` (Just $ toKey "key2")
577+ }
578+ tearDown db
579+
580+ it "empty keyPath" do
581+ { db } <- setup
582+ { storeParams : IDBObjectStore.defaultParameters
583+ , indexParams : IDBIndex.defaultParameters
584+ , keyPath : []
585+ , values : [ "object_1" :+: (Just $ toKey 1)
586+ , "object_2" :+: (Just $ toKey 2)
587+ , "object_3" :+: (Just $ toKey 3)
588+ ]
589+ , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
590+ val <- IDBIndex.get index (IDBKeyRange.only "object_3")
591+ val `shouldEqual` (Just "object_3")
592+ }
593+ tearDown db
594+
595+ it "index can be valid keys [date]" do
596+ date <- liftEff $ toDateTime <$> now
597+ { db } <- setup
598+ { storeParams : { keyPath: ["key"]
599+ , autoIncrement: false
600+ }
601+ , indexParams : IDBIndex.defaultParameters
602+ , keyPath : ["i"]
603+ , values : [ { key: "date", i: (toKey date) } :+: Nothing
604+ ]
605+ , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
606+ val <- IDBIndex.get index (IDBKeyRange.only date)
607+ ((\r -> r.key) <$> val) `shouldEqual` (Just "date")
608+ }
609+ tearDown db
610+
611+ it "index can be valid keys [num]" do
612+ let num = 14
613+ { db } <- setup
614+ { storeParams : { keyPath: ["key"]
615+ , autoIncrement: false
616+ }
617+ , indexParams : IDBIndex.defaultParameters
618+ , keyPath : ["i"]
619+ , values : [ { key: "num", i: (toKey num) } :+: Nothing
620+ ]
621+ , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
622+ val <- IDBIndex.get index (IDBKeyRange.only num)
623+ ((\r -> r.key) <$> val) `shouldEqual` (Just "num")
624+ }
625+ tearDown db
626+
627+ it "index can be valid keys [array]" do
628+ let array = ["patate", "autruche"]
629+ { db } <- setup
630+ { storeParams : { keyPath: ["key"]
631+ , autoIncrement: false
632+ }
633+ , indexParams : IDBIndex.defaultParameters
634+ , keyPath : ["i"]
635+ , values : [ { key: "array", i: (toKey array) } :+: Nothing
636+ ]
637+ , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
638+ val <- IDBIndex.get index (IDBKeyRange.only array)
639+ ((\r -> r.key) <$> val) `shouldEqual` (Just "array")
640+ }
641+ tearDown db
642+
643+ it "openKeyCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
644+ res <- attempt $ setup
645+ { storeParams : { keyPath: ["key"], autoIncrement: false }
646+ , indexParams : IDBIndex.defaultParameters
647+ , keyPath : ["indexedProperty"]
648+ , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
649+ ]
650+ , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
651+ let cb =
652+ { onSuccess : const $ pure unit
653+ , onError : show >>> fail >>> launchAff'
699654 , onComplete: pure unit
700655 }
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'
656+ IDBTransaction.onAbort tx (pure unit)
657+ IDBDatabase.onAbort db (pure unit)
658+ IDBTransaction.abort tx
659+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
660+ case cursor of
661+ Right _ -> fail "expected InvalidStateError"
662+ Left err -> message err `shouldEqual` "InvalidStateError"
663+ }
664+ case res of
665+ Right _ -> fail "expected InvalidStateError"
666+ _ -> pure unit
667+
668+ it "openKeyCursor() - throw TransactionInactiveError on aborted transaction" do
669+ { db } <- setup
670+ { storeParams : { keyPath: ["key"], autoIncrement: false }
671+ , indexParams : IDBIndex.defaultParameters
672+ , keyPath : ["indexedProperty"]
673+ , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
674+ ]
675+ , onUpgradeNeeded : Nothing
676+ }
677+ let cb =
678+ { onSuccess : const $ pure unit
679+ , onError : show >>> fail >>> launchAff'
727680 , onComplete: pure unit
728681 }
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'
682+ tx <- IDBDatabase.transaction db ["store"] ReadOnly
683+ store <- IDBTransaction.objectStore tx "store"
684+ index <- IDBObjectStore.index store "index"
685+ IDBTransaction.onAbort tx (pure unit)
686+ IDBTransaction.abort tx
687+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
688+ case cursor of
689+ Right _ -> fail "expected TransactionInactiveError"
690+ Left err -> message err `shouldEqual` "TransactionInactiveError"
691+
692+ tearDown db
693+
694+ it "openKeyCursor() - throw InvalidStateError when the index is deleted" do
695+ { db } <- setup
696+ { storeParams : { keyPath: ["key"], autoIncrement: false }
697+ , indexParams : IDBIndex.defaultParameters
698+ , keyPath : ["indexedProperty"]
699+ , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
700+ ]
701+ , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
702+ let cb =
703+ { onSuccess : const $ pure unit
704+ , onError : show >>> fail >>> launchAff'
754705 , onComplete: pure unit
755706 }
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'
707+ store <- IDBTransaction.objectStore tx "store"
708+ IDBObjectStore.deleteIndex store "index"
709+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
710+ case cursor of
711+ Right _ -> fail "expected InvalidStateError"
712+ Left err -> message err `shouldEqual` "InvalidStateError"
713+ }
714+
715+ tearDown db
716+
717+ it "openCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
718+ res <- attempt $ setup
719+ { storeParams : { keyPath: ["key"], autoIncrement: false }
720+ , indexParams : IDBIndex.defaultParameters
721+ , keyPath : ["indexedProperty"]
722+ , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
723+ ]
724+ , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
725+ let cb =
726+ { onSuccess : const $ pure unit
727+ , onError : show >>> fail >>> launchAff'
779728 , onComplete: pure unit
780729 }
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'
730+ IDBTransaction.onAbort tx (pure unit)
731+ IDBDatabase.onAbort db (pure unit)
732+ IDBTransaction.abort tx
733+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
734+ case cursor of
735+ Right _ -> fail "expected InvalidStateError"
736+ Left err -> message err `shouldEqual` "InvalidStateError"
737+ }
738+ case res of
739+ Right _ -> fail "expected InvalidStateError"
740+ _ -> pure unit
741+
742+ it "openCursor() - throw TransactionInactiveError on aborted transaction" do
743+ { db } <- setup
744+ { storeParams : { keyPath: ["key"], autoIncrement: false }
745+ , indexParams : IDBIndex.defaultParameters
746+ , keyPath : ["indexedProperty"]
747+ , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
748+ ]
749+ , onUpgradeNeeded : Nothing
750+ }
751+ let cb =
752+ { onSuccess : const $ pure unit
753+ , onError : show >>> fail >>> launchAff'
807754 , onComplete: pure unit
808755 }
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'
756+ tx <- IDBDatabase.transaction db ["store"] ReadOnly
757+ store <- IDBTransaction.objectStore tx "store"
758+ index <- IDBObjectStore.index store "index"
759+ IDBTransaction.onAbort tx (pure unit)
760+ IDBTransaction.abort tx
761+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
762+ case cursor of
763+ Right _ -> fail "expected TransactionInactiveError"
764+ Left err -> message err `shouldEqual` "TransactionInactiveError"
765+
766+ tearDown db
767+
768+ it "openCursor() - throw InvalidStateError when the index is deleted" do
769+ { db } <- setup
770+ { storeParams : { keyPath: ["key"], autoIncrement: false }
771+ , indexParams : IDBIndex.defaultParameters
772+ , keyPath : ["indexedProperty"]
773+ , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
774+ ]
775+ , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
776+ let cb =
777+ { onSuccess : const $ pure unit
778+ , onError : show >>> fail >>> launchAff'
834779 , onComplete: pure unit
835780 }
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
781+ store <- IDBTransaction.objectStore tx "store"
782+ IDBObjectStore.deleteIndex store "index"
783+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
784+ case cursor of
785+ Right _ -> fail "expected InvalidStateError"
786+ Left err -> message err `shouldEqual` "InvalidStateError"
787+ }
788+
789+ tearDown db
790+
791+ it "getKey() - multiEntry - adding keys" do
792+ { db } <- setup
793+ { storeParams : IDBObjectStore.defaultParameters
794+ , indexParams : { unique: false, multiEntry: true }
795+ , keyPath : ["name"]
796+ , values : [ { name: ["patate", "autruche"] } :+: (Just $ toKey 1)
797+ , { name: ["bob"] } :+: (Just $ toKey 2)
798+ ]
799+ , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
800+ key <- IDBIndex.getKey index (IDBKeyRange.only "patate")
801+ key `shouldEqual` (Just $ toKey 1)
802+
803+ key <- IDBIndex.getKey index (IDBKeyRange.only "autruche")
804+ key `shouldEqual` (Just $ toKey 1)
805+
806+ key <- IDBIndex.getKey index (IDBKeyRange.only "bob")
807+ key `shouldEqual` (Just $ toKey 2)
808+ }
809+ tearDown db
810+
811+
812+ it "get() - returns the record with the first key in the range" do
813+ { db } <- setup
814+ { storeParams : { keyPath: ["key"], autoIncrement: false }
815+ , indexParams : IDBIndex.defaultParameters
816+ , keyPath : ["indexedProperty"]
817+ , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
818+ , { key: 42, indexedProperty: "autruche" } :+: Nothing
819+ , { key: 1337, indexedProperty: "baguette" } :+: Nothing
820+ ]
821+ , onUpgradeNeeded : Nothing
822+ }
823+
824+ tx <- IDBDatabase.transaction db ["store"] ReadOnly
825+ store <- IDBTransaction.objectStore tx "store"
826+ index <- IDBObjectStore.index store "index"
827+ val <- IDBIndex.get index (IDBKeyRange.lowerBound "autruche" false)
828+ ((\r -> r.key) <$> val) `shouldEqual` (Just 42)
829+
830+ tearDown db
831+
832+ describe "IDBCursor" do
833+ let
890834 tearDown db = do
891835 IDBDatabase.close db
892836 _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
893837 pure unit
894838
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 }
839+ setup :: forall value e e'.
840+ { storeParams :: { keyPath :: Array String, autoIncrement :: Boolean }
841+ , indexParams :: { unique :: Boolean, multiEntry :: Boolean }
842+ , values :: Array (Tuple value (Maybe Key))
843+ , keyPath :: Array String
844+ , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Eff (idb :: IDB, avar :: AVAR, exception :: EXCEPTION | e') Unit)
845+ } -> Aff (idb :: IDB, avar :: AVAR | e) { db :: Database, index :: Index, store :: ObjectStore }
904846 setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
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
847+ let onUpgradeNeeded' var db tx = launchAff' do
848+ store <- IDBDatabase.createObjectStore db "store" storeParams
849+ _ <- traverse (uncurry (IDBObjectStore.add store)) values
850+ index <- IDBObjectStore.createIndex store "index" keyPath indexParams
851+ liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
852+ putVar var { db, index, store }
853+
854+ var <- makeVar
855+ db <- IDBFactory.open "db" Nothing
856+ { onUpgradeNeeded : Just (onUpgradeNeeded' var)
857+ , onBlocked : Nothing
917858 }
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 =
859+ takeVar var
860+
861+ it "continue() - iterate to the next record" do
862+ { db } <- setup
863+ { storeParams : IDBObjectStore.defaultParameters
864+ , indexParams : IDBIndex.defaultParameters
865+ , keyPath : []
866+ , values : [ "cupcake" :+: (Just $ toKey 4)
867+ , "pancake" :+: (Just $ toKey 2)
868+ , "pie" :+: (Just $ toKey 1)
869+ , "pie" :+: (Just $ toKey 3)
870+ ]
871+ , onUpgradeNeeded: Nothing
872+ }
873+ let cb vdone vvals =
935874 { onComplete: launchAff' do
936− AVar.put unit vdone
875+ putVar vdone unit
937876
938− , onError: \error -> launchAff' do
877+ , onError: \error -> launchAff' do
939878 fail $ "unexpected error: " <> show error
940879
941880 , onSuccess: \cursor -> launchAff' do
942− vals <- AVar.take vvals
881+ vals <- takeVar vvals
943882 pure (IDBCursor.value cursor) >>= shouldEqual (maybe "" _.v $ head vals)
944− IDBCursor.primaryKey cursor >>= shouldEqual (maybe (toKey 0) _.k $ head vals)
945− AVar.put (drop 1 vals) vvals
883+ IDBCursor.primaryKey cursor >>= shouldEqual (maybe (toKey 0) _.k $ head vals)
884+ putVar vvals (drop 1 vals)
946885 IDBCursor.continue cursor none
947886 }
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 =
887+ vdone <- makeVar
888+ vvals <- makeVar'
889+ [ { v: "pie" , k: toKey 1 }
890+ , { v: "pancake", k: toKey 2 }
891+ , { v: "pie" , k: toKey 3 }
892+ , { v: "cupcake", k: toKey 4 }
893+ ]
894+ tx <- IDBDatabase.transaction db ["store"] ReadOnly
895+ store <- IDBTransaction.objectStore tx "store"
896+ IDBObjectStore.openCursor store Nothing Next (cb vdone vvals)
897+ takeVar vdone
898+ tearDown db
899+
900+ it "continue() - attempt to iterate in the wrong direction" do
901+ { db } <- setup
902+ { storeParams : IDBObjectStore.defaultParameters
903+ , indexParams : IDBIndex.defaultParameters
904+ , keyPath : []
905+ , values : [ "cupcake" :+: (Just $ toKey 4)
906+ , "pancake" :+: (Just $ toKey 2)
907+ , "pie" :+: (Just $ toKey 1)
908+ , "pie" :+: (Just $ toKey 3)
909+ ]
910+ , onUpgradeNeeded: Nothing
911+ }
912+ let cb vdone =
976913 { onComplete: launchAff' do
977914 fail $ "shouldn't complete"
978915
979− , onError: \error -> launchAff' do
916+ , onError: \error -> launchAff' do
980917 fail $ "unexpected error: " <> show error
981918
982919 , onSuccess: \cursor -> launchAff' do
983920 res <- attempt $ IDBCursor.continue cursor (Just 1)
984921 case res of
985− Left err -> do
986− name err `shouldEqual` "DataError"
987− AVar.put unit vdone
922+ Left err -> do
923+ message err `shouldEqual` "DataError"
924+ putVar vdone unit
988925 Right _ -> do
989926 fail "expected continue to fail"
990927 }
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 =
928+ vdone <- makeVar
929+ tx <- IDBDatabase.transaction db ["store"] ReadOnly
930+ store <- IDBTransaction.objectStore tx "store"
931+ IDBObjectStore.openCursor store Nothing Next (cb vdone)
932+ takeVar vdone
933+ tearDown db
934+
935+
936+ it "advance() - iterate cursor number of times specified by count" do
937+ { db } <- setup
938+ { storeParams : { keyPath: ["pKey"], autoIncrement: false }
939+ , indexParams : IDBIndex.defaultParameters
940+ , keyPath : []
941+ , values : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
942+ , { pKey: "pkey_1", iKey: "ikey_1" } :+: Nothing
943+ , { pKey: "pkey_2", iKey: "ikey_2" } :+: Nothing
944+ , { pKey: "pkey_3", iKey: "ikey_3" } :+: Nothing
945+ ]
946+ , onUpgradeNeeded: Nothing
947+ }
948+ let cb vdone vjump =
1013949 { onComplete: launchAff' do
1014− AVar.put unit vdone
950+ putVar vdone unit
1015951
1016− , onError: \error -> launchAff' do
952+ , onError: \error -> launchAff' do
1017953 fail $ "unexpected error: " <> show error
1018954
1019955 , onSuccess: \cursor -> launchAff' do
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
956+ jump <- takeVar vjump
957+ if jump
958+ then do
959+ IDBCursor.advance cursor 3
960+ else do
961+ let value = IDBCursor.value cursor
962+ value.pKey `shouldEqual` "pkey_3"
963+ value.iKey `shouldEqual` "ikey_3"
964+ IDBCursor.continue cursor none
965+ putVar vjump false
1029966 }
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 =
967+ vdone <- makeVar
968+ vjump <- makeVar' true
969+ tx <- IDBDatabase.transaction db ["store"] ReadOnly
970+ store <- IDBTransaction.objectStore tx "store"
971+ IDBObjectStore.openCursor store Nothing Next (cb vdone vjump)
972+ takeVar vdone
973+ tearDown db
974+
975+ it "delete() - remove a record from the object store" do
976+ { db } <- setup
977+ { storeParams : { keyPath: ["pKey"], autoIncrement: false }
978+ , indexParams : IDBIndex.defaultParameters
979+ , keyPath : []
980+ , values : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
981+ , { pKey: "pkey_1", iKey: "ikey_1" } :+: Nothing
982+ , { pKey: "pkey_2", iKey: "ikey_2" } :+: Nothing
983+ , { pKey: "pkey_3", iKey: "ikey_3" } :+: Nothing
984+ ]
985+ , onUpgradeNeeded: Nothing
986+ }
987+ let cb vdone store =
1053988 { onComplete: launchAff' do
1054989 mval <- map _.pKey <$> IDBIndex.get store (IDBKeyRange.only "pkey_0")
1055990 mval `shouldEqual` (Nothing :: Maybe String)
1056− AVar.put unit vdone
991+ putVar vdone unit
1057992
1058− , onError: \error -> launchAff' do
993+ , onError: \error -> launchAff' do
1059994 fail $ "unexpected error: " <> show error
1060995
1061996 , onSuccess: \cursor -> launchAff' do
@@ -1064,31 +999,29 @@ main = do
1064999 IDBCursor.delete cursor
10651000 IDBCursor.advance cursor 4
10661001 }
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 =
1002+ vdone <- makeVar
1003+ tx <- IDBDatabase.transaction db ["store"] ReadWrite
1004+ store <- IDBTransaction.objectStore tx "store"
1005+ IDBObjectStore.openCursor store Nothing Next (cb vdone store)
1006+ takeVar vdone
1007+ tearDown db
1008+
1009+ it "update() - modify a record in the object store" do
1010+ { db } <- setup
1011+ { storeParams : { keyPath: ["pKey"], autoIncrement: false }
1012+ , indexParams : IDBIndex.defaultParameters
1013+ , keyPath : []
1014+ , values : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
1015+ ]
1016+ , onUpgradeNeeded: Nothing
1017+ }
1018+ let cb vdone store =
10861019 { onComplete: launchAff' do
10871020 mval <- map _.iKey <$> IDBIndex.get store (IDBKeyRange.only "pkey_0")
10881021 mval `shouldEqual` (Just "patate")
1089− AVar.put unit vdone
1022+ putVar vdone unit
10901023
1091− , onError: \error -> launchAff' do
1024+ , onError: \error -> launchAff' do
10921025 fail $ "unexpected error: " <> show error
10931026
10941027 , onSuccess: \cursor -> launchAff' do
@@ -1098,44 +1031,41 @@ main = do
10981031 key `shouldEqual` toKey "pkey_0"
10991032 IDBCursor.advance cursor 4
11001033 }
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 =
1034+ vdone <- makeVar
1035+ tx <- IDBDatabase.transaction db ["store"] ReadWrite
1036+ store <- IDBTransaction.objectStore tx "store"
1037+ IDBObjectStore.openCursor store Nothing Next (cb vdone store)
1038+ takeVar vdone
1039+ tearDown db
1040+
1041+ it "update() - throw ReadOnlyError after update on ReadOnly transaction" do
1042+ { db } <- setup
1043+ { storeParams : { keyPath: ["pKey"], autoIncrement: false }
1044+ , indexParams : IDBIndex.defaultParameters
1045+ , keyPath : []
1046+ , values : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
1047+ ]
1048+ , onUpgradeNeeded: Nothing
1049+ }
1050+ let cb vdone =
11201051 { onComplete: launchAff' do
11211052 fail $ "shouldn't complete"
11221053
1123− , onError: \error -> launchAff' do
1054+ , onError: \error -> launchAff' do
11241055 fail $ "unexpected error: " <> show error
11251056
11261057 , onSuccess: \cursor -> launchAff' do
11271058 res <- attempt $ IDBCursor.update cursor "patate"
11281059 case res of
11291060 Left err -> do
1130− name err `shouldEqual` "ReadOnlyError"
1131− AVar.put unit vdone
1061+ message err `shouldEqual` "ReadOnlyError"
1062+ putVar vdone unit
11321063 Right _ ->
11331064 fail $ "expected ReadOnlyError"
11341065 }
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−
1066+ vdone <- makeVar
1067+ tx <- IDBDatabase.transaction db ["store"] ReadOnly
1068+ store <- IDBTransaction.objectStore tx "store"
1069+ IDBObjectStore.openCursor store Nothing Next (cb vdone)
1070+ takeVar vdone
1071+ tearDown db