Make more assertions about parse results

module Test.Main where

import Prelude
import Debug.Trace
import Control.MonadPlus (guard)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Console (log)
import Control.Monad.Eff.Exception (EXCEPTION(), error, throwException)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Trans (lift)
import qualified Text.Parsing.Parser as P
import Data.Either (Either(..), isRight, isLeft, either)
import Data.Either.Unsafe (fromLeft, fromRight)
import Data.List (length, (!!))
import Data.Maybe.Unsafe (fromJust)
import Data.Maybe (Maybe(..))
import Test.Assert.Simple

import Docopt
import qualified Docopt.Parser.Usage as Usage
import qualified Docopt.Parser.Options as Options
import qualified Docopt.Textwrap as Textwrap
import qualified Docopt.Parser.Lexer as Lexer
import qualified Docopt.Parser.Scanner as Scanner
import Docopt.Parser.Base (debug)

import Test.Assert (assert)
import Test.Spec (describe, it)
import Test.Spec.Runner (run)
import Test.Spec.Reporter.Console (consoleReporter)

main = run [consoleReporter] do
  describe "scanner" do
    it "should scan sections" do
      let docopt = fromRight $ Scanner.scan $
          Textwrap.dedent
            """
            Usage: foo
            Options: bar
            Advanced Options: qux
            """
      liftEff do
        assert $ docopt.usage == "foo\n"
        assert $ length docopt.options == 2
        assert $ fromJust (docopt.options !! 0) == " bar\n"
        assert $ fromJust (docopt.options !! 1) == " qux\n"
      pure unit

    it "should scan sections with new line after colon" do
      let docopt = fromRight $ Scanner.scan $
          Textwrap.dedent
            """
            Usage:
              foo
            Options:
              bar
            Advanced Options:
              qux
            """
      liftEff do
        assert $ docopt.usage == "foo\n"
        assert $ length docopt.options == 2
        assert $ fromJust (docopt.options !! 0) == "\n  bar\n"
        assert $ fromJust (docopt.options !! 1) == "\n  qux\n"
      pure unit

    it "should fail w/o a usage section" do
      let result = Scanner.scan $
          Textwrap.dedent
            """
            Options: bar
            """
      liftEff $ do
        assert $ isLeft result
      pure unit

    it "should fail multiple usage sections" do
      let result = Scanner.scan $
          Textwrap.dedent
            """
            Usage: bar
            Options: foo
            Usage: qux
            """
      liftEff $ do
        assert $ isLeft result
      pure unit

    it "should fail if usage section is not the first section" do
      let result = Scanner.scan $
          Textwrap.dedent
            """
            Options: foo
            Usage: qux
            """
      liftEff $ do
        assert $ isLeft result
      pure unit

    it "should fail w/o any sections" do
      let result = Scanner.scan $
          Textwrap.dedent
            """
            """
      liftEff $ do
        assert $ isLeft result
      pure unit

  describe "parser" do
    it "should parse usage sections" do

      liftEff do

        -- Scan, lex and parse the usage section
        usage <- runEitherEff do
          docopt <- Scanner.scan $
            Textwrap.dedent
              """
              Usage: foo foo | bar aux
                    foo (bar qux)
              NOT PART OF SECTION
              """
          toks <- Lexer.lex docopt.usage
          Usage.parse toks
        assertEqual 2 (length usage)

        -- Validate the first usage
        (Usage.Usage _ u0) <- runMaybeEff $ usage !! 0
        assertEqual 2 (length u0)

        -- Validate the left half of the mutex group
        u0g0 <- runMaybeEff $ u0 !! 0
        assertEqual 1 (length u0g0)

        -- Validate the right half of the mutex group
        u0g1 <- runMaybeEff $ u0 !! 1
        assertEqual 2 (length u0g1)

        -- Validate the second usage
        (Usage.Usage _ u1) <- runMaybeEff $ usage !! 1
        assertEqual 1 (length u1)

        u1g0 <- runMaybeEff $ u1 !! 0
        assertEqual 1 (length u1g0)

      pure unit

  where

    runMaybeEff :: forall a eff.
      Maybe a ->
      Eff (err :: EXCEPTION | eff) a
    runMaybeEff m =
      case m of
        Just v  -> pure v
        Nothing -> throwException (error "Nothing")

    runEitherEff :: forall err a eff. (Show err, Show a) =>
      Either err a ->
      Eff (err :: EXCEPTION | eff) a
    runEitherEff m =
      case m of
        Right v  -> pure v
        Left err -> throwException (error $ show err)

module Test.Main where

import Prelude
import Debug.Trace
import Control.MonadPlus (guard)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Console (log)
import Control.Monad.Eff.Exception (EXCEPTION(), error, throwException)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Trans (lift)
import qualified Text.Parsing.Parser as P
import Data.Either (Either(..), isRight, isLeft, either)
import Data.Either.Unsafe (fromLeft, fromRight)
import Data.List (length, (!!))
import Data.Maybe.Unsafe (fromJust)
import Data.Maybe (Maybe(..))
import Test.Assert.Simple

import Docopt
import qualified Docopt.Parser.Usage as Usage
import qualified Docopt.Parser.Options as Options
import qualified Docopt.Textwrap as Textwrap
import qualified Docopt.Parser.Lexer as Lexer
import qualified Docopt.Parser.Scanner as Scanner
import Docopt.Parser.Base (debug)

import Test.Assert (assert)
import Test.Spec (describe, it)
import Test.Spec.Runner (run)
import Test.Spec.Reporter.Console (consoleReporter)

main = run [consoleReporter] do
  describe "scanner" do
    it "should scan sections" do
      let docopt = fromRight $ Scanner.scan $
          Textwrap.dedent
            """
            Usage: foo
            Options: bar
            Advanced Options: qux
            """
      liftEff do
        assert $ docopt.usage == "foo\n"
        assert $ length docopt.options == 2
        assert $ fromJust (docopt.options !! 0) == " bar\n"
        assert $ fromJust (docopt.options !! 1) == " qux\n"
      pure unit

    it "should scan sections with new line after colon" do
      let docopt = fromRight $ Scanner.scan $
          Textwrap.dedent
            """
            Usage:
              foo
            Options:
              bar
            Advanced Options:
              qux
            """
      liftEff do
        assert $ docopt.usage == "foo\n"
        assert $ length docopt.options == 2
        assert $ fromJust (docopt.options !! 0) == "\n  bar\n"
        assert $ fromJust (docopt.options !! 1) == "\n  qux\n"
      pure unit

    it "should fail w/o a usage section" do
      let result = Scanner.scan $
          Textwrap.dedent
            """
            Options: bar
            """
      liftEff $ do
        assert $ isLeft result
      pure unit

    it "should fail multiple usage sections" do
      let result = Scanner.scan $
          Textwrap.dedent
            """
            Usage: bar
            Options: foo
            Usage: qux
            """
      liftEff $ do
        assert $ isLeft result
      pure unit

    it "should fail if usage section is not the first section" do
      let result = Scanner.scan $
          Textwrap.dedent
            """
            Options: foo
            Usage: qux
            """
      liftEff $ do
        assert $ isLeft result
      pure unit

    it "should fail w/o any sections" do
      let result = Scanner.scan $
          Textwrap.dedent
            """
            """
      liftEff $ do
        assert $ isLeft result
      pure unit

  describe "parser" do
    it "should parse usage sections" do

      liftEff do

        usage <- runEitherEff do
          docopt <- Scanner.scan $
            Textwrap.dedent
              """
              Usage: foo foo | bar
                    foo (bar qux)
              """
          toks <- Lexer.lex docopt.usage
          Usage.parse toks
        assertEqual 2 (length usage)

        -- Validate the first usage
        (Usage.Usage _ u0) <- runMaybeEff $ usage !! 0
        assertEqual 2 (length u0)

        -- Validate the second usage
        (Usage.Usage _ u1) <- runMaybeEff $ usage !! 1
        assertEqual 1 (length u1)

      pure unit

  where

    runMaybeEff :: forall a eff.
      Maybe a ->
      Eff (err :: EXCEPTION | eff) a
    runMaybeEff m =
      case m of
        Just v  -> pure v
        Nothing -> throwException (error "Nothing")

    runEitherEff :: forall err a eff. (Show err, Show a) =>
      Either err a ->
      Eff (err :: EXCEPTION | eff) a
    runEitherEff m =
      case m of
        Right v  -> pure v
        Left err -> throwException (error $ show err)


add some test cases for IDBCursor

add some test cases for IDBCursor

