0b93790 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

More careful handling of value/checked statuses for inputElement

0b93790Tom Smalley6 years ago

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+35−8

compare with develop

unifiedsplit

@@ -11,6 +11,7 @@

11{-# LANGUAGE GeneralizedNewtypeDeriving #-}

12{-# LANGUAGE LambdaCase #-}

13{-# LANGUAGE MultiParamTypeClasses #-}

14+{-# LANGUAGE MultiWayIf #-}

14{-# LANGUAGE OverloadedStrings #-}

15{-# LANGUAGE OverloadedStrings #-}

15{-# LANGUAGE PatternGuards #-}

16{-# LANGUAGE PatternGuards #-}

16{-# LANGUAGE PolyKinds #-}

17{-# LANGUAGE PolyKinds #-}

@@ -321,7 +322,7 @@ instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationRunnerT t m) where

321-- done *before* the switchover to immediate mode - this is most likely some

322-- done *before* the switchover to immediate mode - this is most likely some

322-- form of 'hold' which we want to remove after hydration is done

323-- form of 'hold' which we want to remove after hydration is done

323{-# INLINABLE addHydrationStepWithSetup #-}

324{-# INLINABLE addHydrationStepWithSetup #-}

324−addHydrationStepWithSetup :: (Adjustable t m, MonadIO m) => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()

325+addHydrationStepWithSetup :: MonadIO m => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()

325addHydrationStepWithSetup setup f = getHydrationMode >>= \case

326addHydrationStepWithSetup setup f = getHydrationMode >>= \case

326 HydrationMode_Immediate -> pure ()

327 HydrationMode_Immediate -> pure ()

327 HydrationMode_Hydrating -> do

328 HydrationMode_Hydrating -> do

@@ -926,14 +927,28 @@ inputElementInternal cfg = getHydrationMode >>= \case

926 doc <- askDocument

927 doc <- askDocument

927 -- Expected initial value from config

928 -- Expected initial value from config

928 let v0 = _inputElementConfig_initialValue cfg

929 let v0 = _inputElementConfig_initialValue cfg

929− addHydrationStep $ do

930+ c0 = _inputElementConfig_initialChecked cfg

931+ valuesAtSwitchover = do

932+ v <- maybe (pure $ pure v0) (hold v0) (_inputElementConfig_setValue cfg)

933+ c <- maybe (pure $ pure c0) (hold c0) (_inputElementConfig_setChecked cfg)

934+ pure (v, c)

935+ addHydrationStepWithSetup valuesAtSwitchover $ \(switchoverValue', switchoverChecked') -> do

936+ switchoverValue <- sample switchoverValue'

937+ switchoverChecked <- sample switchoverChecked'

930 domElement <- liftIO $ readIORef domElementRef

938 domElement <- liftIO $ readIORef domElementRef

931 let domInputElement = uncheckedCastTo DOM.HTMLInputElement domElement

939 let domInputElement = uncheckedCastTo DOM.HTMLInputElement domElement

932 getValue = Input.getValue domInputElement

940 getValue = Input.getValue domInputElement

933− -- The browser might have messed with the value, or the user could have

941+ -- Fire the appropriate events if the value has changed somehow

934− -- altered it before activation, so we set it if it isn't what we expect

935− liftJSM getValue >>= \v0' -> do

942+ liftJSM getValue >>= \realValue -> liftIO $ if

943+ -- The user could have altered the value before switchover

936− when (v0' /= v0) $ liftIO $ triggerChangeByUI v0'

944+ | realValue /= switchoverValue -> triggerChangeByUI realValue

945+ -- When the value has been updated by setValue before switchover, but

946+ -- the user hasn't entered text, we must send an update here to remain

947+ -- in sync. This is because the later requestDomAction based on the

948+ -- setValue event will not capture events happening before postBuild,

949+ -- because this code runs after switchover.

950+ | v0 /= switchoverValue -> triggerChangeBySetValue switchoverValue

951+ | otherwise -> pure ()

937 -- Watch for user interaction and trigger event accordingly

952 -- Watch for user interaction and trigger event accordingly

938 requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)

953 requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)

939 for_ (_inputElementConfig_setValue cfg) $ \eSetValue ->

954 for_ (_inputElementConfig_setValue cfg) $ \eSetValue ->

@@ -947,7 +962,19 @@ inputElementInternal cfg = getHydrationMode >>= \case

947 ]

962 ]

948 liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc

963 liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc

949 requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'

964 requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'

950− Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg

965+ -- Fire the appropriate events if the checked state has changed somehow

966+ liftJSM (Input.getChecked domInputElement) >>= \realChecked -> liftIO $ if

967+ -- The user could have clicked the checkbox before switchover, we only

968+ -- detect cases where they flipped the state

969+ | realChecked /= switchoverChecked -> triggerCheckedChangedByUI realChecked

970+ -- When the checked state has been updated by setChecked before

971+ -- switchover, but the user hasn't changed the state, we must send an

972+ -- update here to remain in sync. This is because the later

973+ -- requestDomAction based on the setChecked event will not capture

974+ -- events happening before postBuild, because this code runs after

975+ -- switchover.

976+ | c0 /= switchoverChecked -> triggerCheckedChangedBySetChecked switchoverChecked

977+ | otherwise -> pure ()

951 _ <- liftJSM $ domInputElement `on` Events.click $ do

978 _ <- liftJSM $ domInputElement `on` Events.click $ do

952 liftIO . triggerCheckedChangedByUI =<< Input.getChecked domInputElement

979 liftIO . triggerCheckedChangedByUI =<< Input.getChecked domInputElement

953 for_ (_inputElementConfig_setChecked cfg) $ \eNewchecked ->

980 for_ (_inputElementConfig_setChecked cfg) $ \eNewchecked ->

@@ -960,7 +987,7 @@ inputElementInternal cfg = getHydrationMode >>= \case

960 let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs

987 let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs

961 liftIO . triggerFileChange =<< maybe (return []) getMyFiles mfiles

988 liftIO . triggerFileChange =<< maybe (return []) getMyFiles mfiles

962 return ()

989 return ()

963− checked' <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost

990+ checked' <- holdDyn c0 $ leftmost

964 [ checkedChangedBySetChecked

991 [ checkedChangedBySetChecked

965 , checkedChangedByUI

992 , checkedChangedByUI

966 ]

993 ]

reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+20−8

@@ -312,16 +312,28 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh

312 return (e, result)

313 {-# INLINABLE inputElement #-}

314 inputElement cfg = do

315− -- Tweak the config to update the "value" attribute appropriately.

315+ -- Tweak the config to update the "value" and "checked" attributes appropriately.

316 -- TODO: warn upon overwriting values.

317+ let setInitialValue = Map.insert "value" (_inputElementConfig_initialValue cfg)

318+ setUpdatedValue updatedAttrs = case _inputElementConfig_setValue cfg of

319+ Nothing -> updatedAttrs

320+ Just e -> (Map.singleton "value" . Just <$> e) <> updatedAttrs

321+ setInitialChecked = case _inputElementConfig_initialChecked cfg of

322+ True -> Map.insert "checked" "checked"

323+ False -> id

324+ setUpdatedChecked updatedAttrs = case _inputElementConfig_setChecked cfg of

325+ Nothing -> updatedAttrs

326+ Just e -> (Map.singleton "checked" (Just "checked") <$ e) <> updatedAttrs

317− let adjustedConfig = (_inputElementConfig_elementConfig cfg)

327+ adjustedConfig = (_inputElementConfig_elementConfig cfg)

318− & elementConfig_initialAttributes %~ Map.insert "value" (_inputElementConfig_initialValue cfg)

328+ & elementConfig_initialAttributes %~ setInitialValue . setInitialChecked

319− & elementConfig_modifyAttributes %~ (case _inputElementConfig_setValue cfg of

329+ & elementConfig_modifyAttributes %~ setUpdatedValue . setUpdatedChecked

320− Nothing -> id

321− Just e -> \e' -> (Map.singleton "value" . Just <$> e) <> e')

322 (e, _result) <- element "input" adjustedConfig $ return ()

330 (e, _result) <- element "input" adjustedConfig $ return ()

331+ v0 <- case _inputElementConfig_setValue cfg of

323− let v0 = constDyn $ cfg ^. inputElementConfig_initialValue

332+ Nothing -> pure $ constDyn (cfg ^. inputElementConfig_initialValue)

324− let c0 = constDyn $ cfg ^. inputElementConfig_initialChecked

333+ Just e -> holdDyn (cfg ^. inputElementConfig_initialValue) e

334+ c0 <- case _inputElementConfig_setChecked cfg of

335+ Nothing -> pure $ constDyn $ _inputElementConfig_initialChecked cfg

336+ Just e -> holdDyn (_inputElementConfig_initialChecked cfg) e

325 let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes

337 let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes

326 return $ InputElement

338 return $ InputElement

327 { _inputElement_value = v0

339 { _inputElement_value = v0