1bf9bce · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Merge pull request #350 from lpsmith/ls-fix-dropdown-initialValue

1bf9bceElliot Cameron6 years ago

reflex-dom-core/ChangeLog.md+3−1

compare with develop

unifiedsplit

@@ -43,7 +43,9 @@

43 * `CheckboxConfig`

44 * `FileInput`

46− * Add `< 0.7` upper bound for reflex

46+* Add `< 0.7` upper bound for reflex

47+

48+* Fix the static rendering of which dropdown value is selected, see [#310](https://github.com/reflex-frp/reflex-dom/issues/310).

48* *(Breaking change)* The mouse wheel event now is a `WheelEventResult` rather than `()`.

50* *(Breaking change)* The mouse wheel event now is a `WheelEventResult` rather than `()`.

49 This provides information about the wheel's motion beyond the fact that it merely moved.

51 This provides information about the wheel's motion beyond the fact that it merely moved.

reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+4−1

@@ -437,9 +437,12 @@ dropdown k0 options (DropdownConfig setK attrs) = do

437 let xs = fmap (\(ix, (k, v)) -> ((ix, k), ((ix, k), v))) $ zip [0::Int ..] $ Map.toList os

438 in (Map.fromList $ map snd xs, Bimap.fromList $ map fst xs)

439 modifyAttrs <- dynamicAttributesToModifyAttributes attrs

440+ postBuild <- getPostBuild

441+ let setSelection = attachPromptlyDynWithMaybe (flip Bimap.lookupR) ixKeys $

442+ leftmost [setK, k0 <$ postBuild]

440 let cfg = def

443 let cfg = def

441 & selectElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

444 & selectElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

442− & selectElementConfig_setValue .~ fmap (T.pack . show) (attachPromptlyDynWithMaybe (flip Bimap.lookupR) ixKeys setK)

445+ & selectElementConfig_setValue .~ fmap (T.pack . show) setSelection

443 (eRaw, _) <- selectElement cfg $ listWithKey indexedOptions $ \(ix, k) v -> do

446 (eRaw, _) <- selectElement cfg $ listWithKey indexedOptions $ \(ix, k) v -> do

444 let optionAttrs = fmap (\dk -> "value" =: T.pack (show ix) <> if dk == k then "selected" =: "selected" else mempty) defaultKey

447 let optionAttrs = fmap (\dk -> "value" =: T.pack (show ix) <> if dk == k then "selected" =: "selected" else mempty) defaultKey

445 elDynAttr "option" optionAttrs $ dynText v

448 elDynAttr "option" optionAttrs $ dynText v

reflex-dom-core/test/hydration.hs+33−2

@@ -39,6 +39,7 @@ import Data.Functor.Misc

39import Data.GADT.Compare.TH

40import Data.GADT.Show.TH

41import Data.IORef (IORef)

42+import Data.List (sort)

42import Data.Maybe

43import Data.Maybe

43import Data.Proxy

44import Data.Proxy

44import Data.Text (Text)

45import Data.Text (Text)

@@ -49,6 +50,7 @@ import Network.Socket

49import Network.Wai

50import Network.Wai

50import Network.WebSockets

51import Network.WebSockets

51import Reflex.Dom.Core

52import Reflex.Dom.Core

53+import Reflex.Dom.Widget.Input (dropdown)

52import Reflex.Patch.DMapWithMove

54import Reflex.Patch.DMapWithMove

53import System.Directory

55import System.Directory

54import System.Environment

56import System.Environment

@@ -57,7 +59,7 @@ import System.IO.Silently

57import System.IO.Temp

59import System.IO.Temp

58import System.Process

60import System.Process

59import System.Which (staticWhich)

61import System.Which (staticWhich)

60−import qualified Test.HUnit as HUnit (assertEqual, assertFailure)

62+import qualified Test.HUnit as HUnit

61import qualified Test.Hspec as H

63import qualified Test.Hspec as H

62import qualified Test.Hspec.Core.Spec as H

64import qualified Test.Hspec.Core.Spec as H

63import Test.Hspec (xit)

65import Test.Hspec (xit)

@@ -97,11 +99,14 @@ instance MonadRef WD where

97 writeRef r = WD . writeRef r

99 writeRef r = WD . writeRef r

100

99assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()

101assertEqual :: (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

101

103

102assertFailure :: MonadIO m => String -> m ()

104assertFailure :: MonadIO m => String -> m ()

103assertFailure = liftIO . HUnit.assertFailure

105assertFailure = liftIO . HUnit.assertFailure

104

106

107+assertBool :: (MonadIO m) => String -> Bool -> m ()

108+assertBool msg bool = liftIO $ HUnit.assertBool msg bool

109+

105chromeConfig :: Text -> [Text] -> WD.WDConfig

110chromeConfig :: Text -> [Text] -> WD.WDConfig

106chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig

111chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig

107

112

@@ -1295,6 +1300,29 @@ tests withDebugging wdConfig caps _selenium = do

1295 el "ol" $ text "inner"

1300 el "ol" $ text "inner"

1296 text "after"

1301 text "after"

1297

1302

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+

1298data Selenium = Selenium

1326data Selenium = Selenium

1299 { _selenium_portNumber :: PortNumber

1327 { _selenium_portNumber :: PortNumber

1300 , _selenium_stopServer :: IO ()

1328 , _selenium_stopServer :: IO ()

@@ -1362,6 +1390,9 @@ checkTextInId i expected = do

1362findElemWithRetry :: Selector -> WD WD.Element

1390findElemWithRetry :: Selector -> WD WD.Element

1363findElemWithRetry = withRetry . WD.findElem

1391findElemWithRetry = withRetry . WD.findElem

1364

1392

1393+findElemsWithRetry :: Selector -> WD [WD.Element]

1394+findElemsWithRetry = withRetry . WD.findElems

1395+

1365getBody :: WD WD.Element

1396getBody :: WD WD.Element

1366getBody = WD.findElem $ WD.ByTag "body"

1397getBody = WD.findElem $ WD.ByTag "body"

1367

1398