@@ -16,10 +16,11 @@ import Data.DateTime.Instant (toDateTime)
1616import Data.Either (Either(..))
1717import Data.Enum (toEnum)
1818import Data.Maybe (Maybe(..), isNothing, maybe)
19+import Data.Array (head, drop)
1920import Data.Time.Duration (Milliseconds(..))
2021import Data.Traversable (traverse)
2122import Data.Tuple (Tuple(..), uncurry)
22−import Test.Spec (describe, describe, it, it)
23+import Test.Spec (describe, describeOnly, it)
2324import Test.Spec.Assertions (shouldEqual, fail)
2425import Test.Spec.Mocha (MOCHA, runMocha)
2526
@@ -276,7 +277,7 @@ main = runMocha do
276277 it "can access attributes of a range" do
277278 let range = IDBKeyRange.lowerBound 14 false
278279 IDBKeyRange.lower range `shouldEqual` (Just $ toKey 14)
279− IDBKeyRange.upper range `shouldEqual` (Nothing :: Maybe Key)
280+ IDBKeyRange.upper range `shouldEqual` none
280281 IDBKeyRange.lowerOpen range `shouldEqual` false
281282 IDBKeyRange.upperOpen range `shouldEqual` true
282283
@@ -368,7 +369,7 @@ main = runMocha do
368369 { storeParams: { autoIncrement: true, keyPath: [] }
369370 , onUpgradeNeeded: Just $ \_ store -> launchAff' do
370371 -- no key
371− key <- IDBObjectStore.add store "patate" (Nothing :: Maybe Key)
372+ key <- IDBObjectStore.add store "patate" none
372373 (toKey 1) `shouldEqual` key
373374
374375 -- int key
@@ -424,7 +425,7 @@ main = runMocha do
424425 mkey `shouldEqual` (Just key)
425426
426427 mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 42)
427− mkey `shouldEqual` (Nothing :: Maybe Key)
428+ mkey `shouldEqual` none
428429 }
429430 tearDown db
430431
@@ -455,27 +456,37 @@ main = runMocha do
455456 tearDown db
456457
457458 it "openCursor()" do
459+ let cb =
460+ { onSuccess : const $ pure unit
461+ , onError : show >>> fail >>> launchAff'
462+ , onComplete: pure unit
463+ }
458464 { db } <- setup
459465 { storeParams: IDBObjectStore.defaultParameters
460466 , onUpgradeNeeded: Just $ \_ store -> launchAff' do
461− _ <- IDBObjectStore.openCursor store Nothing Next
462− _ <- IDBObjectStore.openCursor store Nothing NextUnique
463− _ <- IDBObjectStore.openCursor store Nothing Prev
464− _ <- IDBObjectStore.openCursor store Nothing PrevUnique
465− _ <- IDBObjectStore.openCursor store (Just $ IDBKeyRange.upperBound 1 true) Next
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
466472 pure unit
467473 }
468474 tearDown db
469475
470476 it "openKeyCursor()" do
477+ let cb =
478+ { onSuccess : const $ pure unit
479+ , onError : show >>> fail >>> launchAff'
480+ , onComplete: pure unit
481+ }
471482 { db } <- setup
472483 { storeParams: IDBObjectStore.defaultParameters
473484 , onUpgradeNeeded: Just $ \_ store -> launchAff' do
474− _ <- IDBObjectStore.openKeyCursor store Nothing Next
475− _ <- IDBObjectStore.openKeyCursor store Nothing NextUnique
476− _ <- IDBObjectStore.openKeyCursor store Nothing Prev
477− _ <- IDBObjectStore.openKeyCursor store Nothing PrevUnique
478− _ <- IDBObjectStore.openKeyCursor store (Just $ IDBKeyRange.lowerBound 1 true) Next
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
479490 pure unit
480491 }
481492 tearDown db
@@ -637,10 +648,15 @@ main = runMocha do
637648 , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
638649 ]
639650 , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
651+ let cb =
652+ { onSuccess : const $ pure unit
653+ , onError : show >>> fail >>> launchAff'
654+ , onComplete: pure unit
655+ }
640656 IDBTransaction.onAbort tx (pure unit)
641657 IDBDatabase.onAbort db (pure unit)
642658 IDBTransaction.abort tx
643− cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next
659+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
644660 case cursor of
645661 Right _ -> fail "expected InvalidStateError"
646662 Left err -> message err `shouldEqual` "InvalidStateError"
@@ -658,13 +674,17 @@ main = runMocha do
658674 ]
659675 , onUpgradeNeeded : Nothing
660676 }
661−
677+ let cb =
678+ { onSuccess : const $ pure unit
679+ , onError : show >>> fail >>> launchAff'
680+ , onComplete: pure unit
681+ }
662682 tx <- IDBDatabase.transaction db ["store"] ReadOnly
663683 store <- IDBTransaction.objectStore tx "store"
664684 index <- IDBObjectStore.index store "index"
665685 IDBTransaction.onAbort tx (pure unit)
666686 IDBTransaction.abort tx
667− cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next
687+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
668688 case cursor of
669689 Right _ -> fail "expected TransactionInactiveError"
670690 Left err -> message err `shouldEqual` "TransactionInactiveError"
@@ -679,9 +699,14 @@ main = runMocha do
679699 , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
680700 ]
681701 , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
702+ let cb =
703+ { onSuccess : const $ pure unit
704+ , onError : show >>> fail >>> launchAff'
705+ , onComplete: pure unit
706+ }
682707 store <- IDBTransaction.objectStore tx "store"
683708 IDBObjectStore.deleteIndex store "index"
684− cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next
709+ cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
685710 case cursor of
686711 Right _ -> fail "expected InvalidStateError"
687712 Left err -> message err `shouldEqual` "InvalidStateError"
@@ -697,10 +722,15 @@ main = runMocha do
697722 , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
698723 ]
699724 , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
725+ let cb =
726+ { onSuccess : const $ pure unit
727+ , onError : show >>> fail >>> launchAff'
728+ , onComplete: pure unit
729+ }
700730 IDBTransaction.onAbort tx (pure unit)
701731 IDBDatabase.onAbort db (pure unit)
702732 IDBTransaction.abort tx
703− cursor <- attempt $ IDBIndex.openCursor index Nothing Next
733+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
704734 case cursor of
705735 Right _ -> fail "expected InvalidStateError"
706736 Left err -> message err `shouldEqual` "InvalidStateError"
@@ -718,13 +748,17 @@ main = runMocha do
718748 ]
719749 , onUpgradeNeeded : Nothing
720750 }
721−
751+ let cb =
752+ { onSuccess : const $ pure unit
753+ , onError : show >>> fail >>> launchAff'
754+ , onComplete: pure unit
755+ }
722756 tx <- IDBDatabase.transaction db ["store"] ReadOnly
723757 store <- IDBTransaction.objectStore tx "store"
724758 index <- IDBObjectStore.index store "index"
725759 IDBTransaction.onAbort tx (pure unit)
726760 IDBTransaction.abort tx
727− cursor <- attempt $ IDBIndex.openCursor index Nothing Next
761+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
728762 case cursor of
729763 Right _ -> fail "expected TransactionInactiveError"
730764 Left err -> message err `shouldEqual` "TransactionInactiveError"
@@ -739,9 +773,14 @@ main = runMocha do
739773 , values : [ { key: 14, indexedProperty: "patate" } :+: Nothing
740774 ]
741775 , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
776+ let cb =
777+ { onSuccess : const $ pure unit
778+ , onError : show >>> fail >>> launchAff'
779+ , onComplete: pure unit
780+ }
742781 store <- IDBTransaction.objectStore tx "store"
743782 IDBObjectStore.deleteIndex store "index"
744− cursor <- attempt $ IDBIndex.openCursor index Nothing Next
783+ cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
745784 case cursor of
746785 Right _ -> fail "expected InvalidStateError"
747786 Left err -> message err `shouldEqual` "InvalidStateError"
@@ -789,3 +828,244 @@ main = runMocha do
789828 ((\r -> r.key) <$> val) `shouldEqual` (Just 42)
790829
791830 tearDown db
831+
832+ describe "IDBCursor" do
833+ let
834+ tearDown db = do
835+ IDBDatabase.close db
836+ _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
837+ pure unit
838+
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 }
846+ setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
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
858+ }
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 =
874+ { onComplete: launchAff' do
875+ putVar vdone unit
876+
877+ , onError: \error -> launchAff' do
878+ fail $ "unexpected error: " <> show error
879+
880+ , onSuccess: \cursor -> launchAff' do
881+ vals <- takeVar vvals
882+ pure (IDBCursor.value cursor) >>= shouldEqual (maybe "" _.v $ head vals)
883+ IDBCursor.primaryKey cursor >>= shouldEqual (maybe (toKey 0) _.k $ head vals)
884+ putVar vvals (drop 1 vals)
885+ IDBCursor.continue cursor none
886+ }
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 =
913+ { onComplete: launchAff' do
914+ fail $ "shouldn't complete"
915+
916+ , onError: \error -> launchAff' do
917+ fail $ "unexpected error: " <> show error
918+
919+ , onSuccess: \cursor -> launchAff' do
920+ res <- attempt $ IDBCursor.continue cursor (Just 1)
921+ case res of
922+ Left err -> do
923+ message err `shouldEqual` "DataError"
924+ putVar vdone unit
925+ Right _ -> do
926+ fail "expected continue to fail"
927+ }
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 =
949+ { onComplete: launchAff' do
950+ putVar vdone unit
951+
952+ , onError: \error -> launchAff' do
953+ fail $ "unexpected error: " <> show error
954+
955+ , onSuccess: \cursor -> launchAff' do
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
966+ }
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 =
988+ { onComplete: launchAff' do
989+ mval <- map _.pKey <$> IDBIndex.get store (IDBKeyRange.only "pkey_0")
990+ mval `shouldEqual` (Nothing :: Maybe String)
991+ putVar vdone unit
992+
993+ , onError: \error -> launchAff' do
994+ fail $ "unexpected error: " <> show error
995+
996+ , onSuccess: \cursor -> launchAff' do
997+ let value = IDBCursor.value cursor
998+ value.pKey `shouldEqual` "pkey_0"
999+ IDBCursor.delete cursor
1000+ IDBCursor.advance cursor 4
1001+ }
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 =
1019+ { onComplete: launchAff' do
1020+ mval <- map _.iKey <$> IDBIndex.get store (IDBKeyRange.only "pkey_0")
1021+ mval `shouldEqual` (Just "patate")
1022+ putVar vdone unit
1023+
1024+ , onError: \error -> launchAff' do
1025+ fail $ "unexpected error: " <> show error
1026+
1027+ , onSuccess: \cursor -> launchAff' do
1028+ let value = IDBCursor.value cursor
1029+ value.pKey `shouldEqual` "pkey_0"
1030+ key <- IDBCursor.update cursor { pKey: "pkey_0", iKey: "patate" }
1031+ key `shouldEqual` toKey "pkey_0"
1032+ IDBCursor.advance cursor 4
1033+ }
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 =
1051+ { onComplete: launchAff' do
1052+ fail $ "shouldn't complete"
1053+
1054+ , onError: \error -> launchAff' do
1055+ fail $ "unexpected error: " <> show error
1056+
1057+ , onSuccess: \cursor -> launchAff' do
1058+ res <- attempt $ IDBCursor.update cursor "patate"
1059+ case res of
1060+ Left err -> do
1061+ message err `shouldEqual` "ReadOnlyError"
1062+ putVar vdone unit
1063+ Right _ ->
1064+ fail $ "expected ReadOnlyError"
1065+ }
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