content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE PolyKinds #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE RecursiveDo #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE TupleSections #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  -- Notice to those working on this test suite:
  -- It doesn't appear to be possible to use --match to run a particular test, in
  -- this situation the test may hang before reaching our code. This seems to
  -- happen when the test is not the first test in the block. As a workaround, you
  -- can just comment out the other tests. Also, using `xit` will cause the same
  -- issue. `xit` tests must be the last tests in the session, or the session will
  -- hang in the following test.
  
  import Prelude hiding (fail)
  import Control.Concurrent
  import qualified Control.Concurrent.Async as Async
  import Control.Lens.Operators
  import Control.Monad hiding (fail)
  import Control.Monad.Catch
  import Control.Monad.Fail
  import Control.Monad.Fix
  import Control.Monad.IO.Class
  import Control.Monad.Ref
  import Data.Constraint.Extras
  import Data.Constraint.Extras.TH
  import Data.Dependent.Map (DMap)
  import Data.Dependent.Sum (DSum(..), (==>))
  import Data.Functor.Identity
  import Data.Functor.Misc
  import Data.GADT.Compare.TH
  import Data.GADT.Show.TH
  import Data.IORef (IORef)
  import Data.List (sort)
  import Data.Maybe
  import Data.Proxy
  import Data.Text (Text)
  import Language.Javascript.JSaddle (syncPoint, liftJSM)
  import Language.Javascript.JSaddle.Warp
  import Network.HTTP.Types (status200)
  import Network.Socket
  import Network.Wai
  import Network.WebSockets
  import Reflex.Dom.Core
  import Reflex.Patch.DMapWithMove
  import System.Directory
  import System.Environment
  import System.IO (stderr)
  import System.IO.Silently
  import System.IO.Temp
  import System.Process
  import System.Which (staticWhich)
  import qualified Test.HUnit as HUnit
  import qualified Test.Hspec as H
  import qualified Test.Hspec.Core.Spec as H
  import Test.Hspec (xit)
  import Test.Hspec.WebDriver hiding (runWD, click, uploadFile, WD)
  import qualified Test.Hspec.WebDriver as WD
  import Test.WebDriver (WD(..))
  
  import qualified Data.ByteString.Lazy as LBS
  import qualified Data.Dependent.Map as DMap
  import qualified Data.IntMap as IntMap
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as TE
  import qualified GHCJS.DOM.File as File
  import qualified Network.Wai.Handler.Warp as Warp
  import qualified System.FilePath as FilePath
  import qualified Test.WebDriver as WD
  import qualified Test.WebDriver.Capabilities as WD
  
  import Test.Util.ChromeFlags
  import Test.Util.UnshareNetwork
  
  
  #if !MIN_VERSION_webdriver(0,10,0)
  deriving instance MonadMask WD
  #endif
  
  chromium :: FilePath
  chromium = $(staticWhich "chromium")
  
  seleniumPort, jsaddlePort :: PortNumber
  seleniumPort = 8000
  jsaddlePort = 8001
  
  -- TODO Remove orphan
  instance MonadRef WD where
    type Ref WD = Ref IO
    newRef = WD . newRef
    readRef = WD . readRef
    writeRef r = WD . writeRef r
  
  assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()
  assertEqual msg a b = liftIO $ HUnit.assertEqual msg a b
  
  assertFailure :: MonadIO m => String -> m ()
  assertFailure = liftIO . HUnit.assertFailure
  
  assertBool :: (MonadIO m) => String -> Bool -> m ()
  assertBool msg bool = liftIO $ HUnit.assertBool msg bool
  
  chromeConfig :: Text -> [Text] -> WD.WDConfig
  chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig
  
  data DKey a where
    Key_Int :: DKey Int
    Key_Char :: DKey Char
    Key_Bool :: DKey Bool
  
  textKey :: DKey a -> Text
  textKey = \case
    Key_Int -> "Key_Int"
    Key_Char -> "Key_Char"
    Key_Bool -> "Key_Bool"
  
  deriveArgDict ''DKey
  deriveGEq ''DKey
  deriveGCompare ''DKey
  deriveGShow ''DKey
  
  keyMap :: DMap DKey Identity
  keyMap = DMap.fromList
    [ Key_Int ==> 0
    , Key_Char ==> 'A'
    ]
  
  data Key2 a where
    Key2_Int :: Int -> Key2 Int
    Key2_Char :: Char -> Key2 Char
  
  deriveGEq ''Key2
  deriveGCompare ''Key2
  deriveGShow ''Key2
  deriveArgDict ''Key2
  
  deriving instance MonadFail WD
  
  main :: IO ()
  main = do
    unshareNetwork
    isHeadless <- (== Nothing) <$> lookupEnv "NO_HEADLESS"
    withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
      withSeleniumServer $ \selenium -> do
        let browserPath = T.strip $ T.pack chromium
        when (T.null browserPath) $ fail "No browser found"
        withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"
        let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
            chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
        hspec (tests withDebugging wdConfig [(chromeCaps', "chrome")] selenium) `finally` _selenium_stopServer selenium
  
  tests :: Bool -> WD.WDConfig -> [(Capabilities, String)] -> Selenium -> Spec
  tests withDebugging wdConfig caps _selenium = do
    let putStrLnDebug :: MonadIO m => Text -> m ()
        putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
        session' t = sessionWith wdConfig t . using caps
        runWD m = runWDOptions (WdOptions False) $ do
          putStrLnDebug "before"
          r <- m
          putStrLnDebug "after"
          return r
        testWidgetStatic :: WD b -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
        testWidgetStatic = testWidgetStaticDebug withDebugging
        testWidget :: WD () -> WD b -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
        testWidget = testWidgetDebug True withDebugging
        testWidget' :: WD a -> (a -> WD b) -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
        testWidget' = testWidgetDebug' True withDebugging
    session' "text" $ do
      it "works" $ runWD $ do
        testWidgetStatic (checkBodyText "hello world") $ do
          text "hello world"
      it "works with postBuild" $ runWD $ do
        testWidgetStatic (checkBodyText "pb") $ do
          pb <- getPostBuild
          void $ textNode $ TextNodeConfig "" $ Just $ "pb" <$ pb
      it "works for adjacent text nodes" $ runWD $ do
        testWidgetStatic (checkBodyText "hello world") $ do
          text "hello "
          text "world"
      it "works for empty adjacent text nodes" $ runWD $ do
        testWidgetStatic (checkBodyText "hello world") $ do
          pb <- getPostBuild
          text ""
          text ""
          _ <- textNode $ TextNodeConfig "" $ Just $ "hello " <$ pb
          _ <- textNode $ TextNodeConfig "abc" $ Just $ "" <$ pb
          _ <- textNode $ TextNodeConfig "" $ Just $ "world" <$ pb
          text ""
      it "works when empty text nodes are the only children of an element" $ runWD $ do
        testWidgetStatic (checkBodyText "hello world") $ do
          el "div" $ do
            text ""
            text ""
          text "hello world"
      it "works when an empty text node is the first child before text" $ runWD $ do
        testWidgetStatic (checkTextInTag "div" "hello world") $ do
          el "div" $ do
            text ""
            text "hello world"
      it "works when an empty text node is the first child before element" $ runWD $ do
        testWidgetStatic (checkTextInTag "div" "hello world") $ do
          el "div" $ do
            text ""
            el "span" $ text "hello world"
      it "works when an empty text node is the last child" $ runWD $ do
        testWidgetStatic (checkTextInTag "div" "hello world") $ do
          el "div" $ do
            el "span" $ text "hello world"
            text ""
  -- TODO I think these two tests are broken
  --    it "updates after postBuild" $ runWD $ do
  --      testWidget (checkBodyText "initial") (checkBodyText "after") $ do
  --        after <- delay 0 =<< getPostBuild
  --        void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ after
  --    it "updates immediately after postBuild" $ runWD $ do
  --      testWidget (checkBodyText "pb") (checkBodyText "after") $ do
  --        pb <- getPostBuild
  --        after <- delay 0 pb
  --        void $ textNode $ TextNodeConfig "initial" $ Just $ leftmost ["pb" <$ pb, "after" <$ after]
      it "updates in immediate mode" $ runWD $ do
        let checkUpdated = do
              checkBodyText "initial"
              WD.click =<< findElemWithRetry (WD.ByTag "button")
              checkBodyText "after"
        testWidget (pure ()) checkUpdated $ prerender_ (pure ()) $ do
          click <- button ""
          void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
  
    session' "element" $ do
      it "works with domEvent Click" $ runWD $ do
        clickedRef <- liftIO $ newRef False
        testWidget' (findElemWithRetry $ WD.ByTag "div") WD.click $ do
          (e, _) <- el' "div" $ text "hello world"
          performEvent_ $ liftIO (writeRef clickedRef True) <$ domEvent Click e
        readRef clickedRef `shouldBeWithRetryM` True
      it "works with eventFlags stopPropagation" $ runWD $ do
        firstClickedRef <- newRef False
        secondClickedRef <- newRef False
        let clickBoth = do
              findElemWithRetry (WD.ById "first") >>= WD.click
              findElemWithRetry (WD.ById "second") >>= WD.click
        testWidget (pure ()) clickBoth $ do
          (firstDivEl, _) <- el' "div" $ prerender_ (pure ()) $ do
            void $ elAttr "span" ("id" =: "first") $ text "hello world"
          performEvent_ $ liftIO (writeRef firstClickedRef True) <$ domEvent Click firstDivEl
          (secondDivEl, _) <- el' "div" $ prerender_ (pure ()) $ do
            let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
                conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
                  & initialAttributes .~ "id" =: "second"
                  & elementConfig_eventSpec .~ addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> stopPropagation) def
            void $ element "span" conf $ text "hello world"
          performEvent_ $ liftIO (writeRef secondClickedRef True) <$ domEvent Click secondDivEl
        firstClicked <- readRef firstClickedRef
        secondClicked <- readRef secondClickedRef
        assertEqual "Click propagated when it should have stopped" (True, False) (firstClicked, secondClicked)
      it "works with eventFlags preventDefault" $ runWD $ do
        let click = do
              e <- findElemWithRetry $ WD.ByTag "input"
              s0 <- WD.isSelected e
              WD.click e
              s1 <- WD.isSelected e
              pure (s0, s1)
        clicked <- testWidget (pure ()) click $ prerender_ (pure ()) $ do
          let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
              conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
                & elementConfig_eventSpec .~ addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> preventDefault) def
                & initialAttributes .~ "type" =: "checkbox"
          void $ element "input" conf $ text "hello world"
        assertEqual "Click not prevented" (False, False) clicked
      it "can add/update/remove attributes" $ runWD $ do
        let checkInitialAttrs = do
              e <- findElemWithRetry $ WD.ByTag "div"
              assertAttr e "const" (Just "const")
              assertAttr e "delete" (Just "delete")
              assertAttr e "init" (Just "init")
              assertAttr e "click" Nothing
              pure e
            checkModifyAttrs e = do
              WD.click e
              withRetry $ do
                assertAttr e "const" (Just "const")
                assertAttr e "delete" Nothing
                assertAttr e "init" (Just "click")
                assertAttr e "click" (Just "click")
        testWidget' checkInitialAttrs checkModifyAttrs $ mdo
          let conf = def
                & initialAttributes .~ "const" =: "const" <> "delete" =: "delete" <> "init" =: "init"
                & modifyAttributes .~ (("delete" =: Nothing <> "init" =: Just "click" <> "click" =: Just "click") <$ click)
          (e, ()) <- element "div" conf $ text "hello world"
          let click = domEvent Click e
          return ()
  
    session' "inputElement" $ do
      describe "static renderer" $ do
        it "sets value attribute" $ runWD $ do
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.attr e "value" `shouldBeWithRetryM` Just "test"
                pure e
              checkHydrated e = do
                WD.attr e "value" `shouldBeWithRetryM` Just "test"
          testWidget' checkStatic checkHydrated $ void $ inputElement $ def
            & inputElementConfig_initialValue .~ "test"
        it "updates value attribute at postBuild" $ runWD $ do
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.attr e "value" `shouldBeWithRetryM` Just "test-updated"
                pure e
              checkHydrated e = do
                WD.attr e "value" `shouldBeWithRetryM` Just "test-updated"
          testWidget' checkStatic checkHydrated $ do
            pb <- getPostBuild
            _ <- inputElement $ def
              & inputElementConfig_initialValue .~ "test"
              & inputElementConfig_setValue .~ ("test-updated" <$ pb)
            pure ()
        it "sets checked attr appropriately" $ runWD $ do
          setCheckedChan <- liftIO newChan
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.attr e "checked" `shouldBeWithRetryM` Just "true"
                pure e
              checkValue e = do
                WD.attr e "checked" `shouldBeWithRetryM` Just "true"
                WD.moveToCenter e
                WD.click e -- Click to uncheck
                WD.attr e "checked" `shouldBeWithRetryM` Nothing
                liftIO $ writeChan setCheckedChan True -- Programatically check the checkbox
                WD.attr e "checked" `shouldBeWithRetryM` Just "true"
          testWidget' checkStatic checkValue $ do
            setChecked <- triggerEventWithChan setCheckedChan
            _ <- inputElement $ def
              & initialAttributes .~ "type" =: "checkbox"
              & inputElementConfig_initialChecked .~ True
              & inputElementConfig_setChecked .~ setChecked
            pure ()
        it "sets checked attr appropriately at postbuild" $ runWD $ do
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.attr e "checked" `shouldBeWithRetryM` Just "true"
                pure e
              checkValue e = do
                WD.attr e "checked" `shouldBeWithRetryM` Just "true"
          testWidget' checkStatic checkValue $ do
            pb <- getPostBuild
            _ <- inputElement $ def
              & initialAttributes .~ "type" =: "checkbox"
              & inputElementConfig_initialChecked .~ False
              & inputElementConfig_setChecked .~ (True <$ pb)
            pure ()
      describe "hydration" $ do
        it "doesn't wipe user input when switching over" $ runWD $ do
          inputRef <- newRef ("hello " :: Text)
          testWidget'
            (do
              e <- findElemWithRetry $ WD.ByTag "input"
              WD.sendKeys "world" e
              pure e)
            (\e -> do
              WD.attr e "value" `shouldBeWithRetryM` Just "hello world"
              WD.click =<< findElemWithRetry (WD.ByTag "button")
              readRef inputRef `shouldBeWithRetryM` "hello world"
            ) $ do
            e <- inputElement $ def & inputElementConfig_initialValue .~ "hello "
            click <- button "save"
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
        it "captures user input after switchover" $ runWD $ do
          inputRef <- newRef ("" :: Text)
          let checkValue = do
                WD.sendKeys "hello world" =<< findElemWithRetry (WD.ByTag "input")
                WD.click =<< findElemWithRetry (WD.ByTag "button")
                readRef inputRef `shouldBeWithRetryM` "hello world"
          testWidget (pure ()) checkValue $ do
            e <- inputElement def
            click <- button "save"
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
        it "sets focus appropriately" $ runWD $ do
          focusRef <- newRef False
          let checkValue = do
                readRef focusRef `shouldBeWithRetryM` False
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.click e
                readRef focusRef `shouldBeWithRetryM` True
          testWidget (pure ()) checkValue $ do
            e <- inputElement def
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
        it "sets focus when focus occurs before hydration" $ runWD $ do
          focusRef <- newRef False
          let setup = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.click e
                ((== e) <$> WD.activeElem) `shouldBeWithRetryM` True
                readRef focusRef `shouldBeWithRetryM` False
              check = readRef focusRef `shouldBeWithRetryM` True
          testWidget setup check $ do
            e <- inputElement def
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
        it "sets value appropriately" $ runWD $ do
          valueByUIRef <- newRef ("" :: Text)
          valueRef <- newRef ("" :: Text)
          setValueChan :: Chan Text <- liftIO newChan
          let checkValue = do
                readRef valueByUIRef `shouldBeWithRetryM` ""
                readRef valueRef `shouldBeWithRetryM` ""
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.sendKeys "hello" e
                readRef valueByUIRef `shouldBeWithRetryM` "hello"
                readRef valueRef `shouldBeWithRetryM` "hello"
                liftIO $ writeChan setValueChan "world"
                readRef valueByUIRef `shouldBeWithRetryM` "hello"
                readRef valueRef `shouldBeWithRetryM` "world"
          testWidget (pure ()) checkValue $ do
            update <- triggerEventWithChan setValueChan
            e <- inputElement $ def & inputElementConfig_setValue .~ update
            performEvent_ $ liftIO . writeRef valueByUIRef <$> _inputElement_input e
            performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
        it "sets checked appropriately" $ runWD $ do
          checkedByUIRef <- newRef False
          checkedRef <- newRef False
          setCheckedChan <- liftIO newChan
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.attr e "checked" `shouldBeWithRetryM` Nothing
                pure e
              checkValue e = do
                readRef checkedByUIRef `shouldBeWithRetryM` False
                readRef checkedRef `shouldBeWithRetryM` False
                WD.attr e "checked" `shouldBeWithRetryM` Nothing
                WD.moveToCenter e
                WD.click e
                readRef checkedByUIRef `shouldBeWithRetryM` True
                readRef checkedRef `shouldBeWithRetryM` True
                WD.attr e "checked" `shouldBeWithRetryM` Just "true"
                liftIO $ writeChan setCheckedChan False
                readRef checkedByUIRef `shouldBeWithRetryM` True
                readRef checkedRef `shouldBeWithRetryM` False
                WD.attr e "checked" `shouldBeWithRetryM` Nothing
          testWidget' checkStatic checkValue $ do
            setChecked <- triggerEventWithChan setCheckedChan
            e <- inputElement $ def
              & initialAttributes .~ "type" =: "checkbox"
              & inputElementConfig_setChecked .~ setChecked
            performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
            performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
        it "respects user updates to checked which happen before hydration" $ runWD $ do
          checkedByUIRef <- newRef False
          checkedRef <- newRef False
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.attr e "checked" `shouldBeWithRetryM` Nothing
                WD.moveToCenter e
                WD.click e
                WD.attr e "checked" `shouldBeWithRetryM` Just "true"
                pure e
              checkValue e = do
                WD.attr e "checked" `shouldBeWithRetryM` Just "true"
                readRef checkedByUIRef `shouldBeWithRetryM` True
                readRef checkedRef `shouldBeWithRetryM` True
          testWidget' checkStatic checkValue $ do
            e <- inputElement $ def
              & initialAttributes .~ "type" =: "checkbox"
            performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
            performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
        it "captures file uploads" $ runWD $ do
          filesRef :: IORef [Text] <- newRef []
          let uploadFile = do
                e <- findElemWithRetry $ WD.ByTag "input"
                path <- liftIO $ writeSystemTempFile "testFile" "file contents"
                WD.sendKeys (T.pack path) e
                WD.click =<< findElemWithRetry (WD.ByTag "button")
                liftIO $ removeFile path
                readRef filesRef `shouldBeWithRetryM` [T.pack $ FilePath.takeFileName path]
          testWidget (pure ()) uploadFile $ do
            e <- inputElement $ def & initialAttributes .~ "type" =: "file"
            click <- button "save"
            prerender_ (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
              names <- liftJSM $ traverse File.getName fs
              liftIO $ writeRef filesRef names
        it "fires _input event if the user altered the value before hydration" $ runWD $ do
          input <- newRef ("" :: Text)
          update <- newRef ("" :: Text)
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.attr e "value" `shouldBeWithRetryM` Just ""
                WD.sendKeys "test" e
                WD.attr e "value" `shouldBeWithRetryM` Just "test"
                pure e
              checkHydrated e = do
                WD.attr e "value" `shouldBeWithRetryM` Just "test"
                readRef input `shouldBeWithRetryM` "test"
                readRef update `shouldBeWithRetryM` "test"
          testWidget' checkStatic checkHydrated $ do
            e <- inputElement def
            performEvent_ $ liftIO . writeRef input <$> _inputElement_input e
            performEvent_ $ liftIO . writeRef update <$> updated (_inputElement_value e)
        it "does not fire _input event when the value is updated at postBuild" $ runWD $ do
          input <- newRef (Nothing :: Maybe Text)
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.attr e "value" `shouldBeWithRetryM` Just "pb"
                pure e
              checkHydrated e = do
                WD.attr e "value" `shouldBeWithRetryM` Just "pb"
                readRef input `shouldBeWithRetryM` Nothing
          testWidget' checkStatic checkHydrated $ do
            pb <- getPostBuild
            e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
            performEvent_ $ liftIO . writeRef input . Just <$> _inputElement_input e
        it "SSR produces correct DOM based on inputElement values when setValue happens at postBuild" $ runWD $ do
          let checkBoth = do
                input <- findElemWithRetry $ WD.ByTag "input"
                WD.attr input "value" `shouldBeWithRetryM` Just "pb"
                p <- findElemWithRetry (WD.ByTag "p")
                shouldContainText "pb" p
          testWidget checkBoth checkBoth $ do
            pb <- getPostBuild
            e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
            el "p" $ dynText $ _inputElement_value e
        it "does not fail when both setValue AND user updated value happen before switchover" $ runWD $ do
          let checkStatic = do
                input <- findElemWithRetry $ WD.ByTag "input"
                h2_value <- findElemWithRetry (WD.ByTag "h2")
                h3_input <- findElemWithRetry (WD.ByTag "h3")
                WD.attr input "value" `shouldBeWithRetryM` Just "pb"
                shouldContainText "pb" h2_value
                shouldContainText "" h3_input
                WD.sendKeys "abc" input
                WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pb" h2_value
                shouldContainText "" h3_input
                pure (input, h2_value, h3_input)
              checkHydrated (input, h2_value, h3_input) = do
                WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pbabc" h3_input
                shouldContainText "pbabc pb" h2_value
                pure ()
          testWidget' checkStatic checkHydrated $ do
            pb <- getPostBuild
            e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
            el "h1" $ dynText $ _inputElement_value e
            el "h2" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ updated $ _inputElement_value e
            el "h3" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ _inputElement_input e
        it "value is correct when both setValue AND user updated value happen before switchover" $ runWD $ do
          let checkStatic = do
                input <- findElemWithRetry $ WD.ByTag "input"
                p <- findElemWithRetry (WD.ByTag "p")
                WD.attr input "value" `shouldBeWithRetryM` Just "pb"
                shouldContainText "pb" p
                WD.sendKeys "abc" input
                WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pb" p -- It won't be updated yet
                pure (input, p)
              checkHydrated (input, p) = do
                WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pbabc" p
                pure ()
          testWidget' checkStatic checkHydrated $ do
            pb <- getPostBuild
            e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
            el "p" $ dynText $ _inputElement_value e
        it "input event and (updated value) fire correctly when both setValue AND user updated value happen before switchover" $ runWD $ do
          valRef <- newRef ([] :: [Text])
          inputRef <- newRef ([] :: [Text])
          let consRef ref a = liftIO $ atomicModifyRef ref $ \as -> (a:as, ())
              checkStatic = do
                input <- findElemWithRetry $ WD.ByTag "input"
                p <- findElemWithRetry (WD.ByTag "p")
                WD.attr input "value" `shouldBeWithRetryM` Just "pb"
                shouldContainText "pb" p
                WD.sendKeys "abc" input
                WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pb" p -- It won't be updated yet
                readRef inputRef `shouldBeWithRetryM` [] -- Should never fire input ref during SSR
                readRef valRef `shouldBeWithRetryM` ["pb"]
                pure (input, p)
              checkHydrated (input, p) = do
                readRef inputRef `shouldBeWithRetryM` ["pbabc"]
                readRef valRef `shouldBeWithRetryM` ["pbabc", "pb"]
                WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pbabc" p
                pure ()
          testWidget' checkStatic checkHydrated $ do
            liftIO $ writeRef valRef []
            pb <- getPostBuild
            e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
            el "p" $ dynText $ _inputElement_value e
            performEvent_ $ consRef valRef <$> updated (_inputElement_value e)
            performEvent_ $ consRef inputRef <$> _inputElement_input e
      describe "hydration/immediate" $ do
        it "captures user input after switchover" $ runWD $ do
          inputRef :: IORef Text <- newRef ""
          let checkValue = do
                WD.sendKeys "hello world" =<< findElemWithRetry (WD.ByTag "input")
                WD.click =<< findElemWithRetry (WD.ByTag "button")
                readRef inputRef `shouldBeWithRetryM` "hello world"
          testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
            e <- inputElement def
            click <- button "save"
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
        it "sets focus appropriately" $ runWD $ do
          focusRef <- newRef False
          let checkValue = do
                readRef focusRef `shouldBeWithRetryM` False
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.click e
                readRef focusRef `shouldBeWithRetryM` True
          testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
            e <- inputElement def
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
        it "sets value appropriately" $ runWD $ do
          valueByUIRef :: IORef Text <- newRef ""
          valueRef :: IORef Text <- newRef ""
          setValueChan :: Chan Text <- liftIO newChan
          let checkValue = do
                readRef valueByUIRef `shouldBeWithRetryM` ""
                readRef valueRef `shouldBeWithRetryM` ""
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.sendKeys "hello" e
                readRef valueByUIRef `shouldBeWithRetryM` "hello"
                readRef valueRef `shouldBeWithRetryM` "hello"
                liftIO $ writeChan setValueChan "world"
                readRef valueByUIRef `shouldBeWithRetryM` "hello"
                readRef valueRef `shouldBeWithRetryM` "world"
          testWidget (pure ()) checkValue $ do
            update <- triggerEventWithChan setValueChan
            prerender_ (pure ()) $ do
              e <- inputElement $ def & inputElementConfig_setValue .~ update
              performEvent_ $ liftIO . writeRef valueByUIRef <$> _inputElement_input e
              performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
        it "sets checked appropriately" $ runWD $ do
          checkedByUIRef <- newRef False
          checkedRef <- newRef False
          setCheckedChan <- liftIO newChan
          let checkValue = do
                readRef checkedByUIRef `shouldBeWithRetryM` False
                readRef checkedRef `shouldBeWithRetryM` False
                e <- findElemWithRetry $ WD.ByTag "input"
                WD.moveToCenter e
                WD.click e
                readRef checkedByUIRef `shouldBeWithRetryM` True
                readRef checkedRef `shouldBeWithRetryM` True
                liftIO $ writeChan setCheckedChan False
                readRef checkedByUIRef `shouldBeWithRetryM` True
                readRef checkedRef `shouldBeWithRetryM` False
          testWidget (pure ()) checkValue $ do
            setChecked <- triggerEventWithChan setCheckedChan
            prerender_ (pure ()) $ do
              e <- inputElement $ def
                & initialAttributes .~ "type" =: "checkbox"
                & inputElementConfig_setChecked .~ setChecked
              performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
              performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
        it "captures file uploads" $ runWD $ do
          filesRef :: IORef [Text] <- newRef []
          let uploadFile = do
                e <- findElemWithRetry $ WD.ByTag "input"
                path <- liftIO $ writeSystemTempFile "testFile" "file contents"
                WD.sendKeys (T.pack path) e
                WD.click =<< findElemWithRetry (WD.ByTag "button")
                liftIO $ removeFile path
                readRef filesRef `shouldBeWithRetryM` [T.pack $ FilePath.takeFileName path]
          testWidget (pure ()) uploadFile $ prerender_ (pure ()) $ do
            e <- inputElement $ def & initialAttributes .~ "type" =: "file"
            click <- button "save"
            performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
              names <- liftJSM $ traverse File.getName fs
              liftIO $ writeRef filesRef names
  
    session' "textAreaElement" $ do
      describe "static renderer" $ do
        it "sets value attribute" $ runWD $ do
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.attr e "value" `shouldBeWithRetryM` Just "test"
                pure e
              checkHydrated e = do
                WD.attr e "value" `shouldBeWithRetryM` Just "test"
          testWidget' checkStatic checkHydrated $ void $ textAreaElement $ def
            & textAreaElementConfig_initialValue .~ "test"
        it "updates value attribute at postBuild" $ runWD $ do
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.attr e "value" `shouldBeWithRetryM` Just "test-updated"
                pure e
              checkHydrated e = do
                WD.attr e "value" `shouldBeWithRetryM` Just "test-updated"
          testWidget' checkStatic checkHydrated $ do
            pb <- getPostBuild
            _ <- textAreaElement $ def
              & textAreaElementConfig_initialValue .~ "test"
              & textAreaElementConfig_setValue .~ ("test-updated" <$ pb)
            pure ()
      describe "hydration" $ do
        it "doesn't wipe user input when switching over" $ runWD $ do
          inputRef <- newRef ("" :: Text)
          testWidget'
            (do
              e <- findElemWithRetry $ WD.ByTag "textarea"
              WD.sendKeys "hello world" e
              pure e)
            (\e -> do
              WD.attr e "value" `shouldBeWithRetryM` Just "hello world"
              WD.click <=< findElemWithRetry $ WD.ByTag "button"
              readRef inputRef `shouldBeWithRetryM` "hello world"
            ) $ do
            e <- textAreaElement def
            click <- button "save"
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
        it "captures user input after switchover" $ runWD $ do
          inputRef <- newRef ("" :: Text)
          let checkValue = do
                WD.sendKeys "hello world" =<< findElemWithRetry (WD.ByTag "textarea")
                WD.click =<< findElemWithRetry (WD.ByTag "button")
                readRef inputRef `shouldBeWithRetryM` "hello world"
          testWidget (pure ()) checkValue $ do
            e <- textAreaElement def
            click <- button "save"
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
        it "sets focus appropriately" $ runWD $ do
          focusRef <- newRef False
          let checkValue = do
                readRef focusRef `shouldBeWithRetryM` False
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.click e
                readRef focusRef `shouldBeWithRetryM` True
          testWidget (pure ()) checkValue $ do
            e <- textAreaElement def
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
        it "sets focus when focus occurs before hydration" $ runWD $ do
          focusRef <- newRef False
          let setup = do
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.click e
                ((== e) <$> WD.activeElem) `shouldBeWithRetryM` True
                readRef focusRef `shouldBeWithRetryM` False
              check = readRef focusRef `shouldBeWithRetryM` True
          testWidget setup check $ do
            e <- textAreaElement def
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
        it "sets value appropriately" $ runWD $ do
          valueByUIRef <- newRef ("" :: Text)
          valueRef <- newRef ("" :: Text)
          setValueChan :: Chan Text <- liftIO newChan
          let checkValue = do
                readRef valueByUIRef `shouldBeWithRetryM` ""
                readRef valueRef `shouldBeWithRetryM` ""
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.sendKeys "hello" e
                readRef valueByUIRef `shouldBeWithRetryM` "hello"
                readRef valueRef `shouldBeWithRetryM` "hello"
                liftIO $ writeChan setValueChan "world"
                readRef valueByUIRef `shouldBeWithRetryM` "hello"
                readRef valueRef `shouldBeWithRetryM` "world"
          testWidget (pure ()) checkValue $ do
            setValue' <- triggerEventWithChan setValueChan
            e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
            performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
            performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
        it "fires _input event if the user altered the value before hydration" $ runWD $ do
          textarea <- newRef ("" :: Text)
          update <- newRef ("" :: Text)
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.attr e "value" `shouldBeWithRetryM` Just ""
                WD.sendKeys "test" e
                WD.attr e "value" `shouldBeWithRetryM` Just "test"
                pure e
              checkHydrated e = do
                WD.attr e "value" `shouldBeWithRetryM` Just "test"
                readRef textarea `shouldBeWithRetryM` "test"
                readRef update `shouldBeWithRetryM` "test"
          testWidget' checkStatic checkHydrated $ do
            e <- textAreaElement def
            performEvent_ $ liftIO . writeRef textarea <$> _textAreaElement_input e
            performEvent_ $ liftIO . writeRef update <$> updated (_textAreaElement_value e)
        it "does not fire _input event when the value is updated at postBuild" $ runWD $ do
          textarea <- newRef (Nothing :: Maybe Text)
          let checkStatic = do
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.attr e "value" `shouldBeWithRetryM` Just "pb"
                pure e
              checkHydrated e = do
                WD.attr e "value" `shouldBeWithRetryM` Just "pb"
                readRef textarea `shouldBeWithRetryM` Nothing
          testWidget' checkStatic checkHydrated $ do
            pb <- getPostBuild
            e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
            performEvent_ $ liftIO . writeRef textarea . Just <$> _textAreaElement_input e
        it "SSR produces correct DOM based on textAreaElement values when setValue happens at postBuild" $ runWD $ do
          let checkBoth = do
                textarea <- findElemWithRetry $ WD.ByTag "textarea"
                WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"
                p <- findElemWithRetry (WD.ByTag "p")
                shouldContainText "pb" p
          testWidget checkBoth checkBoth $ do
            pb <- getPostBuild
            e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
            el "p" $ dynText $ _textAreaElement_value e
        it "does not fail when both setValue AND user updated value happen before switchover" $ runWD $ do
          let checkStatic = do
                textarea <- findElemWithRetry $ WD.ByTag "textarea"
                h2_value <- findElemWithRetry (WD.ByTag "h2")
                h3_input <- findElemWithRetry (WD.ByTag "h3")
                WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"
                shouldContainText "pb" h2_value
                shouldContainText "" h3_input
                WD.sendKeys "abc" textarea
                WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pb" h2_value
                shouldContainText "" h3_input
                pure (textarea, h2_value, h3_input)
              checkHydrated (textarea, h2_value, h3_input) = do
                WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pbabc" h3_input
                shouldContainText "pbabc pb" h2_value
                pure ()
          testWidget' checkStatic checkHydrated $ do
            pb <- getPostBuild
            e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
            el "h1" $ dynText $ _textAreaElement_value e
            el "h2" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ updated $ _textAreaElement_value e
            el "h3" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ _textAreaElement_input e
        it "value is correct when both setValue AND user updated value happen before switchover" $ runWD $ do
          let checkStatic = do
                textarea <- findElemWithRetry $ WD.ByTag "textarea"
                p <- findElemWithRetry (WD.ByTag "p")
                WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"
                shouldContainText "pb" p
                WD.sendKeys "abc" textarea
                WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pb" p -- It won't be updated yet
                pure (textarea, p)
              checkHydrated (textarea, p) = do
                WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"
                shouldContainText "pbabc" p
                pure ()
          testWidget' checkStatic checkHydrated $ do
            pb <- getPostBuild
            e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
            el "p" $ dynText $ _textAreaElement_value e
  
      describe "hydration/immediate" $ do
        it "captures user input after switchover" $ runWD $ do
          inputRef :: IORef Text <- newRef ""
          let checkValue = do
                WD.sendKeys "hello world" <=< findElemWithRetry $ WD.ByTag "textarea"
                WD.click <=< findElemWithRetry $ WD.ByTag "button"
                readRef inputRef `shouldBeWithRetryM` "hello world"
          testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
            e <- textAreaElement def
            click <- button "save"
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
        it "sets focus appropriately" $ runWD $ do
          focusRef <- newRef False
          let checkValue = do
                readRef focusRef `shouldBeWithRetryM` False
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.click e
                readRef focusRef `shouldBeWithRetryM` True
          testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
            e <- textAreaElement def
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
        it "sets value appropriately" $ runWD $ do
          valueByUIRef :: IORef Text <- newRef ""
          valueRef :: IORef Text <- newRef ""
          setValueChan :: Chan Text <- liftIO newChan
          let checkValue = do
                readRef valueByUIRef `shouldBeWithRetryM` ""
                readRef valueRef `shouldBeWithRetryM` ""
                e <- findElemWithRetry $ WD.ByTag "textarea"
                WD.sendKeys "hello" e
                readRef valueByUIRef `shouldBeWithRetryM` "hello"
                readRef valueRef `shouldBeWithRetryM` "hello"
                liftIO $ writeChan setValueChan "world"
                readRef valueByUIRef `shouldBeWithRetryM` "hello"
                readRef valueRef `shouldBeWithRetryM` "world"
          testWidget (pure ()) checkValue $ do
            setValue' <- triggerEventWithChan setValueChan
            prerender_ (pure ()) $ do
              e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
              performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
              performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
  
    session' "selectElement" $ do
      let options :: DomBuilder t m => m ()
          options = do
            elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
            elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
            elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
      describe "hydration" $ do
        it "sets initial value correctly" $ runWD $ do
          inputRef <- newRef ("" :: Text)
          let setup = do
                e <- findElemWithRetry $ WD.ByTag "select"
                assertAttr e "value" (Just "three")
                WD.click =<< findElemWithRetry (WD.ById "two")
                pure e
              check e = do
                assertAttr e "value" (Just "two")
                readRef inputRef `shouldBeWithRetryM` "three"
                WD.click =<< findElemWithRetry (WD.ByTag "button")
                assertAttr e "value" (Just "two")
                readRef inputRef `shouldBeWithRetryM` "two"
          testWidget' setup check $ do
            (e, ()) <- selectElement (def { _selectElementConfig_initialValue = "three" }) options
            click <- button "save"
            liftIO . writeRef inputRef <=< sample $ current $ _selectElement_value e
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
        it "captures user input after switchover" $ runWD $ do
          inputRef <- newRef ("" :: Text)
          let checkValue = do
                e <- findElemWithRetry $ WD.ByTag "select"
                assertAttr e "value" (Just "one")
                WD.click =<< findElemWithRetry (WD.ById "two")
                assertAttr e "value" (Just "two")
                WD.click =<< findElemWithRetry (WD.ByTag "button")
                readRef inputRef `shouldBeWithRetryM` "two"
          testWidget (pure ()) checkValue $ do
            (e, ()) <- selectElement def options
            click <- button "save"
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
        it "sets focus appropriately" $ runWD $ do
          focusRef <- newRef False
          let checkValue = do
                readRef focusRef `shouldBeWithRetryM` False
                e <- findElemWithRetry $ WD.ByTag "select"
                WD.click e
                readRef focusRef `shouldBeWithRetryM` True
          testWidget (pure ()) checkValue $ do
            (e, ()) <- selectElement def options
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
        it "sets focus when focus occurs before hydration" $ runWD $ do
          focusRef <- newRef False
          let setup = do
                e <- findElemWithRetry $ WD.ByTag "select"
                WD.click e
                ((== e) <$> WD.activeElem) `shouldBeWithRetryM` True
                readRef focusRef `shouldBeWithRetryM` False
              check = readRef focusRef `shouldBeWithRetryM` True
          testWidget setup check $ do
            (e, ()) <- selectElement def options
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
        it "sets value appropriately" $ runWD $ do
          valueByUIRef <- newRef ("" :: Text)
          valueRef <- newRef ("" :: Text)
          setValueChan :: Chan Text <- liftIO newChan
          let checkValue = do
                e <- findElemWithRetry $ WD.ByTag "select"
                assertAttr e "value" (Just "one")
                readRef valueByUIRef `shouldBeWithRetryM` "one"
                readRef valueRef `shouldBeWithRetryM` "one"
                WD.click <=< findElemWithRetry $ WD.ById "two"
                readRef valueByUIRef `shouldBeWithRetryM` "two"
                readRef valueRef `shouldBeWithRetryM` "two"
                liftIO $ writeChan setValueChan "three"
                readRef valueByUIRef `shouldBeWithRetryM` "two"
                readRef valueRef `shouldBeWithRetryM` "three"
          testWidget (pure ()) checkValue $ do
            setValue' <- triggerEventWithChan setValueChan
            (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
            performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
            performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
  
      describe "hydration/immediate" $ do
        it "captures user input after switchover" $ runWD $ do
          inputRef :: IORef Text <- newRef ""
          let checkValue = do
                WD.click <=< findElemWithRetry $ WD.ById "two"
                WD.click <=< findElemWithRetry $ WD.ByTag "button"
                readRef inputRef `shouldBeWithRetryM` "two"
          testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
            (e, ()) <- selectElement def options
            click <- button "save"
            performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
        it "sets focus appropriately" $ runWD $ do
          focusRef <- newRef False
          let checkValue = do
                readRef focusRef `shouldBeWithRetryM` False
                e <- findElemWithRetry $ WD.ByTag "select"
                WD.click e
                readRef focusRef `shouldBeWithRetryM` True
          testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
            (e, ()) <- selectElement def options
            performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
        it "has correct initial value" $ runWD $ do
          valueRef :: IORef Text <- newRef ""
          let checkValue = readRef valueRef `shouldBeWithRetryM` "one"
          testWidget (pure ()) checkValue $ do
            prerender_ (pure ()) $ do
              (e, ()) <- selectElement def { _selectElementConfig_initialValue = "one" } options
              liftIO . writeRef valueRef <=< sample $ current $ _selectElement_value e
        it "sets value appropriately" $ runWD $ do
          valueByUIRef :: IORef Text <- newRef ""
          valueRef :: IORef Text <- newRef ""
          setValueChan :: Chan Text <- liftIO newChan
          let checkValue = do
                WD.click =<< findElemWithRetry (WD.ById "two")
                readRef valueByUIRef `shouldBeWithRetryM` "two"
                readRef valueRef `shouldBeWithRetryM` "two"
                liftIO $ writeChan setValueChan "three"
                readRef valueByUIRef `shouldBeWithRetryM` "two"
                readRef valueRef `shouldBeWithRetryM` "three"
          testWidget (pure ()) checkValue $ do
            setValue' <- triggerEventWithChan setValueChan
            prerender_ (pure ()) $ do
              (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
              performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
              performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
  
    session' "prerender" $ do
      it "works in simple case" $ runWD $ do
        testWidget (checkBodyText "One") (checkBodyText "Two") $ do
          prerender_ (text "One") (text "Two")
      it "removes element correctly" $ runWD $ do
        testWidget' (findElemWithRetry $ WD.ByTag "span") elementShouldBeRemoved $ do
          prerender_ (el "span" $ text "One") (text "Two")
      it "can be nested in server widget" $ runWD $ do
        testWidget (checkBodyText "One") (checkBodyText "Three") $ do
          prerender_ (prerender_ (text "One") (text "Two")) (text "Three")
      it "can be nested in client widget" $ runWD $ do
        testWidget (checkBodyText "One") (checkBodyText "Three") $ do
          prerender_ (text "One") (prerender_ (text "Two") (text "Three"))
      it "works with prerender_ siblings" $ runWD $ do
        testWidget
          (checkTextInId "a1" "One" >> checkTextInId "b1" "Three" >> checkTextInId "c1" "Five")
          (checkTextInId "a2" "Two" >> checkTextInId "b2" "Four" >> checkTextInId "c2" "Six") $ do
            prerender_ (divId "a1" $ text "One") (divId "a2" $ text "Two")
            prerender_ (divId "b1" $ text "Three") (divId "b2" $ text "Four")
            prerender_ (divId "c1" $ text "Five") (divId "c2" $ text "Six")
      it "works inside other element" $ runWD $ do
        testWidget (checkTextInTag "div" "One") (checkTextInTag "div" "Two") $ do
          el "div" $ prerender_ (text "One") (text "Two")
  -- TODO re-enable this
  --    it "places fences and removes them" $ runWD $ do
  --      testWidget'
  --        (do
  --          scripts <- WD.findElems $ WD.ByTag "script"
  --          filterM (\s -> maybe False (\t -> "prerender" `T.isPrefixOf` t) <$> WD.attr s "type") scripts
  --        )
  --        (traverse_ elementShouldBeRemoved)
  --        (el "span" $ prerender_ (text "One") (text "Two"))
      it "postBuild works on server side" $ runWD $ do
        lock :: MVar () <- liftIO newEmptyMVar
        testWidget (liftIO $ takeMVar lock) (pure ()) $ do
          prerender_ (do
            pb <- getPostBuild
            performEvent_ $ liftIO (putMVar lock ()) <$ pb) blank
      it "postBuild works on client side" $ runWD $ do
        lock :: MVar () <- liftIO newEmptyMVar
        testWidget (pure ()) (liftIO $ takeMVar lock) $ do
          prerender_ blank $ do
            pb <- getPostBuild
            performEvent_ $ liftIO (putMVar lock ()) <$ pb
      it "result Dynamic is updated *after* switchover" $ runWD $ do
        let preSwitchover = checkBodyText "PostBuild"
            check = checkBodyText "Client"
        testWidget preSwitchover check $ void $ do
          d <- prerender (pure "Initial") (pure "Client")
          pb <- getPostBuild
          initial <- sample $ current d
          textNode $ TextNodeConfig initial $ Just $ leftmost [updated d, "PostBuild" <$ pb]
      -- This essentially checks that the client IO runs *after* switchover/postBuild,
      -- thus can't create conflicting DOM
      it "can't exploit IO to break hydration" $ runWD $ do
        let preSwitchover = checkBodyText "Initial"
        testWidgetStatic preSwitchover $ void $ do
          ref <- liftIO $ newRef "Initial"
          prerender_ (pure ()) (liftIO $ writeRef ref "Client")
          text <=< liftIO $ readRef ref
      -- As above, so below
      it "can't exploit triggerEvent to break hydration" $ runWD $ do
        let preSwitchover = checkBodyText "Initial"
            check = checkBodyText "Client"
        testWidget preSwitchover check $ void $ do
          (e, trigger) <- newTriggerEvent
          prerender_ (pure ()) (liftIO $ trigger "Client")
          textNode $ TextNodeConfig "Initial" $ Just e
  
    session' "namespaces" $ do
      it "dyn can be nested in namespaced widget" $ runWD $ do
        testWidget (pure ()) (checkTextInTag "svg" "one") $ do
          let svgRootCfg = def
                & (elementConfig_namespace ?~ "http://www.w3.org/2000/svg")
                & (elementConfig_initialAttributes .~ ("width" =: "100%" <> "height" =: "100%" <> "viewBox" =: "0 0 1536 2048"))
          void $ element "svg" svgRootCfg $ do
            dyn_ $ text "one" <$ pure ()
  
    session' "runWithReplace" $ do
      it "works" $ runWD $ do
        replaceChan :: Chan Text <- liftIO newChan
        let setup = findElemWithRetry $ WD.ByTag "div"
            check ssr = do
              -- Check that the original element still exists and has the correct text
              shouldContainText "two" ssr
              liftIO $ writeChan replaceChan "three"
              elementShouldBeRemoved ssr
              shouldContainText "three" =<< findElemWithRetry (WD.ByTag "span")
        testWidget' setup check $ do
          replace <- triggerEventWithChan replaceChan
          pb <- getPostBuild
          void $ runWithReplace (el "div" $ text "one") $ leftmost
            [ el "div" (text "two") <$ pb
            , el "span" . text <$> replace
            ]
      it "can be nested in initial widget" $ runWD $ do
        replaceChan :: Chan Text <- liftIO newChan
        let setup = findElemWithRetry $ WD.ByTag "div"
            check ssr = do
              -- Check that the original element still exists and has the correct text
              shouldContainText "two" ssr
              liftIO $ writeChan replaceChan "three"
              elementShouldBeRemoved ssr
              shouldContainText "three" =<< findElemWithRetry (WD.ByTag "span")
        testWidget' setup check $ void $ flip runWithReplace never $ do
          replace <- triggerEventWithChan replaceChan
          pb <- getPostBuild
          void $ runWithReplace (el "div" $ text "one") $ leftmost
            [ el "div" (text "two") <$ pb
            , el "span" . text <$> replace
            ]
      it "can be nested in postBuild widget" $ runWD $ do
        replaceChan :: Chan Text <- liftIO newChan
        let setup = findElemWithRetry $ WD.ByTag "div"
            check ssr = do
              -- Check that the original element still exists and has the correct text
              shouldContainText "two" ssr
              liftIO $ writeChan replaceChan "three"
              elementShouldBeRemoved ssr
              shouldContainText "three" =<< findElemWithRetry (WD.ByTag "span")
        testWidget' setup check $ void $ do
          pb <- getPostBuild
          runWithReplace (pure ()) $ ffor pb $ \() -> do
            replace <- triggerEventWithChan replaceChan
            pb' <- getPostBuild
            void $ runWithReplace (el "div" $ text "one") $ leftmost
              [ el "div" (text "two") <$ pb'
              , el "span" . text <$> replace
              ]
      it "postBuild works in replaced widget" $ runWD $ do
        replaceChan <- liftIO newChan
        pbLock <- liftIO newEmptyMVar
        let check = liftIO $ do
              writeChan replaceChan ()
              takeMVar pbLock
        testWidget (pure ()) check $ void $ do
          replace <- triggerEventWithChan replaceChan
          runWithReplace (pure ()) $ ffor replace $ \() -> do
            pb <- getPostBuild
            performEvent_ $ liftIO (putMVar pbLock ()) <$ pb
      it "can be nested in event widget" $ runWD $ do
        replaceChan1 :: Chan Text <- liftIO newChan
        replaceChan2 :: Chan Text <- liftIO newChan
        lock :: MVar () <- liftIO newEmptyMVar
        let check = do
              shouldContainText "" =<< findElemWithRetry (WD.ByTag "body")
              liftIO $ do
                writeChan replaceChan1 "one"
                takeMVar lock
              one <- findElemWithRetry $ WD.ByTag "div"
              shouldContainText "pb" one
              liftIO $ writeChan replaceChan2 "two"
              elementShouldBeRemoved one
              shouldContainText "two" =<< findElemWithRetry (WD.ByTag "span")
        testWidget (pure ()) check $ void $ do
          replace1 <- triggerEventWithChan replaceChan1
          runWithReplace (pure ()) $ ffor replace1 $ \r1 -> do
            replace2 <- triggerEventWithChan replaceChan2
            pb <- getPostBuild
            performEvent_ $ liftIO (putMVar lock ()) <$ pb
            void $ runWithReplace (el "div" $ text r1) $ leftmost
              [ el "span" . text <$> replace2
              , el "div" (text "pb") <$ pb
              ]
      it "prerender works in replaced widget" $ runWD $ do
        replaceChan <- liftIO newChan
        lock :: MVar () <- liftIO newEmptyMVar
        pbLock :: MVar () <- liftIO newEmptyMVar
        let check = do
              liftIO $ do
                writeChan replaceChan ()
                takeMVar lock
                takeMVar pbLock
        testWidget (pure ()) check $ void $ do
          replace <- triggerEventWithChan replaceChan
          runWithReplace (pure ()) $ ffor replace $ \() -> do
            prerender_ (pure ()) $ do
              liftIO $ putMVar lock ()
              pb <- getPostBuild
              performEvent_ $ liftIO (putMVar pbLock ()) <$ pb
      it "prerender returns in immediate mode" $ runWD $ do
        replaceChan <- liftIO newChan
        pbLock <- liftIO newEmptyMVar
        let check = liftIO $ do
              writeChan replaceChan ()
              takeMVar pbLock
        testWidget (pure ()) check $ void $ do
          replace <- triggerEventWithChan replaceChan
          runWithReplace (pure ()) $ ffor replace $ \() -> do
            prerender_ (pure ()) (pure ())
            liftIO $ putMVar pbLock ()
      it "works in immediate mode (RHS of prerender)" $ runWD $ do
        replaceChan :: Chan Text <- liftIO newChan
        let check = do
              checkBodyText "one"
              one <- findElemWithRetry $ WD.ByTag "div"
              shouldContainText "one" one
              liftIO $ writeChan replaceChan "pb"
              elementShouldBeRemoved one
              shouldContainText "pb" =<< findElemWithRetry (WD.ByTag "span")
        testWidget (pure ()) check $ void $ do
          replace <- triggerEventWithChan replaceChan
          prerender_ blank $ do
            void $ runWithReplace (el "div" $ text "one") $ el "span" . text <$> replace
      it "works with postBuild in immediate mode (RHS of prerender)" $ runWD $ do
        replaceChan :: Chan Text <- liftIO newChan
        let check = do
              checkBodyText "two"
              two <- findElemWithRetry $ WD.ByTag "div"
              shouldContainText "two" two
              liftIO $ writeChan replaceChan "three"
              elementShouldBeRemoved two
              shouldContainText "three" =<< findElemWithRetry (WD.ByTag "span")
        testWidget (pure ()) check $ void $ do
          replace <- triggerEventWithChan replaceChan
          prerender_ blank $ do
            pb <- getPostBuild
            void $ runWithReplace (el "div" $ text "one") $ leftmost
              [ el "div" (text "two") <$ pb
              , el "span" . text <$> replace
              ]
  
      let checkInnerHtml t x = findElemWithRetry (WD.ByTag t) >>= (`attr` "innerHTML") >>= (`shouldBe` Just x)
      it "removes bracketing comments" $ runWD $ do
        replaceChan :: Chan () <- liftIO newChan
        let
          preSwitchover = checkInnerHtml "div" "before|<!--replace-start-0-->inner1<!--replace-end-0-->|after"
          check () = do
            liftIO $ writeChan replaceChan () -- trigger creation of p tag
            _ <- findElemWithRetry $ WD.ByTag "p" -- wait till p tag is created
            checkInnerHtml "div" "before|<p>inner2</p>|after"
        testWidget' preSwitchover check $ do
          replace <- triggerEventWithChan replaceChan
          el "div" $ do
            text "before|"
            _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
            text "|after"
      it "ignores extra ending bracketing comment" $ runWD $ do
        replaceChan :: Chan () <- liftIO newChan
        let
          preSwitchover = checkInnerHtml "div" "before|<!--replace-start-0-->inner1<!--replace-end-0--><!--replace-end-0-->|after"
          check () = do
            liftIO $ writeChan replaceChan () -- trigger creation of p tag
            _ <- findElemWithRetry $ WD.ByTag "p" -- wait till p tag is created
            checkInnerHtml "div" "before|inner2|after"
        testWidget' preSwitchover check $ do
          replace <- triggerEventWithChan replaceChan
          el "div" $ do
            text "before|"
            _ <- runWithReplace (text "inner1" *> comment "replace-end-0") $ text "inner2" <$ replace
            text "|after"
          void $ runWithReplace blank $ el "p" blank <$ replace -- Signal tag for end of test
      -- TODO This test actually causes a hydration failure, but it wasn't
      -- previously detected, so I've marked it pending
      xit "ignores missing ending bracketing comments" $ runWD $ do
        replaceChan :: Chan () <- liftIO newChan
        let
          preSwitchover = do
            checkInnerHtml "div" "before|<!--replace-start-0-->inner1<!--replace-end-0-->|after"
            divEl <- findElemWithRetry (WD.ByTag "div")
            let wrongHtml = "<!--replace-start-0-->inner1"
            actualHtml :: String <- WD.executeJS
              [WD.JSArg divEl, WD.JSArg wrongHtml]
              "arguments[0].innerHTML = arguments[1]; return arguments[0].innerHTML"
            actualHtml `shouldBe` wrongHtml
          check () = do
            liftIO $ writeChan replaceChan () -- trigger creation of p tag
            _ <- findElemWithRetry $ WD.ByTag "p" -- wait till p tag is created
            checkInnerHtml "div" "before|<p>inner2</p>|after"
        testWidget' preSwitchover check $ do
          replace <- triggerEventWithChan replaceChan
          el "div" $ do
            text "before|"
            _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
            text "|after"
  
    session' "traverseDMapWithKeyWithAdjust" $ do
      let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
          widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
            elClass "span" "key" $ text $ textKey k
            elClass "span" "value" $ text $ T.pack $ has @Show k $ show v
            pure (Identity v)
          checkItem :: WD.Element -> Text -> Text -> WD ()
          checkItem li k v = do
            putStrLnDebug "checkItem"
            shouldContainTextNoRetry k =<< WD.findElemFrom li (WD.ByClass "key")
            shouldContainTextNoRetry v =<< WD.findElemFrom li (WD.ByClass "value")
          checkInitialItems dm xs = do
            putStrLnDebug "checkInitialItems"
            liftIO $ assertEqual "Wrong amount of items in DOM" (DMap.size dm) (length xs)
            forM_ (zip xs (DMap.toList dm)) $ \(e, k :=> Identity v) -> checkItem e (textKey k) (T.pack $ has @Show k $ show v)
          getAndCheckInitialItems dm = withRetry $ do
            putStrLnDebug "getAndCheckInitialItems"
            xs <- WD.findElems (WD.ByTag "li")
            checkInitialItems dm xs
            pure xs
          checkRemoval chan k = do
            putStrLnDebug "checkRemoval"
            e <- findElemWithRetry (WD.ById $ textKey k)
            liftIO $ writeChan chan $ PatchDMap $ DMap.singleton k (ComposeMaybe Nothing)
            elementShouldBeRemoved e
          checkReplace chan k v = do
            putStrLnDebug "checkReplace"
            e <- findElemWithRetry (WD.ById $ textKey k)
            liftIO $ writeChan chan $ PatchDMap $ DMap.singleton k (ComposeMaybe $ Just $ Identity v)
            elementShouldBeRemoved e
            e' <- findElemWithRetry $ WD.ById $ textKey k
            checkItem e' (textKey k) (T.pack $ show v)
          checkInsert chan k v = do
            putStrLnDebug "checkInsert"
            liftIO $ writeChan chan $ PatchDMap $ DMap.singleton k (ComposeMaybe $ Just $ Identity v)
            e <- findElemWithRetry (WD.ById $ textKey k)
            checkItem e (textKey k) (T.pack $ show v)
          postBuildPatch = PatchDMap $ DMap.fromList [Key_Char :=> ComposeMaybe Nothing, Key_Bool :=> ComposeMaybe (Just $ Identity True)]
      it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
        chan <- liftIO newChan
        let preSwitchover :: WD [WD.Element]
            preSwitchover = getAndCheckInitialItems keyMap
            check :: [WD.Element] -> WD ()
            check xs = do
              checkInitialItems keyMap xs
              checkRemoval chan Key_Int
              checkReplace chan Key_Char 'B'
              checkInsert chan Key_Bool True
        testWidget' preSwitchover check $ do
          (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
          liftIO $ dmap `H.shouldBe` keyMap
      it "handles postBuild correctly" $ runWD $ do
        chan <- liftIO newChan
        let preSwitchover = getAndCheckInitialItems $ applyAlways postBuildPatch keyMap
            check xs = do
              withRetry $ checkInitialItems (applyAlways postBuildPatch keyMap) xs
              checkRemoval chan Key_Int
              checkInsert chan Key_Char 'B'
              checkReplace chan Key_Bool True
        testWidget' preSwitchover check $ void $ do
          pb <- getPostBuild
          replace <- triggerEventWithChan chan
          (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
          liftIO $ dmap `H.shouldBe` keyMap
      it "can delete/update/insert when built in prerender" $ runWD $ do
        chan <- liftIO newChan
        let check = do
              _ <- getAndCheckInitialItems keyMap
              checkRemoval chan Key_Int
              checkReplace chan Key_Char 'B'
              checkInsert chan Key_Bool True
        testWidget (pure ()) check $ do
          replace <- triggerEventWithChan chan
          prerender_ (pure ()) $ do
            (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap replace
            liftIO $ dmap `H.shouldBe` keyMap
      it "can delete/update/insert when built in immediate mode" $ runWD $ do
        chan <- liftIO newChan
        let check = do
              _ <- getAndCheckInitialItems keyMap
              checkRemoval chan Key_Int
              checkReplace chan Key_Char 'B'
              checkInsert chan Key_Bool True
        testWidget (pure ()) check $ void $ do
          pb <- getPostBuild
          runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
            (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
            liftIO $ dmap `H.shouldBe` keyMap
      -- Should be fixed by prerender changes!
      it "handles postBuild correctly in prerender" $ runWD $ do
        chan <- liftIO newChan
        let check = do
              _ <- getAndCheckInitialItems $ applyAlways postBuildPatch keyMap
              checkRemoval chan Key_Int
              checkInsert chan Key_Char 'B'
              checkReplace chan Key_Bool True
        testWidget (pure ()) check $ do
          replace <- triggerEventWithChan chan
          prerender_ (pure ()) $ void $ do
            pb <- getPostBuild
            (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
            liftIO $ dmap `H.shouldBe` keyMap
  
    session' "traverseIntMapWithKeyWithAdjust" $ do
      let textKeyInt k = "key" <> T.pack (show k)
          intMap = IntMap.fromList
            [ (1, "one")
            , (2, "two")
            , (3, "three")
            ]
      let widget :: DomBuilder t m => IntMap.Key -> Text -> m Text
          widget k v = elAttr "li" ("id" =: textKeyInt k) $ do
            elClass "span" "key" $ text $ textKeyInt k
            elClass "span" "value" $ text v
            pure v
          checkItem :: WD.Element -> Text -> Text -> WD ()
          checkItem li k v = do
            putStrLnDebug "checkItem"
            shouldContainTextNoRetry k =<< WD.findElemFrom li (WD.ByClass "key")
            shouldContainTextNoRetry v =<< WD.findElemFrom li (WD.ByClass "value")
          checkInitialItems dm xs = do
            putStrLnDebug "checkInitialItems"
            liftIO $ assertEqual "Wrong amount of items in DOM" (IntMap.size dm) (length xs)
            forM_ (zip xs (IntMap.toList dm)) $ \(e, (k, v)) -> checkItem e (textKeyInt k) v
          getAndCheckInitialItems dm = withRetry $ do
            putStrLnDebug "getAndCheckInitialItems"
            xs <- WD.findElems (WD.ByTag "li")
            checkInitialItems dm xs
            pure xs
          checkRemoval chan k = do
            putStrLnDebug "checkRemoval"
            e <- findElemWithRetry (WD.ById $ textKeyInt k)
            liftIO $ writeChan chan $ PatchIntMap $ IntMap.singleton k Nothing
            elementShouldBeRemoved e
          checkReplace chan k v = do
            putStrLnDebug "checkReplace"
            e <- findElemWithRetry (WD.ById $ textKeyInt k)
            liftIO $ writeChan chan $ PatchIntMap $ IntMap.singleton k $ Just v
            elementShouldBeRemoved e
            e' <- findElemWithRetry (WD.ById $ textKeyInt k)
            withRetry $ checkItem e' (textKeyInt k) v
          checkInsert chan k v = do
            putStrLnDebug "checkInsert"
            liftIO $ writeChan chan $ PatchIntMap $ IntMap.singleton k $ Just v
            e <- findElemWithRetry (WD.ById $ textKeyInt k)
            checkItem e (textKeyInt k) v
          postBuildPatch = PatchIntMap $ IntMap.fromList [(2, Nothing), (3, Just "trois"), (4, Just "four")]
      xit "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
        chan <- liftIO newChan
        let preSwitchover = getAndCheckInitialItems intMap
            check xs = do
              checkInitialItems intMap xs
              checkRemoval chan 1
              checkReplace chan 2 "deux"
              checkInsert chan 4 "four"
        testWidget' preSwitchover check $ void $ do
          (im, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
          liftIO $ im `H.shouldBe` intMap
      xit "handles postBuild correctly" $ runWD $ do
        chan <- liftIO newChan
        let preSwitchover = getAndCheckInitialItems $ applyAlways postBuildPatch intMap
            check xs = do
              withRetry $ checkInitialItems (applyAlways postBuildPatch intMap) xs
              checkRemoval chan 1
              checkInsert chan 2 "deux"
              checkReplace chan 3 "trois"
        testWidget' preSwitchover check $ void $ do
          pb <- getPostBuild
          replace <- triggerEventWithChan chan
          (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
          liftIO $ dmap `H.shouldBe` intMap
      xit "can delete/update/insert when built in prerender" $ runWD $ do
        chan <- liftIO newChan
        let check = do
              _ <- getAndCheckInitialItems intMap
              checkRemoval chan 1
              checkReplace chan 2 "deux"
              checkInsert chan 4 "quatre"
        testWidget (pure ()) check $ do
          replace <- triggerEventWithChan chan
          prerender_ (pure ()) $ do
            (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap replace
            liftIO $ dmap `H.shouldBe` intMap
      xit "can delete/update/insert when built in immediate mode" $ runWD $ do
        chan <- liftIO newChan
        let check = do
              _ <- getAndCheckInitialItems intMap
              checkRemoval chan 1
              checkReplace chan 2 "deux"
              checkInsert chan 4 "quatre"
        testWidget (pure ()) check $ void $ do
          pb <- getPostBuild
          runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
            (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
            liftIO $ dmap `H.shouldBe` intMap
      -- Should be fixed by prerender changes!
      xit "handles postBuild correctly in prerender" $ runWD $ do
        chan <- liftIO newChan
        let check = do
              _ <- getAndCheckInitialItems $ applyAlways postBuildPatch intMap
              checkRemoval chan 1
              checkInsert chan 2 "deux"
              checkReplace chan 3 "trois"
        testWidget (pure ()) check $ do
          replace <- triggerEventWithChan chan
          prerender_ (pure ()) $ void $ do
            pb <- getPostBuild
            (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
            liftIO $ dmap `H.shouldBe` intMap
  
    session' "traverseDMapWithKeyWithAdjustWithMove" $ do
      let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)
          widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do
            elClass "span" "key" $ text $ textKey2 k
            elClass "span" "value" $ text $ T.pack $ has @Show k $ show v
            pure (Identity v)
          textKey2 :: Key2 a -> Text
          textKey2 = \case
            Key2_Int i -> "i" <> T.pack (show i)
            Key2_Char c -> "c" <> T.pack [c]
          checkItem :: WD.Element -> Text -> Text -> WD ()
          checkItem li k v = do
            shouldContainTextNoRetry k =<< WD.findElemFrom li (WD.ByClass "key")
            shouldContainTextNoRetry v =<< WD.findElemFrom li (WD.ByClass "value")
          checkInitialItems dm xs = do
            liftIO $ assertEqual "Wrong amount of items in DOM" (DMap.size dm) (length xs)
            forM_ (zip xs (DMap.toList dm)) $ \(e, k :=> Identity v) -> checkItem e (textKey2 k) (T.pack $ has @Show k $ show v)
          getAndCheckInitialItems dm = withRetry $ do
            xs <- WD.findElems (WD.ByTag "li")
            checkInitialItems dm xs
            pure xs
          moveSpec
            :: (DMap Key2 Identity -> (WD.Element -> Chan (PatchDMapWithMove Key2 Identity) -> WD ()) -> WD ())
            -> H.SpecM (WdTestSession ()) ()
          moveSpec testMove = do
            it "can insert an item" $ runWD $ testMove (DMap.fromList [Key2_Int 1 ==> 1, Key2_Int 3 ==> 3]) $ \body chan -> do
              shouldContainText (T.strip $ T.unlines ["i11","i33"]) body
              liftIO $ writeChan chan (insertDMapKey (Key2_Int 2) 2)
              shouldContainText (T.strip $ T.unlines ["i11","i22","i33"]) body
            it "can delete an item" $ runWD $ testMove (DMap.fromList [Key2_Int 1 ==> 1, Key2_Int 2 ==> 2, Key2_Int 3 ==> 3]) $ \body chan -> do
              shouldContainText (T.strip $ T.unlines ["i11","i22","i33"]) body
              liftIO $ writeChan chan (deleteDMapKey (Key2_Int 2))
              shouldContainText (T.strip $ T.unlines ["i11","i33"]) body
            it "can swap items" $ runWD $ testMove (DMap.fromList [Key2_Int 1 ==> 1, Key2_Int 2 ==> 2, Key2_Int 3 ==> 3, Key2_Int 4 ==> 4]) $ \body chan -> do
              shouldContainText (T.strip $ T.unlines ["i11","i22","i33","i44"]) body
              liftIO $ writeChan chan (swapDMapKey (Key2_Int 2) (Key2_Int 3))
              shouldContainText (T.strip $ T.unlines ["i11","i33","i22","i44"]) body
  -- TODO re-enable this
  --          it "can move items" $ runWD $ testMove (DMap.fromList [Key2_Int 1 ==> 1, Key2_Int 2 ==> 2, Key2_Int 3 ==> 3, Key2_Int 4 ==> 4]) $ \body chan -> do
  --            shouldContainText (T.strip $ T.unlines ["i11","i22","i33", "i44"]) body
  --            liftIO $ writeChan chan (moveDMapKey (Key2_Int 2) (Key2_Int 3))
  --            shouldContainText (T.strip $ T.unlines ["i11","i22","i44"]) body
  --            liftIO $ writeChan chan (moveDMapKey (Key2_Int 2) (Key2_Int 3)) -- attempt a move to nonexistent key should delete
  --            shouldContainText (T.strip $ T.unlines ["i11","i44"]) body
  --            liftIO $ writeChan chan (moveDMapKey (Key2_Int 2) (Key2_Int 3)) -- this causes a JSException in immediate builder too
  --            shouldContainText (T.strip $ T.unlines ["i11","i44"]) body
  --            liftIO $ writeChan chan (insertDMapKey (Key2_Int 2) 2) -- this step will fail if the above caused an exception, thus works as a proxy for detecting the exception given we can't catch it
  --            shouldContainText (T.strip $ T.unlines ["i11","i22","i44"]) body
  
      describe "hydration" $ moveSpec $ \initMap test -> do
        chan <- liftIO newChan
        let preSwitchover = getAndCheckInitialItems initMap
            check xs = do
              checkInitialItems initMap xs
              body <- getBody
              test body chan
        testWidget' preSwitchover check $ void $ do
          (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
          liftIO $ assertEqual "DMap" initMap dmap
  
      describe "hydration/immediate" $ moveSpec $ \initMap test -> do
        chan <- liftIO newChan
        replace <- liftIO newChan
        lock :: MVar () <- liftIO newEmptyMVar
        let check = do
              liftIO $ do
                writeChan replace ()
                takeMVar lock
              xs <- getAndCheckInitialItems initMap
              checkInitialItems initMap xs
              body <- getBody
              test body chan
        testWidget (pure ()) check $ void $ do
          e <- triggerEventWithChan replace
          runWithReplace (pure ()) $ ffor e $ \() -> void $ do
            pb <- getPostBuild
            performEvent_ $ liftIO (putMVar lock ()) <$ pb
            (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
            liftIO $ assertEqual "DMap" initMap dmap
  
    session' "hydrating invalid HTML" $ do
      xit "can hydrate list in paragraph" $ runWD $ do
        let preSwitchover = do
              checkBodyText "before\ninner\nafter"
              -- Two <p> tags should be present
              (p1, p2) <- WD.findElems (WD.ByTag "p") >>= \case
                [p1, p2] -> pure (p1, p2)
                _ -> error "Unexpected number of `p` tags (expected 2)"
              ol <- findElemWithRetry (WD.ByTag "ol")
              shouldContainText "before" p1
              shouldContainText "inner" ol
              shouldContainText "" p2
              pure (p1, ol, p2)
            check (p1, ol, p2) = do
              checkBodyText "before\ninner\nafter"
              shouldContainText "before\ninner\nafter" p1
              elementShouldBeRemoved ol
              elementShouldBeRemoved p2
        -- Don't fail fatally when hydration encounters the invalid DOM
        testWidgetDebug' False withDebugging preSwitchover check $ do
          -- This is deliberately invalid HTML, the browser will interpret it as
          -- <p>before</p><ol>inner</ol>after<p></p>
          el "p" $ do
            text "before"
            el "ol" $ text "inner"
            text "after"
  
    -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options.
    -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid.
    -- It seems expedient for the time being to expect this test case to be updated, should those implementation details ever change.
    session' "dropdown" $ do
      let doTest expectedOpts (initialValue :: Text) = do
            let doCheck = do
                  es <- findElemsWithRetry $ WD.ByTag "option"
                  opts <- mapM fetchElement es
                  assertEqual "missing/extra/incorrect option element(s)" expectedOpts (sort opts)
            testWidget doCheck doCheck $ do
              void $ dropdown initialValue (constDyn (("aa" :: Text) =: "aaa" <> "bb" =: "bbb")) def
          fetchElement e = do
             val <- WD.attr e "value"
             sel <- WD.attr e "selected"
             return (fromMaybe "" val, isJust sel)
      -- The "aa" test case is important,  but a good test implementation probably needs to avoid selenium,  because HTML parsers will insert a "selected" attribute on the first "option" tag if no selected attributes are present;  thus as written, this erroneously succeeds on the old implementation (but properly implemented, should fail)
      -- Thus, it would appear that we do actually need a HTML5 or maybe XML parser for this test suite.
      xit "statically renders initial values (on aa)" $ runWD $ do
        doTest [("0",True),("1",False)] "aa"
      -- These tests are currently marked "pending" (by using "xit" instead of "it") because this test has a high chance of non-deterministically failing, which is a problem elsewhere in this test suite as well
      xit "statically renders initial values (on bb)" $ runWD $ do
        doTest [("0",False),("1",True)] "bb"
  
  data Selenium = Selenium
    { _selenium_portNumber :: PortNumber
    , _selenium_stopServer :: IO ()
    }
  
  startSeleniumServer :: PortNumber -> IO (IO ())
  startSeleniumServer port = do
    (_,_,_,ph) <- createProcess $ (proc "selenium-server" ["-port", show port])
      { std_in = NoStream
      , std_out = NoStream
      , std_err = NoStream
      }
    return $ terminateProcess ph
  
  withSeleniumServer :: (Selenium -> IO ()) -> IO ()
  withSeleniumServer f = do
    stopServer <- startSeleniumServer seleniumPort
    threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
    f $ Selenium
      { _selenium_portNumber = seleniumPort
      , _selenium_stopServer = stopServer
      }
  
  triggerEventWithChan :: (Reflex t, TriggerEvent t m, Prerender t m) => Chan a -> m (Event t a)
  triggerEventWithChan chan = do
    (e, trigger) <- newTriggerEvent
    -- In prerender because we only want to do this on the client
    prerender_ (pure ()) $ void $ liftIO $ forkIO $ forever $ trigger =<< readChan chan
    pure e
  
  shouldBeWithRetryM :: (Eq a, Show a) => WD a -> a -> WD ()
  shouldBeWithRetryM m expected = withRetry $ do
    got <- m
    got `shouldBe` expected
  
  assertAttr :: WD.Element -> Text -> Maybe Text -> WD ()
  assertAttr e k v = liftIO . assertEqual "Incorrect attribute value" v =<< WD.attr e k
  
  elementShouldBeRemoved :: WD.Element -> WD ()
  elementShouldBeRemoved e = withRetry $ do
    try (WD.getText e) >>= \case
      Left (WD.FailedCommand WD.StaleElementReference _) -> return ()
      Left err -> throwM err
      Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"
  
  shouldContainText :: Text -> WD.Element -> WD ()
  shouldContainText t = withRetry . shouldContainTextNoRetry t
  
  shouldContainTextNoRetry :: Text -> WD.Element -> WD ()
  shouldContainTextNoRetry t = flip shouldBe t <=< WD.getText
  
  checkBodyText :: Text -> WD ()
  checkBodyText = checkTextInTag "body"
  
  checkTextInTag :: Text -> Text -> WD ()
  checkTextInTag t expected = do
    e <- findElemWithRetry (WD.ByTag t)
    shouldContainText expected e
  
  checkTextInId :: Text -> Text -> WD ()
  checkTextInId i expected = do
    e <- findElemWithRetry (WD.ById i)
    shouldContainText expected e
  
  findElemWithRetry :: Selector -> WD WD.Element
  findElemWithRetry = withRetry . WD.findElem
  
  findElemsWithRetry :: Selector -> WD [WD.Element]
  findElemsWithRetry = withRetry . WD.findElems
  
  getBody :: WD WD.Element
  getBody = WD.findElem $ WD.ByTag "body"
  
  withRetry :: forall a. WD a -> WD a
  withRetry a = wait 300
    where wait :: Int -> WD a
          wait 0 = a
          wait n = try a >>= \case
            Left (e :: SomeException) -> do
              liftIO $ putStrLn ("(retrying due to " <> show e <> ")") *> threadDelay 100000
              wait $ n - 1
            Right v -> return v
  
  divId :: DomBuilder t m => Text -> m a -> m a
  divId i = elAttr "div" ("id" =: i)
  
  type TestWidget t m = (DomBuilder t m, MonadHold t m, PostBuild t m, Prerender t m, PerformEvent t m, TriggerEvent t m, MonadFix m, MonadIO (Performable m), MonadIO m)
  
  testWidgetStaticDebug
    :: Bool
    -> WD b
    -- ^ Webdriver commands to run before JS runs and after hydration switchover
    -> (forall m. TestWidget (SpiderTimeline Global) m => m ())
    -- ^ Widget we are testing
    -> WD b
  testWidgetStaticDebug withDebugging w = testWidgetDebug True withDebugging (void w) w
  
  -- | TODO: do something about JSExceptions not causing tests to fail
  testWidgetDebug
    :: Bool
    -> Bool
    -> WD ()
    -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
    -> WD b
    -- ^ Webdriver commands to run after hydration switchover
    -> (forall m. TestWidget (SpiderTimeline Global) m => m ())
    -- ^ Widget we are testing
    -> WD b
  testWidgetDebug hardFailure withDebugging beforeJS afterSwitchover =
    testWidgetDebug' hardFailure withDebugging beforeJS (const afterSwitchover)
  
  data HydrationFailedException = HydrationFailedException deriving Show
  instance Exception HydrationFailedException
  
  -- | TODO: do something about JSExceptions not causing tests to fail
  testWidgetDebug'
    :: Bool
    -> Bool
    -> WD a
    -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
    -> (a -> WD b)
    -- ^ Webdriver commands to run after hydration switchover
    -> (forall m. TestWidget (SpiderTimeline Global) m => m ())
    -- ^ Widget we are testing (contents of body)
    -> WD b
  testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget = do
    let putStrLnDebug :: MonadIO m => Text -> m ()
        putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
        staticApp = do
          el "head" $ pure ()
          el "body" $ do
            bodyWidget
            el "script" $ text $ TE.decodeUtf8 $ LBS.toStrict $ jsaddleJs False
    putStrLnDebug "rendering static"
    ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp
    putStrLnDebug "rendered static"
    waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
    onFailure <- if hardFailure then (`throwTo` HydrationFailedException) <$> liftIO myThreadId else pure $ pure ()
    waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
    let entryPoint = do
          putStrLnDebug "taking waitBeforeJS"
          liftIO $ takeMVar waitBeforeJS
          let switchOverAction = do
                putStrLnDebug "switchover syncPoint"
                syncPoint
                putStrLnDebug "putting waitUntilSwitchover"
                liftIO $ putMVar waitUntilSwitchover ()
                putStrLnDebug "put waitUntilSwitchover"
          putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"
          mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchOverAction blank bodyWidget
          putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"
          syncPoint
    application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do
      putStrLnDebug "sending response"
      r <- sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html
      putStrLnDebug "sent response"
      return r
    waitJSaddle <- liftIO newEmptyMVar
    let settings = foldr ($) Warp.defaultSettings
          [ Warp.setPort $ fromIntegral $ toInteger jsaddlePort
          , Warp.setBeforeMainLoop $ do
              putStrLnDebug "putting waitJSaddle"
              putMVar waitJSaddle ()
              putStrLnDebug "put waitJSaddle"
          ]
        -- hSilence to get rid of ConnectionClosed logs
        silenceIfDebug = if withDebugging then id else hSilence [stderr]
        jsaddleWarp = silenceIfDebug $ Warp.runSettings settings application
    withAsync' jsaddleWarp $ do
      putStrLnDebug "taking waitJSaddle"
      liftIO $ takeMVar waitJSaddle
      putStrLnDebug "opening page"
      WD.openPage $ "http://localhost:" <> show jsaddlePort
      putStrLnDebug "running beforeJS"
      a <- beforeJS
      putStrLnDebug "putting waitBeforeJS"
      liftIO $ putMVar waitBeforeJS ()
      putStrLnDebug "taking waitUntilSwitchover"
      liftIO $ takeMVar waitUntilSwitchover
      putStrLnDebug "running afterSwitchover"
      afterSwitchover a
  
  withAsync' :: (MonadIO m, MonadMask m) => IO a -> m b -> m b
  withAsync' f g = bracket
    (liftIO $ Async.async f)
    (liftIO . Async.uninterruptibleCancel)
    (const g)
  