module Test.Main where

import Prelude

import Control.Monad.Aff                 (Aff, launchAff, forkAff, delay, attempt)
import Control.Monad.Aff.AVar            (AVAR, makeVar, makeVar', modifyVar, peekVar, putVar, takeVar)
import Control.Monad.Aff.Console         (log)
import Control.Monad.Eff                 (Eff)
import Control.Monad.Eff.Class           (liftEff)
import Control.Monad.Eff.Exception       (EXCEPTION, message)
import Control.Monad.Eff.Now             (NOW, now)
import Data.Date                          as Date
import Data.DateTime                      as DateTime
import Data.DateTime                     (DateTime(..), Time(..))
import Data.DateTime.Instant             (toDateTime)
import Data.Either                       (Either(..))
import Data.Enum                         (toEnum)
import Data.Maybe                        (Maybe(..), isNothing, maybe)
import Data.Array                        (head, drop)
import Data.Time.Duration                (Milliseconds(..))
import Data.Traversable                  (traverse)
import Data.Tuple                        (Tuple(..), uncurry)
import Test.Spec                         (describe, describeOnly, it)
import Test.Spec.Assertions              (shouldEqual, fail)
import Test.Spec.Mocha                   (MOCHA, runMocha)

import Database.IndexedDB.Core
import Database.IndexedDB.IDBKey
import Database.IndexedDB.IDBCursor       as IDBCursor
import Database.IndexedDB.IDBDatabase     as IDBDatabase
import Database.IndexedDB.IDBFactory      as IDBFactory
import Database.IndexedDB.IDBIndex        as IDBIndex
import Database.IndexedDB.IDBKeyRange     as IDBKeyRange
import Database.IndexedDB.IDBObjectStore  as IDBObjectStore
import Database.IndexedDB.IDBTransaction  as IDBTransaction

infixr 7 Tuple as :+:

launchAff' :: forall a e. Aff e a -> Eff (exception :: EXCEPTION | e) Unit
launchAff' aff =
  pure unit <* (launchAff aff)

-- main :: forall eff. Eff (now :: NOW, mocha :: MOCHA, idb :: IDB, exception :: EXCEPTION, avar :: AVAR | eff) Unit
main = runMocha do
  describe "IDBFactory" do
    let
        tearDown name version db = do
          IDBDatabase.close db
          version' <- IDBFactory.deleteDatabase name
          version' `shouldEqual` version

    it "open default" do
      let name    = "db-default"
          version = 1
      db <- IDBFactory.open name Nothing
        { onUpgradeNeeded : Nothing
        , onBlocked       : Nothing
        }
      IDBDatabase.name db `shouldEqual` name
      tearDown name version db

    it "open specific version" do
      let name    = "db-specific"
          version = 14
      db <- IDBFactory.open name (Just version)
        { onUpgradeNeeded : Nothing
        , onBlocked       : Nothing
        }
      IDBDatabase.name db `shouldEqual` name
      tearDown name version db

    it "open specific version -> close -> open latest" do
      let name    = "db-latest"
          version = 14
      db <- IDBFactory.open name (Just version)
        { onUpgradeNeeded : Nothing
        , onBlocked : Nothing
        }
      IDBDatabase.name db `shouldEqual` name
      IDBDatabase.close db
      db <- IDBFactory.open name Nothing
        { onUpgradeNeeded : Nothing
        , onBlocked       : Nothing
        }
      tearDown name version db

    it "open + onUpgradeNeed" do
      let name    = "db-upgrade-needed"
          version = 1
          callback var db _ = do
            _ <- launchAff $ modifyVar (const $ IDBDatabase.name db) var
            pure unit
      var <- makeVar' "-"
      db  <- IDBFactory.open name Nothing
        { onUpgradeNeeded : Just (callback var)
        , onBlocked       : Nothing
        }
      name <- peekVar var
      name `shouldEqual` name
      tearDown name version db

    it "open + onBlocked" do
      let name    = "db-blocked"
          version = 14
          callback var = do
            _ <- launchAff $ modifyVar (const $ "db-blocked") var
            pure unit

      var   <- makeVar' "-"
      db01  <- IDBFactory.open name Nothing
        { onUpgradeNeeded : Nothing
        , onBlocked       : Nothing
        }
      _ <- forkAff do
        delay (Milliseconds 100.0)
        IDBDatabase.close db01

      db02  <- IDBFactory.open name (Just version)
        { onUpgradeNeeded : Nothing
        , onBlocked       : Just (callback var)
        }
      name <- peekVar var
      name `shouldEqual` name
      tearDown name version db02

  describe "IDBKeyRange" do
    it "only(int)" do
      let key   = 14
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only(string)" do
      let key   = "patate"
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only(float)" do
      let key   = 14.42
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only(date)" do
      let mkey = DateTime
            <$> (Date.canonicalDate <$> toEnum 2017 <*> toEnum 6 <*> toEnum 23)
            <*> (Time <$> toEnum 17 <*> toEnum 59 <*> toEnum 34 <*> toEnum 42)

      case mkey of
        Nothing ->
          fail "unable to create datetime"
        Just key -> do
          let range = IDBKeyRange.only key
          IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only([int])" do
      let key   = [14, 42]
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only([string])" do
      let key   = ["patate", "autruche"]
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "lowerBound(14, open)" do
      let key   = 14
          open  = true
          range = IDBKeyRange.lowerBound key open
      IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
      IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
      IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false

    it "lowerBound(14, close)" do
      let key   = 14
          open  = false
          range = IDBKeyRange.lowerBound key open
      IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
      IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
      IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false

    it "upperBound(14, open)" do
      let key   = 14
          open  = true
          range = IDBKeyRange.upperBound key open
      IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
      IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
      IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true

    it "upperBound(14, close)" do
      let key   = 14
          open  = false
          range = IDBKeyRange.upperBound key open
      IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
      IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
      IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true

    it "bound(42, 14, open, open) => Nothing" do
      let lower     = 42
          upper     = 14
          lowerOpen = true
          upperOpen = true
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      isNothing mrange `shouldEqual` true

    it "bound(14, 42, open, open)" do
      let lower     = 14
          upper     = 42
          lowerOpen = true
          upperOpen = true
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      case mrange of
        Nothing ->
          fail "invalid range provided"
        Just range -> do
          IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
          IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)

    it "bound(14, 42, open, close)" do
      let lower     = 14
          upper     = 42
          lowerOpen = true
          upperOpen = false
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      case mrange of
        Nothing ->
          fail "invalid range provided"
        Just range -> do
          IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
          IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)

    it "bound(14, 42, close, open)" do
      let lower     = 14
          upper     = 42
          lowerOpen = false
          upperOpen = true
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      case mrange of
        Nothing ->
          fail "invalid range provided"
        Just range -> do
          IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
          IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)

    it "bound(14, 42, close, close)" do
      let lower     = 14
          upper     = 42
          lowerOpen = false
          upperOpen = false
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      case mrange of
        Nothing ->
          fail "invalid range provided"
        Just range -> do
          IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
          IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)

    it "can access attributes of a range" do
      let range = IDBKeyRange.lowerBound 14 false
      IDBKeyRange.lower range `shouldEqual` (Just $ toKey 14)
      IDBKeyRange.upper range `shouldEqual` none
      IDBKeyRange.lowerOpen range `shouldEqual` false
      IDBKeyRange.upperOpen range `shouldEqual` true

  describe "IDBDatabase" do
    let
        tearDown db = do
          IDBDatabase.close db
          _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
          pure unit

        setup storeParams = do
          let onUpgradeNeeded var db _ = launchAff' do
                store <- IDBDatabase.createObjectStore db "store" storeParams
                _     <- putVar var { db, store }
                pure unit

          var <- makeVar
          db  <- IDBFactory.open "db" Nothing
            { onUpgradeNeeded : Just (onUpgradeNeeded var)
            , onBlocked : Nothing
            }

          takeVar var

    it "createObjectStore (keyPath: [], autoIncrement: true)" do
      { db, store } <- setup { keyPath: [], autoIncrement: true }
      IDBObjectStore.name store `shouldEqual` "store"
      IDBObjectStore.keyPath store `shouldEqual` []
      IDBObjectStore.autoIncrement store `shouldEqual` true
      IDBObjectStore.indexNames store `shouldEqual` []
      tearDown db

    it "createObjectStore (keyPath: [\"patate\"], autoIncrement: true)" do
      { db, store } <- setup { keyPath: ["patate"], autoIncrement: true }
      IDBObjectStore.name store `shouldEqual` "store"
      IDBObjectStore.keyPath store `shouldEqual` ["patate"]
      IDBObjectStore.autoIncrement store `shouldEqual` true
      IDBObjectStore.indexNames store `shouldEqual` []
      tearDown db

    it "createObjectStore (keyPath: [\"a\", \"b\"], autoIncrement: false)" do
      { db, store } <- setup { keyPath: ["patate", "autruche"], autoIncrement: false }
      IDBObjectStore.name store `shouldEqual` "store"
      IDBObjectStore.keyPath store `shouldEqual` ["patate", "autruche"]
      IDBObjectStore.autoIncrement store `shouldEqual` false
      IDBObjectStore.indexNames store `shouldEqual` []
      tearDown db

    it "deleteObjectStore" do
      let onUpgradeNeeded var db _ = launchAff' do
            _ <- IDBDatabase.deleteObjectStore db "store"
            putVar var true

      var           <- makeVar
      { db, store } <- setup IDBObjectStore.defaultParameters
      IDBDatabase.close db
      db <- IDBFactory.open "db" (Just 999) { onUpgradeNeeded : Just (onUpgradeNeeded var)
                                            , onBlocked       : Nothing
                                            }
      deleted <- takeVar var
      deleted `shouldEqual` true
      tearDown db

  describe "IDBObjectStore" do
    let
        tearDown db = do
          IDBDatabase.close db
          _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
          pure unit

        setup { storeParams, onUpgradeNeeded } = do
          let onUpgradeNeeded' var db _ = launchAff' do
                store <- IDBDatabase.createObjectStore db "store" storeParams
                liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure store)
                putVar var { db, store }

          var <- makeVar
          db  <- IDBFactory.open "db" Nothing
            { onUpgradeNeeded : Just (onUpgradeNeeded' var)
            , onBlocked : Nothing
            }

          takeVar var

    it "add()" do
      date   <- liftEff $ toDateTime <$> now
      { db } <- setup
        { storeParams: { autoIncrement: true, keyPath: [] }
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            -- no key
            key <- IDBObjectStore.add store "patate" none
            (toKey 1) `shouldEqual` key

            -- int key
            key <- IDBObjectStore.add store "patate" (Just 14)
            (toKey 14) `shouldEqual` key

            -- number key
            key <- IDBObjectStore.add store "patate" (Just 14.42)
            (toKey 14.42) `shouldEqual` key

            -- string key
            key <- IDBObjectStore.add store "patate" (Just "key")
            (toKey "key") `shouldEqual` key

            -- date key
            key <- IDBObjectStore.add store "patate" (Just date)
            (toKey date) `shouldEqual` key

            -- array key
            key <- IDBObjectStore.add store "patate" (Just $ toKey [14, 42])
            (toKey [14, 42]) `shouldEqual` key
        }
      tearDown db

    it "clear()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            key <- IDBObjectStore.add store "patate" (Just 14)
            _   <- IDBObjectStore.clear store
            val <- IDBObjectStore.get store (IDBKeyRange.only key)
            val `shouldEqual` (Nothing :: Maybe String)
        }
      tearDown db

    it "count()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            key <- IDBObjectStore.add store "patate" (Just 14)
            key <- IDBObjectStore.add store "autruche" (Just 42)
            n   <- IDBObjectStore.count store Nothing
            n `shouldEqual` 2
        }
      tearDown db

    it "getKey()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            key  <- IDBObjectStore.add store "patate" (Just 14)
            mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 14)
            mkey `shouldEqual` (Just key)

            mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 42)
            mkey `shouldEqual` none
          }
      tearDown db

    it "getAllKeys()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            key1  <- IDBObjectStore.add store "patate" (Just 14)
            key2  <- IDBObjectStore.add store "autruche" (Just 42)
            key3  <- IDBObjectStore.add store 14 (Just 1337)

            -- no bounds
            keys  <- IDBObjectStore.getAllKeys store Nothing Nothing
            keys `shouldEqual` [key1, key2, key3]

            -- lower bound
            keys  <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 14 true) Nothing
            keys `shouldEqual` [key2, key3]

            -- upper bound
            keys  <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.upperBound 42 false) Nothing
            keys `shouldEqual` [key1, key2]

            -- count
            keys  <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 1 true) (Just 2)
            keys `shouldEqual` [key1, key2]
        }
      tearDown db

    it "openCursor()" do
      let cb =
            { onSuccess : const $ pure unit
            , onError   : show >>> fail >>> launchAff'
            , onComplete: pure unit
            }
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            _ <- IDBObjectStore.openCursor store Nothing Next cb
            _ <- IDBObjectStore.openCursor store Nothing NextUnique cb
            _ <- IDBObjectStore.openCursor store Nothing Prev cb
            _ <- IDBObjectStore.openCursor store Nothing PrevUnique cb
            _ <- IDBObjectStore.openCursor store (Just $ IDBKeyRange.upperBound 1 true) Next cb
            pure unit
        }
      tearDown db

    it "openKeyCursor()" do
      let cb =
            { onSuccess : const $ pure unit
            , onError   : show >>> fail >>> launchAff'
            , onComplete: pure unit
            }
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            _ <- IDBObjectStore.openKeyCursor store Nothing Next cb
            _ <- IDBObjectStore.openKeyCursor store Nothing NextUnique cb
            _ <- IDBObjectStore.openKeyCursor store Nothing Prev cb
            _ <- IDBObjectStore.openKeyCursor store Nothing PrevUnique cb
            _ <- IDBObjectStore.openKeyCursor store (Just $ IDBKeyRange.lowerBound 1 true) Next cb
            pure unit
        }
      tearDown db

  describe "IDBIndex" do
    let
        tearDown db = do
          IDBDatabase.close db
          _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
          pure unit

        setup :: forall value e e'.
                 { storeParams     :: { keyPath :: Array String, autoIncrement :: Boolean }
                 , indexParams     :: { unique :: Boolean, multiEntry :: Boolean }
                 , values          :: Array (Tuple value (Maybe Key))
                 , keyPath         :: Array String
                 , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Eff (idb :: IDB, avar :: AVAR, exception :: EXCEPTION | e') Unit)
               } -> Aff (idb :: IDB, avar :: AVAR | e) { db :: Database, index :: Index, store :: ObjectStore }
        setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
          let onUpgradeNeeded' var db tx = launchAff' do
                store <- IDBDatabase.createObjectStore db "store" storeParams
                _     <- traverse (uncurry (IDBObjectStore.add store)) values
                index <- IDBObjectStore.createIndex store "index" keyPath indexParams
                liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
                putVar var { db, index, store }

          var <- makeVar
          db  <- IDBFactory.open "db" Nothing
            { onUpgradeNeeded : Just (onUpgradeNeeded' var)
            , onBlocked : Nothing
            }
          takeVar var

    it "returns an IDBIndex and the properties are set correctly" do
      { db, index } <- setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : IDBIndex.defaultParameters
        , onUpgradeNeeded : Nothing
        , keyPath         : []
        , values          : []
        }
      IDBIndex.name index `shouldEqual` "index"
      IDBIndex.keyPath index `shouldEqual` []
      IDBIndex.unique index `shouldEqual` IDBIndex.defaultParameters.unique
      IDBIndex.multiEntry index `shouldEqual` IDBIndex.defaultParameters.multiEntry
      tearDown db

    it "attempt to create an index that requires unique values on an object store already contains duplicates" do
      let onAbort var = launchAff' (putVar var true)
      txVar <- makeVar
      dbVar <- makeVar
      res   <- attempt $ setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : { unique : true
                            , multiEntry : false
                            }
        , keyPath         : ["indexedProperty"]
        , values          : [ { indexedProperty: "bar" } :+: (Just $ toKey 1)
                            , { indexedProperty: "bar" } :+: (Just $ toKey 2)
                            ]
        , onUpgradeNeeded : Just $ \db tx _ -> launchAff' do
            IDBTransaction.onAbort tx (onAbort txVar)
            IDBDatabase.onAbort db (onAbort dbVar)
        }
      case res of
        Right _ ->
          fail "expected abort"
        _       -> do
          shouldEqual true =<< takeVar txVar
          shouldEqual true =<< takeVar dbVar

    it "the index is usable right after being made" do
      { db } <- setup
        { storeParams     : { keyPath       : ["key"]
                            , autoIncrement : false
                            }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: "key1", indexedProperty: "indexed_1" } :+: Nothing
                            , { key: "key2", indexedProperty: "indexed_2" } :+: Nothing
                            , { key: "key3", indexedProperty: "indexed_3" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only "indexed_2")
            ((\r -> r.key) <$> val) `shouldEqual` (Just $ toKey "key2")
        }
      tearDown db

    it "empty keyPath" do
      { db } <- setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : []
        , values          : [ "object_1" :+: (Just $ toKey 1)
                            , "object_2" :+: (Just $ toKey 2)
                            , "object_3" :+: (Just $ toKey 3)
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only "object_3")
            val `shouldEqual` (Just "object_3")
        }
      tearDown db

    it "index can be valid keys [date]" do
      date   <- liftEff $ toDateTime <$> now
      { db } <- setup
        { storeParams     : { keyPath: ["key"]
                            , autoIncrement: false
                            }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["i"]
        , values          : [ { key: "date", i: (toKey date) } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only date)
            ((\r -> r.key) <$> val) `shouldEqual` (Just "date")
        }
      tearDown db

    it "index can be valid keys [num]" do
      let num = 14
      { db } <- setup
        { storeParams     : { keyPath: ["key"]
                            , autoIncrement: false
                            }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["i"]
        , values          : [ { key: "num", i: (toKey num) } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only num)
            ((\r -> r.key) <$> val) `shouldEqual` (Just "num")
        }
      tearDown db

    it "index can be valid keys [array]" do
      let array = ["patate", "autruche"]
      { db } <- setup
        { storeParams     : { keyPath: ["key"]
                            , autoIncrement: false
                            }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["i"]
        , values          : [ { key: "array", i: (toKey array) } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only array)
            ((\r -> r.key) <$> val) `shouldEqual` (Just "array")
        }
      tearDown db

    it "openKeyCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
      res <- attempt $ setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
            let cb =
                  { onSuccess : const $ pure unit
                  , onError   : show >>> fail >>> launchAff'
                  , onComplete: pure unit
                  }
            IDBTransaction.onAbort tx (pure unit)
            IDBDatabase.onAbort db (pure unit)
            IDBTransaction.abort tx
            cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
            case cursor of
              Right _  -> fail "expected InvalidStateError"
              Left err -> message err `shouldEqual` "InvalidStateError"
        }
      case res of
        Right _ -> fail "expected InvalidStateError"
        _       -> pure unit

    it "openKeyCursor() - throw TransactionInactiveError on aborted transaction" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Nothing
        }
      let cb =
            { onSuccess : const $ pure unit
            , onError   : show >>> fail >>> launchAff'
            , onComplete: pure unit
            }
      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      index <- IDBObjectStore.index store "index"
      IDBTransaction.onAbort tx (pure unit)
      IDBTransaction.abort tx
      cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
      case cursor of
        Right _  -> fail "expected TransactionInactiveError"
        Left err -> message err `shouldEqual` "TransactionInactiveError"

      tearDown db

    it "openKeyCursor() - throw InvalidStateError when the index is deleted" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
            let cb =
                  { onSuccess : const $ pure unit
                  , onError   : show >>> fail >>> launchAff'
                  , onComplete: pure unit
                  }
            store <- IDBTransaction.objectStore tx "store"
            IDBObjectStore.deleteIndex store "index"
            cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next cb
            case cursor of
              Right _  -> fail "expected InvalidStateError"
              Left err -> message err `shouldEqual` "InvalidStateError"
        }

      tearDown db

    it "openCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
      res <- attempt $ setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
            let cb =
                  { onSuccess : const $ pure unit
                  , onError   : show >>> fail >>> launchAff'
                  , onComplete: pure unit
                  }
            IDBTransaction.onAbort tx (pure unit)
            IDBDatabase.onAbort db (pure unit)
            IDBTransaction.abort tx
            cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
            case cursor of
              Right _  -> fail "expected InvalidStateError"
              Left err -> message err `shouldEqual` "InvalidStateError"
        }
      case res of
        Right _ -> fail "expected InvalidStateError"
        _       -> pure unit

    it "openCursor() - throw TransactionInactiveError on aborted transaction" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Nothing
        }
      let cb =
            { onSuccess : const $ pure unit
            , onError   : show >>> fail >>> launchAff'
            , onComplete: pure unit
            }
      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      index <- IDBObjectStore.index store "index"
      IDBTransaction.onAbort tx (pure unit)
      IDBTransaction.abort tx
      cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
      case cursor of
        Right _  -> fail "expected TransactionInactiveError"
        Left err -> message err `shouldEqual` "TransactionInactiveError"

      tearDown db

    it "openCursor() - throw InvalidStateError when the index is deleted" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
            let cb =
                  { onSuccess : const $ pure unit
                  , onError   : show >>> fail >>> launchAff'
                  , onComplete: pure unit
                  }
            store <- IDBTransaction.objectStore tx "store"
            IDBObjectStore.deleteIndex store "index"
            cursor <- attempt $ IDBIndex.openCursor index Nothing Next cb
            case cursor of
              Right _  -> fail "expected InvalidStateError"
              Left err -> message err `shouldEqual` "InvalidStateError"
        }

      tearDown db

    it "getKey() - multiEntry - adding keys" do
      { db } <- setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : { unique: false, multiEntry: true }
        , keyPath         : ["name"]
        , values          : [ { name: ["patate", "autruche"] } :+: (Just $ toKey 1)
                            , { name: ["bob"] } :+: (Just $ toKey 2)
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            key <- IDBIndex.getKey index (IDBKeyRange.only "patate")
            key `shouldEqual` (Just $ toKey 1)

            key <- IDBIndex.getKey index (IDBKeyRange.only "autruche")
            key `shouldEqual` (Just $ toKey 1)

            key <- IDBIndex.getKey index (IDBKeyRange.only "bob")
            key `shouldEqual` (Just $ toKey 2)
        }
      tearDown db

    it "get() - returns the record with the first key in the range" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            , { key: 42, indexedProperty: "autruche" } :+: Nothing
                            , { key: 1337, indexedProperty: "baguette" } :+: Nothing
                            ]
        , onUpgradeNeeded : Nothing
        }

      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      index <- IDBObjectStore.index store "index"
      val   <- IDBIndex.get index (IDBKeyRange.lowerBound "autruche" false)
      ((\r -> r.key) <$> val) `shouldEqual` (Just 42)

      tearDown db

  describe "IDBCursor" do
    let
        tearDown db = do
          IDBDatabase.close db
          _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
          pure unit

        setup :: forall value e e'.
                 { storeParams     :: { keyPath :: Array String, autoIncrement :: Boolean }
                 , indexParams     :: { unique :: Boolean, multiEntry :: Boolean }
                 , values          :: Array (Tuple value (Maybe Key))
                 , keyPath         :: Array String
                 , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Eff (idb :: IDB, avar :: AVAR, exception :: EXCEPTION | e') Unit)
               } -> Aff (idb :: IDB, avar :: AVAR | e) { db :: Database, index :: Index, store :: ObjectStore }
        setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
          let onUpgradeNeeded' var db tx = launchAff' do
                store <- IDBDatabase.createObjectStore db "store" storeParams
                _     <- traverse (uncurry (IDBObjectStore.add store)) values
                index <- IDBObjectStore.createIndex store "index" keyPath indexParams
                liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
                putVar var { db, index, store }

          var <- makeVar
          db  <- IDBFactory.open "db" Nothing
            { onUpgradeNeeded : Just (onUpgradeNeeded' var)
            , onBlocked : Nothing
            }
          takeVar var

    it "continue() - iterate to the next record" do
      { db } <- setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : []
        , values          : [ "cupcake" :+: (Just $ toKey 4)
                            , "pancake" :+: (Just $ toKey 2)
                            , "pie"     :+: (Just $ toKey 1)
                            , "pie"     :+: (Just $ toKey 3)
                            ]
        , onUpgradeNeeded: Nothing
        }
      let cb vdone vvals =
            { onComplete: launchAff' do
                putVar vdone unit

            , onError: \error  -> launchAff' do
                fail $ "unexpected error: " <> show error

            , onSuccess: \cursor -> launchAff' do
                vals <- takeVar vvals
                pure (IDBCursor.value cursor) >>= shouldEqual (maybe "" _.v $ head vals)
                IDBCursor.primaryKey cursor   >>= shouldEqual (maybe (toKey 0) _.k $ head vals)
                putVar vvals (drop 1 vals)
                IDBCursor.continue cursor none
            }
      vdone <- makeVar
      vvals <- makeVar'
        [ { v: "pie"    , k: toKey 1 }
        , { v: "pancake", k: toKey 2 }
        , { v: "pie"    , k: toKey 3 }
        , { v: "cupcake", k: toKey 4 }
        ]
      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      IDBObjectStore.openCursor store Nothing Next (cb vdone vvals)
      takeVar vdone
      tearDown db

    it "continue() - attempt to iterate in the wrong direction" do
      { db } <- setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : []
        , values          : [ "cupcake" :+: (Just $ toKey 4)
                            , "pancake" :+: (Just $ toKey 2)
                            , "pie"     :+: (Just $ toKey 1)
                            , "pie"     :+: (Just $ toKey 3)
                            ]
        , onUpgradeNeeded: Nothing
        }
      let cb vdone =
            { onComplete: launchAff' do
                fail $ "shouldn't complete"

            , onError: \error  -> launchAff' do
                fail $ "unexpected error: " <> show error

            , onSuccess: \cursor -> launchAff' do
                res <- attempt $ IDBCursor.continue cursor (Just 1)
                case res of
                  Left err  -> do
                    message err `shouldEqual` "DataError"
                    putVar vdone unit
                  Right _ -> do
                    fail "expected continue to fail"
            }
      vdone <- makeVar
      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      IDBObjectStore.openCursor store Nothing Next (cb vdone)
      takeVar vdone
      tearDown db

    it "advance() - iterate cursor number of times specified by count" do
      { db } <- setup
        { storeParams     : { keyPath: ["pKey"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : []
        , values          : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
                            , { pKey: "pkey_1", iKey: "ikey_1" } :+: Nothing
                            , { pKey: "pkey_2", iKey: "ikey_2" } :+: Nothing
                            , { pKey: "pkey_3", iKey: "ikey_3" } :+: Nothing
                            ]
        , onUpgradeNeeded: Nothing
        }
      let cb vdone vjump =
            { onComplete: launchAff' do
                putVar vdone unit

            , onError: \error  -> launchAff' do
                fail $ "unexpected error: " <> show error

            , onSuccess: \cursor -> launchAff' do
                jump <- takeVar vjump
                if jump
                   then do
                     IDBCursor.advance cursor 3
                   else do
                     let value = IDBCursor.value cursor
                     value.pKey `shouldEqual` "pkey_3"
                     value.iKey `shouldEqual` "ikey_3"
                     IDBCursor.continue cursor none
                putVar vjump false
            }
      vdone <- makeVar
      vjump <- makeVar' true
      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      IDBObjectStore.openCursor store Nothing Next (cb vdone vjump)
      takeVar vdone
      tearDown db

    it "delete() - remove a record from the object store" do
      { db } <- setup
        { storeParams     : { keyPath: ["pKey"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : []
        , values          : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
                            , { pKey: "pkey_1", iKey: "ikey_1" } :+: Nothing
                            , { pKey: "pkey_2", iKey: "ikey_2" } :+: Nothing
                            , { pKey: "pkey_3", iKey: "ikey_3" } :+: Nothing
                            ]
        , onUpgradeNeeded: Nothing
        }
      let cb vdone store =
            { onComplete: launchAff' do
                mval <- map _.pKey <$> IDBIndex.get store (IDBKeyRange.only "pkey_0")
                mval `shouldEqual` (Nothing :: Maybe String)
                putVar vdone unit

            , onError: \error  -> launchAff' do
                fail $ "unexpected error: " <> show error

            , onSuccess: \cursor -> launchAff' do
                let value = IDBCursor.value cursor
                value.pKey `shouldEqual` "pkey_0"
                IDBCursor.delete cursor
                IDBCursor.advance cursor 4
            }
      vdone <- makeVar
      tx    <- IDBDatabase.transaction db ["store"] ReadWrite
      store <- IDBTransaction.objectStore tx "store"
      IDBObjectStore.openCursor store Nothing Next (cb vdone store)
      takeVar vdone
      tearDown db

    it "update() - modify a record in the object store" do
      { db } <- setup
        { storeParams     : { keyPath: ["pKey"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : []
        , values          : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
                            ]
        , onUpgradeNeeded: Nothing
        }
      let cb vdone store =
            { onComplete: launchAff' do
                mval <- map _.iKey <$> IDBIndex.get store (IDBKeyRange.only "pkey_0")
                mval `shouldEqual` (Just "patate")
                putVar vdone unit

            , onError: \error  -> launchAff' do
                fail $ "unexpected error: " <> show error

            , onSuccess: \cursor -> launchAff' do
                let value = IDBCursor.value cursor
                value.pKey `shouldEqual` "pkey_0"
                key <- IDBCursor.update cursor { pKey: "pkey_0", iKey: "patate" }
                key `shouldEqual` toKey "pkey_0"
                IDBCursor.advance cursor 4
            }
      vdone <- makeVar
      tx    <- IDBDatabase.transaction db ["store"] ReadWrite
      store <- IDBTransaction.objectStore tx "store"
      IDBObjectStore.openCursor store Nothing Next (cb vdone store)
      takeVar vdone
      tearDown db

    it "update() - throw ReadOnlyError after update on ReadOnly transaction" do
      { db } <- setup
        { storeParams     : { keyPath: ["pKey"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : []
        , values          : [ { pKey: "pkey_0", iKey: "ikey_0" } :+: Nothing
                            ]
        , onUpgradeNeeded: Nothing
        }
      let cb vdone =
            { onComplete: launchAff' do
                fail $ "shouldn't complete"

            , onError: \error  -> launchAff' do
                fail $ "unexpected error: " <> show error

            , onSuccess: \cursor -> launchAff' do
                res <- attempt $ IDBCursor.update cursor "patate"
                case res of
                  Left err -> do
                    message err `shouldEqual` "ReadOnlyError"
                    putVar vdone unit
                  Right _ ->
                    fail $ "expected ReadOnlyError"
            }
      vdone <- makeVar
      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      IDBObjectStore.openCursor store Nothing Next (cb vdone)
      takeVar vdone
      tearDown db

module Test.Main where

import Prelude

import Control.Monad.Aff                 (Aff, launchAff, forkAff, delay, attempt)
import Control.Monad.Aff.AVar            (AVAR, makeVar, makeVar', modifyVar, peekVar, putVar, takeVar)
import Control.Monad.Aff.Console         (log)
import Control.Monad.Eff                 (Eff)
import Control.Monad.Eff.Class           (liftEff)
import Control.Monad.Eff.Exception       (EXCEPTION, message)
import Control.Monad.Eff.Now             (NOW, now)
import Data.Date                          as Date
import Data.DateTime                      as DateTime
import Data.DateTime                     (DateTime(..), Time(..))
import Data.DateTime.Instant             (toDateTime)
import Data.Either                       (Either(..))
import Data.Enum                         (toEnum)
import Data.Maybe                        (Maybe(..), isNothing, maybe)
import Data.Time.Duration                (Milliseconds(..))
import Data.Traversable                  (traverse)
import Data.Tuple                        (Tuple(..), uncurry)
import Test.Spec                         (describe, describe, it, it)
import Test.Spec.Assertions              (shouldEqual, fail)
import Test.Spec.Mocha                   (MOCHA, runMocha)

import Database.IndexedDB.Core
import Database.IndexedDB.IDBKey
import Database.IndexedDB.IDBCursor       as IDBCursor
import Database.IndexedDB.IDBDatabase     as IDBDatabase
import Database.IndexedDB.IDBFactory      as IDBFactory
import Database.IndexedDB.IDBIndex        as IDBIndex
import Database.IndexedDB.IDBKeyRange     as IDBKeyRange
import Database.IndexedDB.IDBObjectStore  as IDBObjectStore
import Database.IndexedDB.IDBTransaction  as IDBTransaction

infixr 7 Tuple as :+:

launchAff' :: forall a e. Aff e a -> Eff (exception :: EXCEPTION | e) Unit
launchAff' aff =
  pure unit <* (launchAff aff)

-- main :: forall eff. Eff (now :: NOW, mocha :: MOCHA, idb :: IDB, exception :: EXCEPTION, avar :: AVAR | eff) Unit
main = runMocha do
  describe "IDBFactory" do
    let
        tearDown name version db = do
          IDBDatabase.close db
          version' <- IDBFactory.deleteDatabase name
          version' `shouldEqual` version

    it "open default" do
      let name    = "db-default"
          version = 1
      db <- IDBFactory.open name Nothing
        { onUpgradeNeeded : Nothing
        , onBlocked       : Nothing
        }
      IDBDatabase.name db `shouldEqual` name
      tearDown name version db

    it "open specific version" do
      let name    = "db-specific"
          version = 14
      db <- IDBFactory.open name (Just version)
        { onUpgradeNeeded : Nothing
        , onBlocked       : Nothing
        }
      IDBDatabase.name db `shouldEqual` name
      tearDown name version db

    it "open specific version -> close -> open latest" do
      let name    = "db-latest"
          version = 14
      db <- IDBFactory.open name (Just version)
        { onUpgradeNeeded : Nothing
        , onBlocked : Nothing
        }
      IDBDatabase.name db `shouldEqual` name
      IDBDatabase.close db
      db <- IDBFactory.open name Nothing
        { onUpgradeNeeded : Nothing
        , onBlocked       : Nothing
        }
      tearDown name version db

    it "open + onUpgradeNeed" do
      let name    = "db-upgrade-needed"
          version = 1
          callback var db _ = do
            _ <- launchAff $ modifyVar (const $ IDBDatabase.name db) var
            pure unit
      var <- makeVar' "-"
      db  <- IDBFactory.open name Nothing
        { onUpgradeNeeded : Just (callback var)
        , onBlocked       : Nothing
        }
      name <- peekVar var
      name `shouldEqual` name
      tearDown name version db

    it "open + onBlocked" do
      let name    = "db-blocked"
          version = 14
          callback var = do
            _ <- launchAff $ modifyVar (const $ "db-blocked") var
            pure unit

      var   <- makeVar' "-"
      db01  <- IDBFactory.open name Nothing
        { onUpgradeNeeded : Nothing
        , onBlocked       : Nothing
        }
      _ <- forkAff do
        delay (Milliseconds 100.0)
        IDBDatabase.close db01

      db02  <- IDBFactory.open name (Just version)
        { onUpgradeNeeded : Nothing
        , onBlocked       : Just (callback var)
        }
      name <- peekVar var
      name `shouldEqual` name
      tearDown name version db02

  describe "IDBKeyRange" do
    it "only(int)" do
      let key   = 14
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only(string)" do
      let key   = "patate"
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only(float)" do
      let key   = 14.42
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only(date)" do
      let mkey = DateTime
            <$> (Date.canonicalDate <$> toEnum 2017 <*> toEnum 6 <*> toEnum 23)
            <*> (Time <$> toEnum 17 <*> toEnum 59 <*> toEnum 34 <*> toEnum 42)

      case mkey of
        Nothing ->
          fail "unable to create datetime"
        Just key -> do
          let range = IDBKeyRange.only key
          IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only([int])" do
      let key   = [14, 42]
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "only([string])" do
      let key   = ["patate", "autruche"]
          range = IDBKeyRange.only key
      IDBKeyRange.includes range (toKey key) `shouldEqual` true

    it "lowerBound(14, open)" do
      let key   = 14
          open  = true
          range = IDBKeyRange.lowerBound key open
      IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
      IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
      IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false

    it "lowerBound(14, close)" do
      let key   = 14
          open  = false
          range = IDBKeyRange.lowerBound key open
      IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` true
      IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
      IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` false

    it "upperBound(14, open)" do
      let key   = 14
          open  = true
          range = IDBKeyRange.upperBound key open
      IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
      IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
      IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true

    it "upperBound(14, close)" do
      let key   = 14
          open  = false
          range = IDBKeyRange.upperBound key open
      IDBKeyRange.includes range (toKey (key + 1)) `shouldEqual` false
      IDBKeyRange.includes range (toKey key) `shouldEqual` (not open)
      IDBKeyRange.includes range (toKey (key - 1)) `shouldEqual` true

    it "bound(42, 14, open, open) => Nothing" do
      let lower     = 42
          upper     = 14
          lowerOpen = true
          upperOpen = true
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      isNothing mrange `shouldEqual` true

    it "bound(14, 42, open, open)" do
      let lower     = 14
          upper     = 42
          lowerOpen = true
          upperOpen = true
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      case mrange of
        Nothing ->
          fail "invalid range provided"
        Just range -> do
          IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
          IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)

    it "bound(14, 42, open, close)" do
      let lower     = 14
          upper     = 42
          lowerOpen = true
          upperOpen = false
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      case mrange of
        Nothing ->
          fail "invalid range provided"
        Just range -> do
          IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
          IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)

    it "bound(14, 42, close, open)" do
      let lower     = 14
          upper     = 42
          lowerOpen = false
          upperOpen = true
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      case mrange of
        Nothing ->
          fail "invalid range provided"
        Just range -> do
          IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
          IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)

    it "bound(14, 42, close, close)" do
      let lower     = 14
          upper     = 42
          lowerOpen = false
          upperOpen = false
          mrange    = IDBKeyRange.bound { lower, upper, lowerOpen, upperOpen }
      case mrange of
        Nothing ->
          fail "invalid range provided"
        Just range -> do
          IDBKeyRange.includes range (toKey (lower + 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (upper - 1)) `shouldEqual` true
          IDBKeyRange.includes range (toKey (lower - 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey (upper + 1)) `shouldEqual` false
          IDBKeyRange.includes range (toKey lower) `shouldEqual` (not lowerOpen)
          IDBKeyRange.includes range (toKey upper) `shouldEqual` (not upperOpen)

    it "can access attributes of a range" do
      let range = IDBKeyRange.lowerBound 14 false
      IDBKeyRange.lower range `shouldEqual` (Just $ toKey 14)
      IDBKeyRange.upper range `shouldEqual` (Nothing :: Maybe Key)
      IDBKeyRange.lowerOpen range `shouldEqual` false
      IDBKeyRange.upperOpen range `shouldEqual` true

  describe "IDBDatabase" do
    let
        tearDown db = do
          IDBDatabase.close db
          _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
          pure unit

        setup storeParams = do
          let onUpgradeNeeded var db _ = launchAff' do
                store <- IDBDatabase.createObjectStore db "store" storeParams
                _     <- putVar var { db, store }
                pure unit

          var <- makeVar
          db  <- IDBFactory.open "db" Nothing
            { onUpgradeNeeded : Just (onUpgradeNeeded var)
            , onBlocked : Nothing
            }

          takeVar var

    it "createObjectStore (keyPath: [], autoIncrement: true)" do
      { db, store } <- setup { keyPath: [], autoIncrement: true }
      IDBObjectStore.name store `shouldEqual` "store"
      IDBObjectStore.keyPath store `shouldEqual` []
      IDBObjectStore.autoIncrement store `shouldEqual` true
      IDBObjectStore.indexNames store `shouldEqual` []
      tearDown db

    it "createObjectStore (keyPath: [\"patate\"], autoIncrement: true)" do
      { db, store } <- setup { keyPath: ["patate"], autoIncrement: true }
      IDBObjectStore.name store `shouldEqual` "store"
      IDBObjectStore.keyPath store `shouldEqual` ["patate"]
      IDBObjectStore.autoIncrement store `shouldEqual` true
      IDBObjectStore.indexNames store `shouldEqual` []
      tearDown db

    it "createObjectStore (keyPath: [\"a\", \"b\"], autoIncrement: false)" do
      { db, store } <- setup { keyPath: ["patate", "autruche"], autoIncrement: false }
      IDBObjectStore.name store `shouldEqual` "store"
      IDBObjectStore.keyPath store `shouldEqual` ["patate", "autruche"]
      IDBObjectStore.autoIncrement store `shouldEqual` false
      IDBObjectStore.indexNames store `shouldEqual` []
      tearDown db

    it "deleteObjectStore" do
      let onUpgradeNeeded var db _ = launchAff' do
            _ <- IDBDatabase.deleteObjectStore db "store"
            putVar var true

      var           <- makeVar
      { db, store } <- setup IDBObjectStore.defaultParameters
      IDBDatabase.close db
      db <- IDBFactory.open "db" (Just 999) { onUpgradeNeeded : Just (onUpgradeNeeded var)
                                            , onBlocked       : Nothing
                                            }
      deleted <- takeVar var
      deleted `shouldEqual` true
      tearDown db

  describe "IDBObjectStore" do
    let
        tearDown db = do
          IDBDatabase.close db
          _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
          pure unit

        setup { storeParams, onUpgradeNeeded } = do
          let onUpgradeNeeded' var db _ = launchAff' do
                store <- IDBDatabase.createObjectStore db "store" storeParams
                liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure store)
                putVar var { db, store }

          var <- makeVar
          db  <- IDBFactory.open "db" Nothing
            { onUpgradeNeeded : Just (onUpgradeNeeded' var)
            , onBlocked : Nothing
            }

          takeVar var

    it "add()" do
      date   <- liftEff $ toDateTime <$> now
      { db } <- setup
        { storeParams: { autoIncrement: true, keyPath: [] }
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            -- no key
            key <- IDBObjectStore.add store "patate" (Nothing :: Maybe Key)
            (toKey 1) `shouldEqual` key

            -- int key
            key <- IDBObjectStore.add store "patate" (Just 14)
            (toKey 14) `shouldEqual` key

            -- number key
            key <- IDBObjectStore.add store "patate" (Just 14.42)
            (toKey 14.42) `shouldEqual` key

            -- string key
            key <- IDBObjectStore.add store "patate" (Just "key")
            (toKey "key") `shouldEqual` key

            -- date key
            key <- IDBObjectStore.add store "patate" (Just date)
            (toKey date) `shouldEqual` key

            -- array key
            key <- IDBObjectStore.add store "patate" (Just $ toKey [14, 42])
            (toKey [14, 42]) `shouldEqual` key
        }
      tearDown db

    it "clear()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            key <- IDBObjectStore.add store "patate" (Just 14)
            _   <- IDBObjectStore.clear store
            val <- IDBObjectStore.get store (IDBKeyRange.only key)
            val `shouldEqual` (Nothing :: Maybe String)
        }
      tearDown db

    it "count()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            key <- IDBObjectStore.add store "patate" (Just 14)
            key <- IDBObjectStore.add store "autruche" (Just 42)
            n   <- IDBObjectStore.count store Nothing
            n `shouldEqual` 2
        }
      tearDown db

    it "getKey()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            key  <- IDBObjectStore.add store "patate" (Just 14)
            mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 14)
            mkey `shouldEqual` (Just key)

            mkey <- IDBObjectStore.getKey store (IDBKeyRange.only 42)
            mkey `shouldEqual` (Nothing :: Maybe Key)
          }
      tearDown db

    it "getAllKeys()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            key1  <- IDBObjectStore.add store "patate" (Just 14)
            key2  <- IDBObjectStore.add store "autruche" (Just 42)
            key3  <- IDBObjectStore.add store 14 (Just 1337)

            -- no bounds
            keys  <- IDBObjectStore.getAllKeys store Nothing Nothing
            keys `shouldEqual` [key1, key2, key3]

            -- lower bound
            keys  <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 14 true) Nothing
            keys `shouldEqual` [key2, key3]

            -- upper bound
            keys  <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.upperBound 42 false) Nothing
            keys `shouldEqual` [key1, key2]

            -- count
            keys  <- IDBObjectStore.getAllKeys store (Just $ IDBKeyRange.lowerBound 1 true) (Just 2)
            keys `shouldEqual` [key1, key2]
        }
      tearDown db

    it "openCursor()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            _ <- IDBObjectStore.openCursor store Nothing Next
            _ <- IDBObjectStore.openCursor store Nothing NextUnique
            _ <- IDBObjectStore.openCursor store Nothing Prev
            _ <- IDBObjectStore.openCursor store Nothing PrevUnique
            _ <- IDBObjectStore.openCursor store (Just $ IDBKeyRange.upperBound 1 true) Next
            pure unit
        }
      tearDown db

    it "openKeyCursor()" do
      { db } <- setup
        { storeParams: IDBObjectStore.defaultParameters
        , onUpgradeNeeded: Just $ \_ store -> launchAff' do
            _ <- IDBObjectStore.openKeyCursor store Nothing Next
            _ <- IDBObjectStore.openKeyCursor store Nothing NextUnique
            _ <- IDBObjectStore.openKeyCursor store Nothing Prev
            _ <- IDBObjectStore.openKeyCursor store Nothing PrevUnique
            _ <- IDBObjectStore.openKeyCursor store (Just $ IDBKeyRange.lowerBound 1 true) Next
            pure unit
        }
      tearDown db

  describe "IDBIndex" do
    let
        tearDown db = do
          IDBDatabase.close db
          _ <- IDBFactory.deleteDatabase (IDBDatabase.name db)
          pure unit

        setup :: forall value e e'.
                 { storeParams     :: { keyPath :: Array String, autoIncrement :: Boolean }
                 , indexParams     :: { unique :: Boolean, multiEntry :: Boolean }
                 , values          :: Array (Tuple value (Maybe Key))
                 , keyPath         :: Array String
                 , onUpgradeNeeded :: Maybe (Database -> Transaction -> Index -> Eff (idb :: IDB, avar :: AVAR, exception :: EXCEPTION | e') Unit)
               } -> Aff (idb :: IDB, avar :: AVAR | e) { db :: Database, index :: Index, store :: ObjectStore }
        setup { storeParams, indexParams, values, keyPath, onUpgradeNeeded } = do
          let onUpgradeNeeded' var db tx = launchAff' do
                store <- IDBDatabase.createObjectStore db "store" storeParams
                _     <- traverse (uncurry (IDBObjectStore.add store)) values
                index <- IDBObjectStore.createIndex store "index" keyPath indexParams
                liftEff $ maybe (pure unit) id (onUpgradeNeeded <*> pure db <*> pure tx <*> pure index)
                putVar var { db, index, store }

          var <- makeVar
          db  <- IDBFactory.open "db" Nothing
            { onUpgradeNeeded : Just (onUpgradeNeeded' var)
            , onBlocked : Nothing
            }
          takeVar var

    it "returns an IDBIndex and the properties are set correctly" do
      { db, index } <- setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : IDBIndex.defaultParameters
        , onUpgradeNeeded : Nothing
        , keyPath         : []
        , values          : []
        }
      IDBIndex.name index `shouldEqual` "index"
      IDBIndex.keyPath index `shouldEqual` []
      IDBIndex.unique index `shouldEqual` IDBIndex.defaultParameters.unique
      IDBIndex.multiEntry index `shouldEqual` IDBIndex.defaultParameters.multiEntry
      tearDown db

    it "attempt to create an index that requires unique values on an object store already contains duplicates" do
      let onAbort var = launchAff' (putVar var true)
      txVar <- makeVar
      dbVar <- makeVar
      res   <- attempt $ setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : { unique : true
                            , multiEntry : false
                            }
        , keyPath         : ["indexedProperty"]
        , values          : [ { indexedProperty: "bar" } :+: (Just $ toKey 1)
                            , { indexedProperty: "bar" } :+: (Just $ toKey 2)
                            ]
        , onUpgradeNeeded : Just $ \db tx _ -> launchAff' do
            IDBTransaction.onAbort tx (onAbort txVar)
            IDBDatabase.onAbort db (onAbort dbVar)
        }
      case res of
        Right _ ->
          fail "expected abort"
        _       -> do
          shouldEqual true =<< takeVar txVar
          shouldEqual true =<< takeVar dbVar

    it "the index is usable right after being made" do
      { db } <- setup
        { storeParams     : { keyPath       : ["key"]
                            , autoIncrement : false
                            }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: "key1", indexedProperty: "indexed_1" } :+: Nothing
                            , { key: "key2", indexedProperty: "indexed_2" } :+: Nothing
                            , { key: "key3", indexedProperty: "indexed_3" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only "indexed_2")
            ((\r -> r.key) <$> val) `shouldEqual` (Just $ toKey "key2")
        }
      tearDown db

    it "empty keyPath" do
      { db } <- setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : []
        , values          : [ "object_1" :+: (Just $ toKey 1)
                            , "object_2" :+: (Just $ toKey 2)
                            , "object_3" :+: (Just $ toKey 3)
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only "object_3")
            val `shouldEqual` (Just "object_3")
        }
      tearDown db

    it "index can be valid keys [date]" do
      date   <- liftEff $ toDateTime <$> now
      { db } <- setup
        { storeParams     : { keyPath: ["key"]
                            , autoIncrement: false
                            }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["i"]
        , values          : [ { key: "date", i: (toKey date) } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only date)
            ((\r -> r.key) <$> val) `shouldEqual` (Just "date")
        }
      tearDown db

    it "index can be valid keys [num]" do
      let num = 14
      { db } <- setup
        { storeParams     : { keyPath: ["key"]
                            , autoIncrement: false
                            }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["i"]
        , values          : [ { key: "num", i: (toKey num) } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only num)
            ((\r -> r.key) <$> val) `shouldEqual` (Just "num")
        }
      tearDown db

    it "index can be valid keys [array]" do
      let array = ["patate", "autruche"]
      { db } <- setup
        { storeParams     : { keyPath: ["key"]
                            , autoIncrement: false
                            }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["i"]
        , values          : [ { key: "array", i: (toKey array) } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            val <- IDBIndex.get index (IDBKeyRange.only array)
            ((\r -> r.key) <$> val) `shouldEqual` (Just "array")
        }
      tearDown db

    it "openKeyCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
      res <- attempt $ setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
            IDBTransaction.onAbort tx (pure unit)
            IDBDatabase.onAbort db (pure unit)
            IDBTransaction.abort tx
            cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next
            case cursor of
              Right _  -> fail "expected InvalidStateError"
              Left err -> message err `shouldEqual` "InvalidStateError"
        }
      case res of
        Right _ -> fail "expected InvalidStateError"
        _       -> pure unit

    it "openKeyCursor() - throw TransactionInactiveError on aborted transaction" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Nothing
        }

      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      index <- IDBObjectStore.index store "index"
      IDBTransaction.onAbort tx (pure unit)
      IDBTransaction.abort tx
      cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next
      case cursor of
        Right _  -> fail "expected TransactionInactiveError"
        Left err -> message err `shouldEqual` "TransactionInactiveError"

      tearDown db

    it "openKeyCursor() - throw InvalidStateError when the index is deleted" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
            store <- IDBTransaction.objectStore tx "store"
            IDBObjectStore.deleteIndex store "index"
            cursor <- attempt $ IDBIndex.openKeyCursor index Nothing Next
            case cursor of
              Right _  -> fail "expected InvalidStateError"
              Left err -> message err `shouldEqual` "InvalidStateError"
        }

      tearDown db

    it "openCursor() - throw InvalidStateError on index deleted by aborted upgrade" do
      res <- attempt $ setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
            IDBTransaction.onAbort tx (pure unit)
            IDBDatabase.onAbort db (pure unit)
            IDBTransaction.abort tx
            cursor <- attempt $ IDBIndex.openCursor index Nothing Next
            case cursor of
              Right _  -> fail "expected InvalidStateError"
              Left err -> message err `shouldEqual` "InvalidStateError"
        }
      case res of
        Right _ -> fail "expected InvalidStateError"
        _       -> pure unit

    it "openCursor() - throw TransactionInactiveError on aborted transaction" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Nothing
        }

      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      index <- IDBObjectStore.index store "index"
      IDBTransaction.onAbort tx (pure unit)
      IDBTransaction.abort tx
      cursor <- attempt $ IDBIndex.openCursor index Nothing Next
      case cursor of
        Right _  -> fail "expected TransactionInactiveError"
        Left err -> message err `shouldEqual` "TransactionInactiveError"

      tearDown db

    it "openCursor() - throw InvalidStateError when the index is deleted" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            ]
        , onUpgradeNeeded : Just $ \db tx index -> launchAff' do
            store <- IDBTransaction.objectStore tx "store"
            IDBObjectStore.deleteIndex store "index"
            cursor <- attempt $ IDBIndex.openCursor index Nothing Next
            case cursor of
              Right _  -> fail "expected InvalidStateError"
              Left err -> message err `shouldEqual` "InvalidStateError"
        }

      tearDown db

    it "getKey() - multiEntry - adding keys" do
      { db } <- setup
        { storeParams     : IDBObjectStore.defaultParameters
        , indexParams     : { unique: false, multiEntry: true }
        , keyPath         : ["name"]
        , values          : [ { name: ["patate", "autruche"] } :+: (Just $ toKey 1)
                            , { name: ["bob"] } :+: (Just $ toKey 2)
                            ]
        , onUpgradeNeeded : Just $ \_ _ index -> launchAff' do
            key <- IDBIndex.getKey index (IDBKeyRange.only "patate")
            key `shouldEqual` (Just $ toKey 1)

            key <- IDBIndex.getKey index (IDBKeyRange.only "autruche")
            key `shouldEqual` (Just $ toKey 1)

            key <- IDBIndex.getKey index (IDBKeyRange.only "bob")
            key `shouldEqual` (Just $ toKey 2)
        }
      tearDown db

    it "get() - returns the record with the first key in the range" do
      { db } <- setup
        { storeParams     : { keyPath: ["key"], autoIncrement: false }
        , indexParams     : IDBIndex.defaultParameters
        , keyPath         : ["indexedProperty"]
        , values          : [ { key: 14, indexedProperty: "patate" } :+: Nothing
                            , { key: 42, indexedProperty: "autruche" } :+: Nothing
                            , { key: 1337, indexedProperty: "baguette" } :+: Nothing
                            ]
        , onUpgradeNeeded : Nothing
        }

      tx    <- IDBDatabase.transaction db ["store"] ReadOnly
      store <- IDBTransaction.objectStore tx "store"
      index <- IDBObjectStore.index store "index"
      val   <- IDBIndex.get index (IDBKeyRange.lowerBound "autruche" false)
      ((\r -> r.key) <$> val) `shouldEqual` (Just 42)

      tearDown db


