Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Input validity #254

Open
wants to merge 1 commit into
base: develop
Choose a base branch
from
Open

Input validity #254

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
63 changes: 49 additions & 14 deletions reflex-dom-core/src/Reflex/Dom/Builder/Class.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -249,13 +249,23 @@ data Element er d t
, _element_raw :: RawElement d
}

data InputElementConfig er t s
= InputElementConfig { _inputElementConfig_initialValue :: Text
, _inputElementConfig_setValue :: Maybe (Event t Text)
, _inputElementConfig_initialChecked :: Bool
, _inputElementConfig_setChecked :: Maybe (Event t Bool)
, _inputElementConfig_elementConfig :: ElementConfig er t s
}
data InputElementConfig er t s = InputElementConfig
{ _inputElementConfig_initialValue :: Text
, _inputElementConfig_setValue :: Maybe (Event t Text)
, _inputElementConfig_initialChecked :: Bool
, _inputElementConfig_setChecked :: Maybe (Event t Bool)
, _inputElementConfig_initialCustomValidity :: Text
-- ^ The initial custom validity status/message. An empty string indicates
-- valid, while a non-empty string indicates invalid. Custom validity is
-- just one endorser of validity; based on the type of the input various
-- other built-in checks may also deem the input invalid, and any one
-- invalid result makes the input invalid overall. '""' is thus the
-- identity.
, _inputElementConfig_setCustomValidity :: Maybe (Event t Text)
-- ^ An event that sets the custom validity. See the initial value
-- documentation for details.
, _inputElementConfig_elementConfig :: ElementConfig er t s
}

#ifndef USE_TEMPLATE_HASKELL
inputElementConfig_initialValue :: Lens' (InputElementConfig er t m) Text
Expand All @@ -280,6 +290,8 @@ instance (Reflex t, er ~ EventResult, DomSpace s) => Default (InputElementConfig
, _inputElementConfig_setValue = Nothing
, _inputElementConfig_initialChecked = False
, _inputElementConfig_setChecked = Nothing
, _inputElementConfig_initialCustomValidity = ""
, _inputElementConfig_setCustomValidity = Nothing
, _inputElementConfig_elementConfig = def
}

Expand All @@ -294,11 +306,17 @@ data InputElement er d t
, _inputElement_files :: Dynamic t [RawFile d]
}

data TextAreaElementConfig er t m
= TextAreaElementConfig { _textAreaElementConfig_initialValue :: Text
, _textAreaElementConfig_setValue :: Maybe (Event t Text)
, _textAreaElementConfig_elementConfig :: ElementConfig er t m
}
data TextAreaElementConfig er t m = TextAreaElementConfig
{ _textAreaElementConfig_initialValue :: Text
, _textAreaElementConfig_setValue :: Maybe (Event t Text)
, _textAreaElementConfig_initialCustomValidity :: Text
-- ^ The initial custom validity status/message. See same field on 'InputElementConfig' for details.
, _textAreaElementConfig_setCustomValidity :: Maybe (Event t Text)
-- ^ An event that sets the custom validity. See the 'initialCustomValidity'
-- and 'setCustomValidity' fields on 'InputElementConfig' for details.
-- documentation for details.
, _textAreaElementConfig_elementConfig :: ElementConfig er t m
}

#ifndef USE_TEMPLATE_HASKELL
textAreaElementConfig_initialValue :: Lens' (TextAreaElementConfig er t m) Text
Expand All @@ -318,6 +336,7 @@ instance (Reflex t, er ~ EventResult, DomSpace s) => Default (TextAreaElementCon
def = TextAreaElementConfig
{ _textAreaElementConfig_initialValue = ""
, _textAreaElementConfig_setValue = Nothing
, _textAreaElementConfig_setCustomValidity = Nothing
, _textAreaElementConfig_elementConfig = def
}

Expand Down Expand Up @@ -394,10 +413,12 @@ data SelectElement er d t = SelectElement
concat <$> mapM (uncurry makeLensesWithoutField)
[ (["_textNodeConfig_setContents"], ''TextNodeConfig)
, ([ "_inputElementConfig_setValue"
, "_inputElementConfig_setChecked" ], ''InputElementConfig)
, "_inputElementConfig_setChecked"
, "_inputElementConfig_setCustomValidity" ], ''InputElementConfig)
, (["_rawElementConfig_modifyAttributes"], ''RawElementConfig)
, (["_elementConfig_modifyAttributes"], ''ElementConfig)
, (["_textAreaElementConfig_setValue"], ''TextAreaElementConfig)
, ([ "_textAreaElementConfig_setValue"
, "_textAreaElementConfig_setCustomValidity" ], ''TextAreaElementConfig)
, (["_selectElementConfig_setValue"], ''SelectElementConfig)
]
#endif
Expand All @@ -423,6 +444,13 @@ inputElementConfig_setChecked =
setter t e = t { _inputElementConfig_setChecked = Just e }
in lens getter setter

