@@ -39,6 +39,7 @@ import Data.Functor.Misc
3939import Data.GADT.Compare.TH
4040import Data.GADT.Show.TH
4141import Data.IORef (IORef)
42+import Data.List (sort)
4243import Data.Maybe
4344import Data.Proxy
4445import Data.Text (Text)
@@ -49,6 +50,7 @@ import Network.Socket
4950import Network.Wai
5051import Network.WebSockets
5152import Reflex.Dom.Core
53+import Reflex.Dom.Widget.Input (dropdown)
5254import Reflex.Patch.DMapWithMove
5355import System.Directory
5456import System.Environment
@@ -57,7 +59,7 @@ import System.IO.Silently
5759import System.IO.Temp
5860import System.Process
5961import System.Which (staticWhich)
60−import qualified Test.HUnit as HUnit (assertEqual, assertFailure)
62+import qualified Test.HUnit as HUnit
6163import qualified Test.Hspec as H
6264import qualified Test.Hspec.Core.Spec as H
6365import Test.Hspec (xit)
@@ -97,11 +99,14 @@ instance MonadRef WD where
9799 writeRef r = WD . writeRef r
98100
99101assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()
100−assertEqual a b = liftIO . HUnit.assertEqual a b
102+assertEqual msg a b = liftIO $ HUnit.assertEqual msg a b
101103
102104assertFailure :: MonadIO m => String -> m ()
103105assertFailure = liftIO . HUnit.assertFailure
104106
107+assertBool :: (MonadIO m) => String -> Bool -> m ()
108+assertBool msg bool = liftIO $ HUnit.assertBool msg bool
109+
105110chromeConfig :: Text -> [Text] -> WD.WDConfig
106111chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig
107112
@@ -1295,6 +1300,29 @@ tests withDebugging wdConfig caps _selenium = do
12951300 el "ol" $ text "inner"
12961301 text "after"
12971302
1303+ -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options.
1304+ -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid.
1305+ -- It seems expedient for the time being to expect this test case to be updated, should those implementation details ever change.
1306+ describe "dropdown" $ session' $ do
1307+ let doTest expectedOpts (initialValue :: Text) = do
1308+ let doCheck = do
1309+ es <- findElemsWithRetry $ WD.ByTag "option"
1310+ opts <- mapM fetchElement es
1311+ assertEqual "missing/extra/incorrect option element(s)" expectedOpts (sort opts)
1312+ testWidget doCheck doCheck $ do
1313+ void $ dropdown initialValue (constDyn (("aa" :: Text) =: "aaa" <> "bb" =: "bbb")) def
1314+ fetchElement e = do
1315+ val <- WD.attr e "value"
1316+ sel <- WD.attr e "selected"
1317+ return (fromMaybe "" val, isJust sel)
1318+ -- 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)
1319+ -- Thus, it would appear that we do actually need a HTML5 or maybe XML parser for this test suite.
1320+ xit "statically renders initial values (on aa)" $ runWD $ do
1321+ doTest [("0",True),("1",False)] "aa"
1322+ -- 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
1323+ xit "statically renders initial values (on bb)" $ runWD $ do
1324+ doTest [("0",False),("1",True)] "bb"
1325+
12981326data Selenium = Selenium
12991327 { _selenium_portNumber :: PortNumber
13001328 , _selenium_stopServer :: IO ()
@@ -1362,6 +1390,9 @@ checkTextInId i expected = do
13621390findElemWithRetry :: Selector -> WD WD.Element
13631391findElemWithRetry = withRetry . WD.findElem
13641392
1393+findElemsWithRetry :: Selector -> WD [WD.Element]
1394+findElemsWithRetry = withRetry . WD.findElems
1395+
13651396getBody :: WD WD.Element
13661397getBody = WD.findElem $ WD.ByTag "body"
13671398