Fix breaking changes in Redux.purs

Fix breaking changes in Redux.purs

module Control.Monad.Eff.Redux
  ( Redux
  , Reducer
  , Dispatch
  , GetState
  , CreateStore
  , Next
  , Middleware
  , Store
  , Action
  , createStore
  , subscribe
  , dispatch
  , getState
  , replaceReducer
  , combineReducers
  , applyMiddleware
  ) where

import Prelude (Unit)
import Effect (Effect)

-- | Redux Objects & Effects

-- `action object` for the `dispatch`-API of `createStore`
-- according to Redux docs the action objects must have a `type` property
-- it is recommended to use string constants for `type`
type Action a b =
  { "type" :: a
  | b
  }

foreign import data Redux :: Type

foreign import data Store :: Type

type Reducer = forall a b c. a -> Action b c -> a

type Dispatch = forall a b. Action a b -> Effect (Action a b)

type GetState = forall a. Effect a

type CreateStore = forall a. Reducer -> a -> Effect Store

type Next = Dispatch

type Middleware = forall a b. Store -> Next -> (Action a b) -> Effect (Action a b)

-- | **TODO** Redux APIs (http://redux.js.org/)
foreign import createStore :: forall a b c. (a -> Action b c -> a) -> a -> Effect Store

foreign import subscribe :: (Effect Unit) -> Store -> Effect Unit

foreign import dispatch :: forall a b. Action a b -> Store -> Effect (Action a b)

foreign import getState :: forall a. Store -> Effect a

foreign import replaceReducer :: Reducer -> Store -> Effect Unit

foreign import combineReducers :: forall a b c. Array (a -> Action b c -> a) -> Effect Reducer

foreign import applyMiddleware :: forall a b c d. Array a -> (b -> Action c d -> b) -> b -> Effect Store

module Control.Monad.Eff.Redux
  ( ReduxM
  , Redux
  , ReduxEff
  , Reducer
  , Dispatch
  , GetState
  , CreateStore
  , Next
  , Middleware
  , Store
  , Action
  , createStore
  , subscribe
  , dispatch
  , getState
  , replaceReducer
  , combineReducers
  , applyMiddleware
  ) where

import Prelude
import Control.Monad.Eff

-- | Redux Objects & Effects

-- `action object` for the `dispatch`-API of `createStore`
-- according to Redux docs the action objects must have a `type` property
-- it is recommended to use string constants for `type`
type Action a b =
  { "type" :: a
  | b
  }

foreign import data ReduxM :: Effect

foreign import data Redux  :: Type

foreign import data Store  :: Type

type ReduxEff a  = forall e. Eff (reduxM :: ReduxM | e) a

type Reducer = forall a b c. a -> Action b c -> a

type Dispatch = forall a b. Action a b -> ReduxEff (Action a b)

type GetState = forall a. ReduxEff a

type CreateStore = forall a. Reducer -> a -> ReduxEff Store

type Next = Dispatch

type Middleware = forall a b. Store -> Next -> (Action a b) -> ReduxEff (Action a b)

-- | **TODO** Redux APIs (http://redux.js.org/)
foreign import createStore :: forall a b c. (a -> Action b c -> a) -> a -> ReduxEff Store

foreign import subscribe :: forall e. (Eff e Unit) -> Store -> ReduxEff Unit

foreign import dispatch :: forall a b. Action a b -> Store -> ReduxEff (Action a b)

foreign import getState :: forall a. Store -> ReduxEff a

foreign import replaceReducer :: Reducer -> Store -> ReduxEff Unit

foreign import combineReducers :: forall a b c. Array (a -> Action b c -> a) -> ReduxEff Reducer

foreign import applyMiddleware :: forall a b c d. Array a -> (b -> Action c d -> b) -> b -> ReduxEff Store