@@ -37,6 +37,7 @@ import Data.Functor.Misc
37import Data.GADT.Compare.TH
37import Data.GADT.Compare.TH
38import Data.GADT.Show.TH
38import Data.GADT.Show.TH
39import Data.IORef (IORef)
39import Data.IORef (IORef)
40+import Data.List (sort)
40import Data.Maybe
41import Data.Maybe
41import Data.Proxy
42import Data.Proxy
42import Data.Text (Text)
43import Data.Text (Text)
@@ -47,6 +48,7 @@ import Network.Socket
47import Network.Wai
48import Network.Wai
48import Network.WebSockets
49import Network.WebSockets
49import Reflex.Dom.Core
50import Reflex.Dom.Core
51+import Reflex.Dom.Widget.Input (dropdown)
50import Reflex.Patch.DMapWithMove
52import Reflex.Patch.DMapWithMove
51import System.Directory
53import System.Directory
52import System.Environment
54import System.Environment
@@ -55,7 +57,7 @@ import System.IO.Silently
55import System.IO.Temp
57import System.IO.Temp
56import System.Process
58import System.Process
57import System.Which (staticWhich)
59import System.Which (staticWhich)
58−import qualified Test.HUnit as HUnit (assertEqual, assertFailure)
60+import qualified Test.HUnit as HUnit
59import qualified Test.Hspec as H
61import qualified Test.Hspec as H
60import qualified Test.Hspec.Core.Spec as H
62import qualified Test.Hspec.Core.Spec as H
61import Test.Hspec (xit)
63import Test.Hspec (xit)
@@ -93,11 +95,14 @@ instance MonadRef WD where
93 writeRef r = WD . writeRef r
95 writeRef r = WD . writeRef r
95assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()
97assertEqual :: (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
98assertFailure :: MonadIO m => String -> m ()
100assertFailure :: MonadIO m => String -> m ()
99assertFailure = liftIO . HUnit.assertFailure
101assertFailure = liftIO . HUnit.assertFailure
103+assertBool :: (MonadIO m) => String -> Bool -> m ()
104+assertBool msg bool = liftIO $ HUnit.assertBool msg bool
101chromeConfig :: Text -> [Text] -> WD.WDConfig
106chromeConfig :: Text -> [Text] -> WD.WDConfig
102chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig
107chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig
@@ -1230,6 +1235,29 @@ tests withDebugging wdConfig caps _selenium = do
1230 el "ol" $ text "inner"
1235 el "ol" $ text "inner"
1231 text "after"
1236 text "after"
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
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"
1233data Selenium = Selenium
1261data Selenium = Selenium
1234 { _selenium_portNumber :: PortNumber
1262 { _selenium_portNumber :: PortNumber
1235 , _selenium_stopServer :: IO ()
1263 , _selenium_stopServer :: IO ()
@@ -1297,6 +1325,9 @@ checkTextInId i expected = do
1297findElemWithRetry :: Selector -> WD WD.Element
1325findElemWithRetry :: Selector -> WD WD.Element
1298findElemWithRetry = withRetry . WD.findElem
1326findElemWithRetry = withRetry . WD.findElem
1328+findElemsWithRetry :: Selector -> WD [WD.Element]
1329+findElemsWithRetry = withRetry . WD.findElems
1300getBody :: WD WD.Element
1331getBody :: WD WD.Element
1301getBody = WD.findElem $ WD.ByTag "body"
1332getBody = WD.findElem $ WD.ByTag "body"