@@ -2,19 +2,23 @@ module Test.Main where
22
33import Prelude
44
5−import Control.Monad.Aff (Aff, launchAff, forkAff, delay)
6−import Control.Monad.Aff.Console (log)
7−import Control.Monad.Aff.AVar (AVAR, makeVar', modifyVar, peekVar, killVar)
5+import Control.Monad.Aff (Aff, launchAff, forkAff, delay, attempt)
6+import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', modifyVar, peekVar, putVar, takeVar)
87import Control.Monad.Eff (Eff)
98import Control.Monad.Eff.Class (liftEff)
109import Control.Monad.Eff.Exception (EXCEPTION)
10+import Control.Monad.Eff.Now (NOW, now)
1111import Data.Date as Date
1212import Data.DateTime as DateTime
13−import Data.DateTime (DateTime(..), Date(..), Time(..))
13+import Data.DateTime (DateTime(..), Time(..))
14+import Data.DateTime.Instant (toDateTime)
15+import Data.Either (Either(..))
1416import Data.Enum (toEnum)
15−import Data.Maybe (Maybe(..), isNothing)
17+import Data.Maybe (Maybe(..), isNothing, maybe)
1618import Data.Time.Duration (Milliseconds(..))
17−import Test.Spec (describe, it)
19+import Data.Traversable (traverse)
20+import Data.Tuple (Tuple(..), uncurry)
21+import Test.Spec (describe, describeOnly, it, itOnly)
1822import Test.Spec.Assertions (shouldEqual, fail)
1923import Test.Spec.Mocha (MOCHA, runMocha)
2024
@@ -22,19 +26,23 @@ import Database.IndexedDB.Core
2226import Database.IndexedDB.IDBKey
2327import Database.IndexedDB.IDBDatabase as IDBDatabase
2428import Database.IndexedDB.IDBFactory as IDBFactory
25−import Database.IndexedDB.IDBObjectStore as IDBObjectStore
29+import Database.IndexedDB.IDBIndex as IDBIndex
2630import Database.IndexedDB.IDBKeyRange as IDBKeyRange
31+import Database.IndexedDB.IDBObjectStore as IDBObjectStore
32+import Database.IndexedDB.IDBTransaction as IDBTransaction
2733
2834
29−tearDown :: forall eff. String -> Int -> Database -> Aff (idb :: INDEXED_DB, exception :: EXCEPTION | eff) Unit
30−tearDown name version db = do
31− liftEff $ IDBDatabase.close db
32− version' <- IDBFactory.deleteDatabase name
33− version' `shouldEqual` version
35+infixr 7 Tuple as :+:
3436
35−-- main :: forall eff. Eff (mocha :: MOCHA, idb :: INDEXED_DB, exception :: EXCEPTION, avar :: AVAR | eff) Unit
37+main :: forall eff. Eff (now :: NOW, mocha :: MOCHA, idb :: IDB, exception :: EXCEPTION, avar :: AVAR | eff) Unit
3638main = runMocha do
3739 describe "IDBFactory" do
40+ let
41+ tearDown name version db = do
42+ liftEff $ IDBDatabase.close db
43+ version' <- IDBFactory.deleteDatabase name
44+ version' `shouldEqual` version
45+
3846 it "open default" do
3947 let name = "db-default"
4048 version = 1
@@ -76,7 +84,7 @@ main = runMocha do
7684 it "open + onUpgradeNeed" do
7785 let name = "db-upgrade-needed"
7886 version = 1
79− callback var db = do
87+ callback var db _ = do
8088 _ <- launchAff $ modifyVar (const $ IDBDatabase.name db) var
8189 pure unit
8290 var <- makeVar' "-"
@@ -260,670 +268,360 @@ main = runMocha do
260268 IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)
261269
262270 it "can access attributes of a range" do
263− let range = IDBKeyRange.lowerBound 14 true
271+ let range = IDBKeyRange.lowerBound 14 false
264272 IDBKeyRange.lower range `shouldEqual` (Just $ toKey 14)
265273 IDBKeyRange.upper range `shouldEqual` (Nothing :: Maybe Key)
266− IDBKeyRange.lowerOpen range `shouldEqual` true
267− -- NOTE Not true on Chrome 56.x => The default value for the flag is `true`
268− -- IDBKeyRange.upperOpen range `shouldEqual` false
274+ IDBKeyRange.lowerOpen range `shouldEqual` false
275+ IDBKeyRange.upperOpen range `shouldEqual` true
269276
270277 describe "IDBDatabase" do
271− it "createObjectStore (keyPath: [], autoIncrement: true)" do
272− let dbName = "db-create-store-01"
273− dbVersion = 1
274− storeName = "store"
275− keyPath = []
276− autoIncrement = true
277− callback var db = do
278− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
279− _ <- launchAff $ IDBObjectStore.name store `shouldEqual` storeName
280− _ <- launchAff $ IDBObjectStore.keyPath store `shouldEqual` keyPath
281− _ <- launchAff $ IDBObjectStore.autoIncrement store `shouldEqual` autoIncrement
282− _ <- launchAff $ IDBObjectStore.indexNames store `shouldEqual` []
283− _ <- launchAff $ modifyVar (const true) var
284− pure unit
278+ let
279+ tearDown db = do
280+ liftEff $ IDBDatabase.close db
281+ _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
282+ pure unit
283+
284+ setup storeParams = do
285+ let onUpgradeNeeded var db _ = pure unit <* do
286+ store <- IDBDatabase.createObjectStore db "store" storeParams
287+ _ <- (launchAff $ putVar var { db, store })
288+ pure unit
285289
286− var <- makeVar' false
287− db <- IDBFactory.open dbName Nothing
288− { onUpgradeNeeded : Just (callback var)
289− , onBlocked : Nothing
290− }
291− hasBeenCalled <- peekVar var
292− hasBeenCalled `shouldEqual` true
293− tearDown dbName dbVersion db
294−
295−
296− it "createObjectStore (keyPath: [\"field\"], autoIncrement: true)" do
297− let dbName = "db-create-store-02"
298− dbVersion = 1
299− storeName = "store"
300− keyPath = ["field"]
301− autoIncrement = true
302− callback var db = do
303− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
304− _ <- launchAff $ IDBObjectStore.name store `shouldEqual` storeName
305− _ <- launchAff $ IDBObjectStore.keyPath store `shouldEqual` keyPath
306− _ <- launchAff $ IDBObjectStore.autoIncrement store `shouldEqual` autoIncrement
307− _ <- launchAff $ IDBObjectStore.indexNames store `shouldEqual` []
308− _ <- launchAff $ modifyVar (const true) var
309− pure unit
290+ var <- makeVar
291+ db <- IDBFactory.open "db" Nothing
292+ { onUpgradeNeeded : Just (onUpgradeNeeded var)
293+ , onBlocked : Nothing
294+ }
310295
311− var <- makeVar' false
312− db <- IDBFactory.open dbName Nothing
313− { onUpgradeNeeded : Just (callback var)
314− , onBlocked : Nothing
315− }
316− hasBeenCalled <- peekVar var
317− hasBeenCalled `shouldEqual` true
318− tearDown dbName dbVersion db
296+ takeVar var
319297
298+ it "createObjectStore (keyPath: [], autoIncrement: true)" do
299+ { db, store } <- setup { keyPath: [], autoIncrement: true }
300+ IDBObjectStore.name store `shouldEqual` "store"
301+ IDBObjectStore.keyPath store `shouldEqual` []
302+ IDBObjectStore.autoIncrement store `shouldEqual` true
303+ IDBObjectStore.indexNames store `shouldEqual` []
304+ tearDown db
305+
306+ it "createObjectStore (keyPath: [\"patate\"], autoIncrement: true)" do
307+ { db, store } <- setup { keyPath: ["patate"], autoIncrement: true }
308+ IDBObjectStore.name store `shouldEqual` "store"
309+ IDBObjectStore.keyPath store `shouldEqual` ["patate"]
310+ IDBObjectStore.autoIncrement store `shouldEqual` true
311+ IDBObjectStore.indexNames store `shouldEqual` []
312+ tearDown db
320313
321314 it "createObjectStore (keyPath: [\"a\", \"b\"], autoIncrement: false)" do
322− let dbName = "db-create-store-03"
323− dbVersion = 1
324− storeName = "store"
325− keyPath = ["a", "b"]
326− autoIncrement = false
327− callback var db = do
328− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
329− _ <- launchAff $ IDBObjectStore.name store `shouldEqual` storeName
330− _ <- launchAff $ IDBObjectStore.keyPath store `shouldEqual` keyPath
331− _ <- launchAff $ IDBObjectStore.autoIncrement store `shouldEqual` autoIncrement
332− _ <- launchAff $ IDBObjectStore.indexNames store `shouldEqual` []
333− _ <- launchAff $ modifyVar (const true) var
334− pure unit
335−
336− var <- makeVar' false
337− db <- IDBFactory.open dbName Nothing
338− { onUpgradeNeeded : Just (callback var)
339− , onBlocked : Nothing
340− }
341− hasBeenCalled <- peekVar var
342− hasBeenCalled `shouldEqual` true
343− tearDown dbName dbVersion db
344−
345−
346− it "createObjectStore (keyPath: [\"field\"], autoIncrement: false)" do
347− let dbName = "db-create-store-04"
348− dbVersion = 1
349− storeName = "store"
350− keyPath = ["field"]
351− autoIncrement = false
352− callback var db = do
353− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
354− _ <- launchAff $ IDBObjectStore.name store `shouldEqual` storeName
355− _ <- launchAff $ IDBObjectStore.keyPath store `shouldEqual` keyPath
356− _ <- launchAff $ IDBObjectStore.autoIncrement store `shouldEqual` autoIncrement
357− _ <- launchAff $ IDBObjectStore.indexNames store `shouldEqual` []
358− _ <- launchAff $ modifyVar (const true) var
359− pure unit
360−
361− var <- makeVar' false
362− db <- IDBFactory.open dbName Nothing
363− { onUpgradeNeeded : Just (callback var)
364− , onBlocked : Nothing
365− }
366− hasBeenCalled <- peekVar var
367− hasBeenCalled `shouldEqual` true
368− tearDown dbName dbVersion db
369−
315+ { db, store } <- setup { keyPath: ["patate", "autruche"], autoIncrement: false }
316+ IDBObjectStore.name store `shouldEqual` "store"
317+ IDBObjectStore.keyPath store `shouldEqual` ["patate", "autruche"]
318+ IDBObjectStore.autoIncrement store `shouldEqual` false
319+ IDBObjectStore.indexNames store `shouldEqual` []
320+ tearDown db
370321
371322 it "deleteObjectStore" do
372− let dbName = "db-delete-store"
373− dbVersion = 2
374− storeName = "store"
375− keyPath = []
376− autoIncrement = true
377− callback db = do
378− _ <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
379− pure unit
380− callback2 var db = do
381− _ <- IDBDatabase.deleteObjectStore db storeName
382− _ <- launchAff $ modifyVar (const true) var
323+ let onUpgradeNeeded var db _ = do
324+ _ <- IDBDatabase.deleteObjectStore db "store"
325+ _ <- (launchAff $ putVar var true)
383326 pure unit
384327
385− var <- makeVar' false
386− db <- IDBFactory.open dbName Nothing
387− { onUpgradeNeeded : Just callback
388− , onBlocked : Nothing
389− }
328+ var <- makeVar
329+ { db, store } <- setup IDBObjectStore.defaultParameters
390330 liftEff $ IDBDatabase.close db
391− db <- IDBFactory.open dbName (Just dbVersion)
392− { onUpgradeNeeded : Just (callback2 var)
393− , onBlocked : Nothing
394− }
395− hasBeenCalled <- peekVar var
396− hasBeenCalled `shouldEqual` true
397− tearDown dbName dbVersion db
331+ db <- IDBFactory.open "db" (Just 999) { onUpgradeNeeded : Just (onUpgradeNeeded var)
332+ , onBlocked : Nothing
333+ }
334+ deleted <- takeVar var
335+ deleted `shouldEqual` true
336+ tearDown db
398337
399− describe "IDBObjectStore" do
400− it "add(\"patate\", Nothing )" do
401− let dbName = "db-add"
402− dbVersion = 1
403− storeName = "store"
404− keyPath = []
405− autoIncrement = true
406− key = 1
407− callback db = do
408− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
409− key <- launchAff $ ((unsafeFromKey >>> shouldEqual key)
410− <$> IDBObjectStore.add store "patate" Nothing)
411− pure unit
412−
413− db <- IDBFactory.open dbName Nothing
414− { onUpgradeNeeded : Just callback
415− , onBlocked : Nothing
416− }
417− tearDown dbName dbVersion db
418−
419− it "add(\"patate\", Just 14 )" do
420− let dbName = "db-add"
421− dbVersion = 1
422− storeName = "store"
423− keyPath = []
424− autoIncrement = true
425− key = 14
426− callback db = do
427− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
428− key <- launchAff $ ((unsafeFromKey >>> shouldEqual key)
429− <$> IDBObjectStore.add store "patate" (Just $ toKey key))
430− pure unit
431338
432− db <- IDBFactory.open dbName Nothing
433− { onUpgradeNeeded : Just callback
434− , onBlocked : Nothing
435− }
436− tearDown dbName dbVersion db
437−
438− it "add(\"patate\", Just \"key\" )" do
439− let dbName = "db-add"
440− dbVersion = 1
441− storeName = "store"
442− keyPath = []
443− autoIncrement = true
444− key = "key"
445− callback db = do
446− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
447− key <- launchAff $ ((unsafeFromKey >>> shouldEqual key)
448− <$> IDBObjectStore.add store "patate" (Just $ toKey key))
449− pure unit
450−
451− db <- IDBFactory.open dbName Nothing
452− { onUpgradeNeeded : Just callback
453− , onBlocked : Nothing
454− }
455− tearDown dbName dbVersion db
456−
457− it "add(\"patate\", Just <date> )" do
458− let dbName = "db-add"
459− dbVersion = 1
460− storeName = "store"
461− keyPath = []
462− autoIncrement = true
463− mkey = DateTime
464− <$> (Date.canonicalDate <$> toEnum 2017 <*> toEnum 6 <*> toEnum 23)
465− <*> (Time <$> toEnum 17 <*> toEnum 59 <*> toEnum 34 <*> toEnum 42)
466−
467− case mkey of
468− Nothing ->
469− fail "unable to create datetime"
470− Just key -> do
471− let callback db = do
472− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
473− key <- launchAff $ ((unsafeFromKey >>> shouldEqual key)
474− <$> IDBObjectStore.add store "patate" (Just $ toKey key))
475− pure unit
476−
477− db <- IDBFactory.open dbName Nothing
478− { onUpgradeNeeded : Just callback
479− , onBlocked : Nothing
339+ describe "IDBObjectStore" do
340+ let
341+ tearDown db = do
342+ liftEff $ IDBDatabase.close db
343+ _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
344+ pure unit
345+
346+ setup { storeParams, onUpgradeNeeded } = do
347+ let onUpgradeNeeded' var db _ = pure unit <* do
348+ store <- IDBDatabase.createObjectStore db "store" storeParams
349+ launchAff do
350+ liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure store)
351+ putVar var { db, store }
352+
353+ var <- makeVar
354+ db <- IDBFactory.open "db" Nothing
355+ { onUpgradeNeeded : Just (onUpgradeNeeded' var)
356+ , onBlocked : Nothing
480357 }
481− tearDown dbName dbVersion db
482−
483− it "add(\"patate\", Just [14, 42] )" do
484− let dbName = "db-add"
485− dbVersion = 1
486− storeName = "store"
487− keyPath = []
488− autoIncrement = true
489− key = [14, 42]
490− callback db = do
491− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
492− key <- launchAff $ ((unsafeFromKey >>> shouldEqual key)
493− <$> IDBObjectStore.add store "patate" (Just $ toKey key))
494− pure unit
495358
496− db <- IDBFactory.open dbName Nothing
497− { onUpgradeNeeded : Just callback
498− , onBlocked : Nothing
499− }
500− tearDown dbName dbVersion db
359+ takeVar var
501360
502− it "clear()" do
503− let dbName = "db-clear"
504− dbVersion = 1
505− storeName = "store"
506− keyPath = []
507− autoIncrement = true
508− callback db = do
509− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
510− _ <- launchAff $ do
511− _ <- IDBObjectStore.add store "patate" (Just $ toKey 14)
512− _ <- IDBObjectStore.clear store
513− v <- IDBObjectStore.get store (IDBKeyRange.only 14)
514− v `shouldEqual` (Nothing :: Maybe Int)
361+ it "add()" do
362+ date <- liftEff $ toDateTime <$> now
363+ { db } <- setup
364+ { storeParams: { autoIncrement: true, keyPath: [] }
365+ , onUpgradeNeeded: Just $ \_ store -> pure unit <* (launchAff do
366+ -- no key
367+ key <- IDBObjectStore.add store "patate" (Nothing :: Maybe Key)
368+ (toKey 1) `shouldEqual` key
515369
516− pure unit
370+ -- int key
371+ key <- IDBObjectStore.add store "patate" (Just 14)
372+ (toKey 14) `shouldEqual` key
517373
518− db <- IDBFactory.open dbName Nothing
519− { onUpgradeNeeded : Just callback
520− , onBlocked : Nothing
521− }
522− tearDown dbName dbVersion db
523−
524− it "count(Nothing) " do
525− let dbName = "db-count"
526− dbVersion = 1
527− storeName = "store"
528− keyPath = []
529− autoIncrement = true
530− callback db = do
531− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
532− _ <- launchAff $ do
533− _ <- IDBObjectStore.add store "patate" Nothing
534− _ <- IDBObjectStore.add store 14 Nothing
535− n <- IDBObjectStore.count store Nothing
536− n `shouldEqual` 2
537− pure unit
374+ -- number key
375+ key <- IDBObjectStore.add store "patate" (Just 14.42)
376+ (toKey 14.42) `shouldEqual` key
538377
539− db <- IDBFactory.open dbName Nothing
540− { onUpgradeNeeded : Just callback
541− , onBlocked : Nothing
542− }
543− tearDown dbName dbVersion db
544−
545−
546− it "getKey() (fixed)" do
547− let dbName = "db-getKey"
548− dbVersion = 1
549− storeName = "store"
550− keyPath = ["id"]
551− key = "patate"
552− autoIncrement = false
553− callback db = do
554− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
555− _ <- launchAff $ do
556− key' <- IDBObjectStore.add store { id: key, value: 14 } Nothing
557− (unsafeFromKey key') `shouldEqual` key
558− key' <- IDBObjectStore.getKey store (IDBKeyRange.only key)
559− (unsafeFromKey <$> key') `shouldEqual` (Just key)
560− pure unit
378+ -- string key
379+ key <- IDBObjectStore.add store "patate" (Just "key")
380+ (toKey "key") `shouldEqual` key
561381
562− db <- IDBFactory.open dbName Nothing
563− { onUpgradeNeeded : Just callback
564− , onBlocked : Nothing
565− }
566− tearDown dbName dbVersion db
567−
568− it "getKey() (given)" do
569− let dbName = "db-getKey"
570− dbVersion = 1
571− storeName = "store"
572− keyPath = []
573− autoIncrement = true
574− callback db = do
575− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
576− _ <- launchAff $ do
577− key <- IDBObjectStore.add store "patate" Nothing
578− mkey <- IDBObjectStore.getKey store (IDBKeyRange.only key)
579− mkey `shouldEqual` Just key
580− pure unit
382+ -- date key
383+ key <- IDBObjectStore.add store "patate" (Just date)
384+ (toKey date) `shouldEqual` key
581385
582− db <- IDBFactory.open dbName Nothing
583− { onUpgradeNeeded : Just callback
584− , onBlocked : Nothing
585− }
586− tearDown dbName dbVersion db
587−
588− it "getKey() unknown" do
589− let dbName = "db-getKey"
590− dbVersion = 1
591− storeName = "store"
592− keyPath = []
593− autoIncrement = true
594− callback db = do
595− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
596− _ <- launchAff $ do
597− key <- IDBObjectStore.add store "patate" Nothing
598− mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 14)
599− mkey `shouldEqual` Nothing
600− pure unit
386+ -- array key
387+ key <- IDBObjectStore.add store "patate" (Just $ toKey [14, 42])
388+ (toKey [14, 42]) `shouldEqual` key
389+ )}
390+ tearDown db
601391
602− db <- IDBFactory.open dbName Nothing
603− { onUpgradeNeeded : Just callback
604− , onBlocked : Nothing
605− }
606− tearDown dbName dbVersion db
607−
608− it "getAllKeys(nothing, nothing)" do
609− let dbName = "db-getAllKeys"
610− dbVersion = 1
611− storeName = "store"
612− keyPath = []
613− autoIncrement = true
614− callback db = do
615− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
616− _ <- launchAff $ do
617− k1 <- IDBObjectStore.add store "patate" Nothing
618− k2 <- IDBObjectStore.add store "autruche" Nothing
619− keys <- IDBObjectStore.getAllKeys store Nothing Nothing
620− keys `shouldEqual` [k1,k2]
621− pure unit
622−
623− db <- IDBFactory.open dbName Nothing
624− { onUpgradeNeeded : Just callback
625− , onBlocked : Nothing
626− }
627− tearDown dbName dbVersion db
628−
629− it "getAllKeys(lowerBound(1, true), nothing)" do
630− let dbName = "db-getAllKeys"
631− dbVersion = 1
632− storeName = "store"
633− keyPath = []
634− autoIncrement = true
635− callback db = do
636− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
637− _ <- launchAff $ do
638− k1 <- IDBObjectStore.add store "patate" Nothing
639− k2 <- IDBObjectStore.add store "autruche" Nothing
640− k3 <- IDBObjectStore.add store 14 Nothing
641− keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 1 true) Nothing
642− keys `shouldEqual` [k2, k3]
643− pure unit
644−
645− db <- IDBFactory.open dbName Nothing
646− { onUpgradeNeeded : Just callback
647− , onBlocked : Nothing
648− }
649− tearDown dbName dbVersion db
650−
651− it "openCursor(Nothing, Next)" do
652− let dbName = "db-openCursor"
653− dbVersion = 1
654− storeName = "store"
655− keyPath = []
656− autoIncrement = true
657− callback db = do
658− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
659− _ <- launchAff $ do
660− _ <- IDBObjectStore.openCursor store Nothing Next
661− pure unit
662− pure unit
663−
664− db <- IDBFactory.open dbName Nothing
665− { onUpgradeNeeded : Just callback
666− , onBlocked : Nothing
667− }
668− tearDown dbName dbVersion db
669−
670− it "openCursor(Nothing, NextUnique)" do
671− let dbName = "db-openCursor"
672− dbVersion = 1
673− storeName = "store"
674− keyPath = []
675− autoIncrement = true
676− callback db = do
677− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
678− _ <- launchAff $ do
679− _ <- IDBObjectStore.openCursor store Nothing NextUnique
680− pure unit
681− pure unit
682−
683− db <- IDBFactory.open dbName Nothing
684− { onUpgradeNeeded : Just callback
685− , onBlocked : Nothing
686− }
687− tearDown dbName dbVersion db
688−
689− it "openCursor(Nothing, Prev)" do
690− let dbName = "db-openCursor"
691− dbVersion = 1
692− storeName = "store"
693− keyPath = []
694− autoIncrement = true
695− callback db = do
696− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
697− _ <- launchAff $ do
698− _ <- IDBObjectStore.openCursor store Nothing Prev
699− pure unit
700− pure unit
701−
702− db <- IDBFactory.open dbName Nothing
703− { onUpgradeNeeded : Just callback
704− , onBlocked : Nothing
705− }
706− tearDown dbName dbVersion db
707−
708− it "openCursor(Nothing, PrevUnique)" do
709− let dbName = "db-openCursor"
710− dbVersion = 1
711− storeName = "store"
712− keyPath = []
713− autoIncrement = true
714− callback db = do
715− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
716− _ <- launchAff $ do
717− _ <- IDBObjectStore.openCursor store Nothing PrevUnique
718− pure unit
719− pure unit
720−
721− db <- IDBFactory.open dbName Nothing
722− { onUpgradeNeeded : Just callback
723− , onBlocked : Nothing
724− }
725− tearDown dbName dbVersion db
726−
727− it "openCursor(Just upperBound, Next)" do
728− let dbName = "db-openCursor"
729− dbVersion = 1
730− storeName = "store"
731− keyPath = []
732− autoIncrement = true
733− callback db = do
734− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
735− _ <- launchAff $ do
736− _ <- IDBObjectStore.openCursor store (Just $ IDBKeyRange.upperBound 10 true) Next
737− pure unit
738− pure unit
739−
740− db <- IDBFactory.open dbName Nothing
741− { onUpgradeNeeded : Just callback
742− , onBlocked : Nothing
743− }
744− tearDown dbName dbVersion db
745−
746− it "openKeyCursor(Nothing, Next)" do
747− let dbName = "db-openKeyCursor"
748− dbVersion = 1
749− storeName = "store"
750− keyPath = []
751− autoIncrement = true
752− callback db = do
753− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
754− _ <- launchAff $ do
755− _ <- IDBObjectStore.openKeyCursor store Nothing Next
756− pure unit
757− pure unit
758−
759− db <- IDBFactory.open dbName Nothing
760− { onUpgradeNeeded : Just callback
761− , onBlocked : Nothing
762− }
763− tearDown dbName dbVersion db
764−
765− it "openKeyCursor(Nothing, NextUnique)" do
766− let dbName = "db-openKeyCursor"
767− dbVersion = 1
768− storeName = "store"
769− keyPath = []
770− autoIncrement = true
771− callback db = do
772− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
773− _ <- launchAff $ do
774− _ <- IDBObjectStore.openKeyCursor store Nothing NextUnique
775− pure unit
776− pure unit
777−
778− db <- IDBFactory.open dbName Nothing
779− { onUpgradeNeeded : Just callback
780− , onBlocked : Nothing
781− }
782− tearDown dbName dbVersion db
783−
784− it "openKeyCursor(Nothing, Prev)" do
785− let dbName = "db-openKeyCursor"
786− dbVersion = 1
787− storeName = "store"
788− keyPath = []
789− autoIncrement = true
790− callback db = do
791− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
792− _ <- launchAff $ do
793− _ <- IDBObjectStore.openKeyCursor store Nothing Prev
794− pure unit
795− pure unit
796−
797− db <- IDBFactory.open dbName Nothing
798− { onUpgradeNeeded : Just callback
799− , onBlocked : Nothing
800− }
801− tearDown dbName dbVersion db
802−
803− it "openKeyCursor(Nothing, PrevUnique)" do
804− let dbName = "db-openKeyCursor"
805− dbVersion = 1
806− storeName = "store"
807− keyPath = []
808− autoIncrement = true
809− callback db = do
810− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
811− _ <- launchAff $ do
812− _ <- IDBObjectStore.openKeyCursor store Nothing PrevUnique
813− pure unit
814− pure unit
815−
816− db <- IDBFactory.open dbName Nothing
817− { onUpgradeNeeded : Just callback
818− , onBlocked : Nothing
819− }
820− tearDown dbName dbVersion db
821−
822− it "openKeyCursor(Just upperBound, Next)" do
823− let dbName = "db-openKeyCursor"
824− dbVersion = 1
825− storeName = "store"
826− keyPath = []
827− autoIncrement = true
828− callback db = do
829− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
830− _ <- launchAff $ do
831− _ <- IDBObjectStore.openKeyCursor store (Just $ IDBKeyRange.upperBound 10 true) Next
832− pure unit
833− pure unit
834−
835− db <- IDBFactory.open dbName Nothing
836− { onUpgradeNeeded : Just callback
837− , onBlocked : Nothing
838− }
839− tearDown dbName dbVersion db
840−
841− it "store.autoIncrement[true]" do
842− let dbName = "db-autoIncrement"
843− dbVersion = 1
844− storeName = "store"
845− keyPath = []
846− autoIncrement = true
847− callback db = do
848− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
849− let autoIncrement' = IDBObjectStore.autoIncrement store
850− _ <- launchAff $ autoIncrement `shouldEqual` autoIncrement'
851− pure unit
852−
853− db <- IDBFactory.open dbName Nothing
854− { onUpgradeNeeded : Just callback
855− , onBlocked : Nothing
856− }
857− tearDown dbName dbVersion db
858−
859− it "store.autoIncrement[false]" do
860− let dbName = "db-autoIncrement"
861− dbVersion = 1
862− storeName = "store"
863− keyPath = []
864− autoIncrement = false
865− callback db = do
866− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
867− let autoIncrement' = IDBObjectStore.autoIncrement store
868− _ <- launchAff $ autoIncrement `shouldEqual` autoIncrement'
869− pure unit
870−
871− db <- IDBFactory.open dbName Nothing
872− { onUpgradeNeeded : Just callback
873− , onBlocked : Nothing
874− }
875− tearDown dbName dbVersion db
876−
877− it "store.keyPath[\"patate\"]" do
878− let dbName = "db-keyPath"
879− dbVersion = 1
880− storeName = "store"
881− keyPath = ["patate"]
882− autoIncrement = false
883− callback db = do
884− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
885− let keyPath' = IDBObjectStore.keyPath store
886− _ <- launchAff $ keyPath `shouldEqual` keyPath'
887− pure unit
888−
889− db <- IDBFactory.open dbName Nothing
890− { onUpgradeNeeded : Just callback
891− , onBlocked : Nothing
892− }
893− tearDown dbName dbVersion db
894−
895− it "store.indexNames[]" do
896− let dbName = "db-indexNames"
897− dbVersion = 1
898− storeName = "store"
899− keyPath = []
900− autoIncrement = false
901− callback db = do
902− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
903− let indexNames = IDBObjectStore.indexNames store
904− _ <- launchAff $ indexNames `shouldEqual` []
905− pure unit
906−
907− db <- IDBFactory.open dbName Nothing
908− { onUpgradeNeeded : Just callback
909− , onBlocked : Nothing
910− }
911− tearDown dbName dbVersion db
912−
913− it "store.name[\"store\"]" do
914− let dbName = "db-indexNames"
915− dbVersion = 1
916− storeName = "store"
917− keyPath = []
918− autoIncrement = false
919− callback db = do
920− store <- IDBDatabase.createObjectStore db storeName { keyPath, autoIncrement }
921− let storeName' = IDBObjectStore.name store
922− _ <- launchAff $ storeName `shouldEqual` storeName'
923− pure unit
924−
925− db <- IDBFactory.open dbName Nothing
926− { onUpgradeNeeded : Just callback
927− , onBlocked : Nothing
928− }
929− tearDown dbName dbVersion db
392+ it "clear()" do
393+ { db } <- setup
394+ { storeParams: IDBObjectStore.defaultParameters
395+ , onUpgradeNeeded: Just $ \_ store -> pure unit <* (launchAff do
396+ key <- IDBObjectStore.add store "patate" (Just 14)
397+ _ <- IDBObjectStore.clear store
398+ val <- IDBObjectStore.get store (IDBKeyRange.only key)
399+ val `shouldEqual` (Nothing :: Maybe String)
400+ )}
401+ tearDown db
402+
403+ it "count()" do
404+ { db } <- setup
405+ { storeParams: IDBObjectStore.defaultParameters
406+ , onUpgradeNeeded: Just $ \_ store -> pure unit <* (launchAff do
407+ key <- IDBObjectStore.add store "patate" (Just 14)
408+ key <- IDBObjectStore.add store "autruche" (Just 42)
409+ n <- IDBObjectStore.count store Nothing
410+ n `shouldEqual` 2
411+ )}
412+ tearDown db
413+
414+ it "getKey()" do
415+ { db } <- setup
416+ { storeParams: IDBObjectStore.defaultParameters
417+ , onUpgradeNeeded: Just $ \_ store -> pure unit <* (launchAff do
418+ key <- IDBObjectStore.add store "patate" (Just 14)
419+ mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 14)
420+ mkey `shouldEqual` (Just key)
421+
422+ mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 42)
423+ mkey `shouldEqual` (Nothing :: Maybe Key)
424+ )}
425+ tearDown db
426+
427+ it "getAllKeys()" do
428+ { db } <- setup
429+ { storeParams: IDBObjectStore.defaultParameters
430+ , onUpgradeNeeded: Just $ \_ store -> pure unit <* (launchAff do
431+ key1 <- IDBObjectStore.add store "patate" (Just 14)
432+ key2 <- IDBObjectStore.add store "autruche" (Just 42)
433+ key3 <- IDBObjectStore.add store 14 (Just 1337)
434+
435+ -- no bounds
436+ keys <- IDBObjectStore.getAllKeys store Nothing Nothing
437+ keys `shouldEqual` [key1, key2, key3]
438+
439+ -- lower bound
440+ keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 14 true) Nothing
441+ keys `shouldEqual` [key2, key3]
442+
443+ -- upper bound
444+ keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.upperBound 42 false) Nothing
445+ keys `shouldEqual` [key1, key2]
446+
447+ -- count
448+ keys <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 1 true) (Just 2)
449+ keys `shouldEqual` [key1, key2]
450+ )}
451+ tearDown db
452+
453+ it "openCursor()" do
454+ { db } <- setup
455+ { storeParams: IDBObjectStore.defaultParameters
456+ , onUpgradeNeeded: Just $ \_ store -> pure unit <* (launchAff do
457+ _ <- IDBObjectStore.openCursor store Nothing Next
458+ _ <- IDBObjectStore.openCursor store Nothing NextUnique
459+ _ <- IDBObjectStore.openCursor store Nothing Prev
460+ _ <- IDBObjectStore.openCursor store Nothing PrevUnique
461+ _ <- IDBObjectStore.openCursor store (Just $ IDBKeyRange.upperBound 1 true) Next
462+ pure unit
463+ )}
464+ tearDown db
465+
466+ it "openKeyCursor()" do
467+ { db } <- setup
468+ { storeParams: IDBObjectStore.defaultParameters
469+ , onUpgradeNeeded: Just $ \_ store -> pure unit <* (launchAff do
470+ _ <- IDBObjectStore.openKeyCursor store Nothing Next
471+ _ <- IDBObjectStore.openKeyCursor store Nothing NextUnique
472+ _ <- IDBObjectStore.openKeyCursor store Nothing Prev
473+ _ <- IDBObjectStore.openKeyCursor store Nothing PrevUnique
474+ _ <- IDBObjectStore.openKeyCursor store (Just $ IDBKeyRange.lowerBound 1 true) Next
475+ pure unit
476+ )}
477+ tearDown db
478+
479+ describe "IDBIndex" do
480+ let
481+ tearDown db = do
482+ liftEff $ IDBDatabase.close db
483+ _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
484+ pure unit
485+
486+ setup :: forall value e e'.
487+ { storeParams :: { keyPath :: Array String, autoIncrement :: Boolean }
488+ , indexParams :: { unique :: Boolean, multiEntry :: Boolean }
489+ , values :: Array (Tuple value (Maybe Key))
490+ , keyPath :: Array String
491+ , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Eff (idb :: IDB, avar :: AVAR, exception :: EXCEPTION | e') Unit)
492+ } -> Aff (idb :: IDB, avar :: AVAR | e) { db :: Database, index :: Index, store :: ObjectStore }
493+ setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
494+ let onUpgradeNeeded' var db tx = pure unit <* do
495+ store <- IDBDatabase.createObjectStore db "store" storeParams
496+ launchAff do
497+ _ <- traverse (uncurry (IDBObjectStore.add store)) values
498+ index <- liftEff $ IDBObjectStore.createIndex store "index" keyPath indexParams
499+ liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
500+ putVar var { db, index, store }
501+
502+ var <- makeVar
503+ db <- IDBFactory.open "db" Nothing
504+ { onUpgradeNeeded : Just (onUpgradeNeeded' var)
505+ , onBlocked : Nothing
506+ }
507+ takeVar var
508+
509+
510+ it "returns an IDBIndex and the properties are set correctly" do
511+ { db, index } <- setup
512+ { storeParams : IDBObjectStore.defaultParameters
513+ , indexParams : IDBIndex.defaultParameters
514+ , onUpgradeNeeded : Nothing
515+ , keyPath : []
516+ , values : []
517+ }
518+ IDBIndex.name index `shouldEqual` "index"
519+ IDBIndex.keyPath index `shouldEqual` []
520+ IDBIndex.unique index `shouldEqual` IDBIndex.defaultParameters.unique
521+ IDBIndex.multiEntry index `shouldEqual` IDBIndex.defaultParameters.multiEntry
522+ tearDown db
523+
524+ it "attempt to create an index that requires unique values on an object store already contains duplicates" do
525+ let onAbort var = launchAff (putVar var true) *> pure unit
526+ txVar <- makeVar
527+ dbVar <- makeVar
528+ res <- attempt $ setup
529+ { storeParams : IDBObjectStore.defaultParameters
530+ , indexParams : { unique : true
531+ , multiEntry : false
532+ }
533+ , keyPath : ["indexedProperty"]
534+ , values : [ { indexedProperty: "bar" } :+: (Just $ toKey 1)
535+ , { indexedProperty: "bar" } :+: (Just $ toKey 2)
536+ ]
537+ , onUpgradeNeeded : Just $ \db tx _ -> do
538+ IDBTransaction.onAbort tx (onAbort txVar)
539+ IDBDatabase.onAbort db (onAbort dbVar)
540+ }
541+ case res of
542+ Right _ ->
543+ fail "expected abort"
544+ _ -> do
545+ shouldEqual true =<< takeVar txVar
546+ shouldEqual true =<< takeVar dbVar
547+
548+
549+ it "the index is usable right after being made" do
550+ { db } <- setup
551+ { storeParams : { keyPath : ["key"]
552+ , autoIncrement : false
553+ }
554+ , indexParams : IDBIndex.defaultParameters
555+ , keyPath : ["indexedProperty"]
556+ , values : [ { key: "key1", indexedProperty: "indexed_1" } :+: Nothing
557+ , { key: "key2", indexedProperty: "indexed_2" } :+: Nothing
558+ , { key: "key3", indexedProperty: "indexed_3" } :+: Nothing
559+ ]
560+ , onUpgradeNeeded : Just $ \_ _ index -> const unit <$> launchAff do
561+ val <- IDBIndex.get index (IDBKeyRange.only "indexed_2")
562+ ((\r -> r.key) <$> val) `shouldEqual` (Just $ toKey "key2")
563+ }
564+ tearDown db
565+
566+ it "empty keyPath" do
567+ { db } <- setup
568+ { storeParams : IDBObjectStore.defaultParameters
569+ , indexParams : IDBIndex.defaultParameters
570+ , keyPath : []
571+ , values : [ "object_1" :+: (Just $ toKey 1)
572+ , "object_2" :+: (Just $ toKey 2)
573+ , "object_3" :+: (Just $ toKey 3)
574+ ]
575+ , onUpgradeNeeded : Just $ \_ _ index -> const unit <$> launchAff do
576+ val <- IDBIndex.get index (IDBKeyRange.only "object_3")
577+ val `shouldEqual` (Just "object_3")
578+ }
579+ tearDown db
580+
581+ it "index can be valid keys [date]" do
582+ date <- liftEff $ toDateTime <$> now
583+ { db } <- setup
584+ { storeParams : { keyPath: ["key"]
585+ , autoIncrement: false
586+ }
587+ , indexParams : IDBIndex.defaultParameters
588+ , keyPath : ["i"]
589+ , values : [ { key: "date", i: (toKey date) } :+: Nothing
590+ ]
591+ , onUpgradeNeeded : Just $ \_ _ index -> const unit <$> launchAff do
592+ val <- IDBIndex.get index (IDBKeyRange.only date)
593+ ((\r -> r.key) <$> val) `shouldEqual` (Just "date")
594+ }
595+ tearDown db
596+
597+ it "index can be valid keys [num]" do
598+ let num = 14
599+ { db } <- setup
600+ { storeParams : { keyPath: ["key"]
601+ , autoIncrement: false
602+ }
603+ , indexParams : IDBIndex.defaultParameters
604+ , keyPath : ["i"]
605+ , values : [ { key: "num", i: (toKey num) } :+: Nothing
606+ ]
607+ , onUpgradeNeeded : Just $ \_ _ index -> const unit <$> launchAff do
608+ val <- IDBIndex.get index (IDBKeyRange.only num)
609+ ((\r -> r.key) <$> val) `shouldEqual` (Just "num")
610+ }
611+ tearDown db
612+
613+ it "index can be valid keys [array]" do
614+ let array = ["patate", "autruche"]
615+ { db } <- setup
616+ { storeParams : { keyPath: ["key"]
617+ , autoIncrement: false
618+ }
619+ , indexParams : IDBIndex.defaultParameters
620+ , keyPath : ["i"]
621+ , values : [ { key: "array", i: (toKey array) } :+: Nothing
622+ ]
623+ , onUpgradeNeeded : Just $ \_ _ index -> const unit <$> launchAff do
624+ val <- IDBIndex.get index (IDBKeyRange.only array)
625+ ((\r -> r.key) <$> val) `shouldEqual` (Just "array")
626+ }
627+ tearDown db