@@ -37,6 +37,7 @@ import Data.Functor.Misc
3737import Data.GADT.Compare.TH
3838import Data.GADT.Show.TH
3939import Data.IORef (IORef)
40+import Data.List (sort)
4041import Data.Maybe
4142import Data.Proxy
4243import Data.Text (Text)
@@ -47,6 +48,7 @@ import Network.Socket
4748import Network.Wai
4849import Network.WebSockets
4950import Reflex.Dom.Core
51+import Reflex.Dom.Widget.Input (dropdown)
5052import Reflex.Patch.DMapWithMove
5153import System.Directory
5254import System.Environment
@@ -55,7 +57,7 @@ import System.IO.Silently
5557import System.IO.Temp
5658import System.Process
5759import System.Which (staticWhich)
58−import qualified Test.HUnit as HUnit (assertEqual, assertFailure)
60+import qualified Test.HUnit as HUnit
5961import qualified Test.Hspec as H
6062import qualified Test.Hspec.Core.Spec as H
6163import Test.Hspec (xit)
@@ -93,11 +95,14 @@ instance MonadRef WD where
9395 writeRef r = WD . writeRef r
9496
9597assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()
96−assertEqual a b = liftIO . HUnit.assertEqual a b
98+assertEqual msg a b = liftIO $ HUnit.assertEqual msg a b
9799
98100assertFailure :: MonadIO m => String -> m ()
99101assertFailure = liftIO . HUnit.assertFailure
100102
103+assertBool :: (MonadIO m) => String -> Bool -> m ()
104+assertBool msg bool = liftIO $ HUnit.assertBool msg bool
105+
101106chromeConfig :: Text -> [Text] -> WD.WDConfig
102107chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig
103108
@@ -1230,6 +1235,29 @@ tests withDebugging wdConfig caps _selenium = do
12301235 el "ol" $ text "inner"
12311236 text "after"
12321237
1238+ -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options.
1239+ -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid.
1240+ -- It seems expedient for the time being to expect this test case to be updated, should those implementation details ever change.
1241+ describe "dropdown" $ session' $ do
1242+ let doTest expectedOpts (initialValue :: Text) = do
1243+ let doCheck = do
1244+ es <- findElemsWithRetry $ WD.ByTag "option"
1245+ opts <- mapM fetchElement es
1246+ assertEqual "missing/extra/incorrect option element(s)" expectedOpts (sort opts)
1247+ testWidget doCheck doCheck $ do
1248+ void $ dropdown initialValue (constDyn (("aa" :: Text) =: "aaa" <> "bb" =: "bbb")) def
1249+ fetchElement e = do
1250+ val <- WD.attr e "value"
1251+ sel <- WD.attr e "selected"
1252+ return (fromMaybe "" val, sel /= Nothing)
1253+ -- 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)
1254+ -- Thus, it would appear that we do actually need a HTML5 or maybe XML parser for this test suite.
1255+ xit "statically renders initial values (on aa)" $ runWD $ do
1256+ doTest [("0",True),("1",False)] "aa"
1257+ -- 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
1258+ xit "statically renders initial values (on bb)" $ runWD $ do
1259+ doTest [("0",False),("1",True)] "bb"
1260+
12331261data Selenium = Selenium
12341262 { _selenium_portNumber :: PortNumber
12351263 , _selenium_stopServer :: IO ()
@@ -1297,6 +1325,9 @@ checkTextInId i expected = do
12971325findElemWithRetry :: Selector -> WD WD.Element
12981326findElemWithRetry = withRetry . WD.findElem
12991327
1328+findElemsWithRetry :: Selector -> WD [WD.Element]
1329+findElemsWithRetry = withRetry . WD.findElems
1330+
13001331getBody :: WD WD.Element
13011332getBody = WD.findElem $ WD.ByTag "body"
13021333