-- | This lens is technically illegal. The implementation of 'InputElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'InputElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.
inputElementConfig_setCustomValidity :: Reflex t => Lens' (InputElementConfig er t m) (Event t Text)
inputElementConfig_setCustomValidity =
let getter = fromMaybe never . _inputElementConfig_setCustomValidity
setter t e = t { _inputElementConfig_setCustomValidity = Just e }
in lens getter setter

-- | This lens is technically illegal. The implementation of 'RawElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'RawElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.
rawElementConfig_modifyAttributes :: Reflex t => Lens' (RawElementConfig er t m) (Event t (Map AttributeName (Maybe Text)))
rawElementConfig_modifyAttributes =
Expand All @@ -444,6 +472,13 @@ textAreaElementConfig_setValue =
setter t e = t { _textAreaElementConfig_setValue = Just e }
in lens getter setter

-- | This lens is technically illegal. The implementation of 'TextAreaElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'TextAreaElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.
textAreaElementConfig_setCustomValidity :: Reflex t => Lens' (TextAreaElementConfig er t m) (Event t Text)
textAreaElementConfig_setCustomValidity =
let getter = fromMaybe never . _textAreaElementConfig_setCustomValidity
setter t e = t { _textAreaElementConfig_setCustomValidity = Just e }
in lens getter setter

-- | This lens is technically illegal. The implementation of 'SelectElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'SelectElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.
selectElementConfig_setValue :: Reflex t => Lens' (SelectElementConfig er t m) (Event t Text)
selectElementConfig_setValue =
Expand Down
10 changes: 10 additions & 0 deletions reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -469,6 +469,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
((e, _), domElement) <- makeElement "input" (cfg ^. inputElementConfig_elementConfig) $ return ()
let domInputElement = uncheckedCastTo DOM.HTMLInputElement domElement
Input.setValue domInputElement $ cfg ^. inputElementConfig_initialValue
Input.setCustomValidity domInputElement $ cfg ^. inputElementConfig_initialCustomValidity
v0 <- Input.getValue domInputElement
let getMyValue = Input.getValue domInputElement
valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Input)
Expand Down Expand Up @@ -496,6 +497,10 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
[ fmapMaybe id checkedChangedBySetChecked
, checkedChangedByUI
]
case _inputElementConfig_setCustomValidity cfg of
Nothing -> pure ()
Just eSetInvalid -> void $ requestDomAction $ ffor eSetInvalid $ \v' -> do
Input.setCustomValidity domInputElement v'
let initialFocus = False --TODO: Is this correct?
hasFocus <- holdDyn initialFocus $ leftmost
[ False <$ Reflex.select (_element_events e) (WrapArg Blur)
Expand All @@ -521,6 +526,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
((e, _), domElement) <- makeElement "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()
let domTextAreaElement = uncheckedCastTo DOM.HTMLTextAreaElement domElement
TextArea.setValue domTextAreaElement $ cfg ^. textAreaElementConfig_initialValue
TextArea.setCustomValidity domTextAreaElement $ cfg ^. textAreaElementConfig_initialCustomValidity
v0 <- TextArea.getValue domTextAreaElement
let getMyValue = TextArea.getValue domTextAreaElement
valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Input)
Expand All @@ -533,6 +539,10 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
[ valueChangedBySetValue
, valueChangedByUI
]
case _textAreaElementConfig_setCustomValidity cfg of
Nothing -> pure ()
Just eSetInvalid -> void $ requestDomAction $ ffor eSetInvalid $ \v' -> do
void $ TextArea.setCustomValidity domTextAreaElement v'
hasFocus <- mkHasFocus e
return $ TextAreaElement
{ _textAreaElement_value = v
Expand Down