module Component.Input ( InputIn(..) , InputOut(..) , input , defaultInputIn ) where import qualified Data.Map as M import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T import Data.Time (NominalDiffTime) import Data.Validation (Validation (Failure, Success)) import qualified Data.Validation as V import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex, (&), (.~)) import qualified Reflex.Dom as R import qualified Common.Util.Validation as ValidationUtil import Component.Button (ButtonIn (..), ButtonOut (..)) import qualified Component.Button as Button import qualified Icon data InputIn a = InputIn { _inputIn_hasResetButton :: Bool , _inputIn_label :: Text , _inputIn_initialValue :: Text , _inputIn_inputType :: Text , _inputIn_validation :: Text -> Validation Text a } defaultInputIn :: InputIn Text defaultInputIn = InputIn { _inputIn_hasResetButton = True , _inputIn_label = "" , _inputIn_initialValue = "" , _inputIn_inputType = "text" , _inputIn_validation = V.Success } data InputOut t a = InputOut { _inputOut_raw :: Dynamic t Text , _inputOut_value :: Dynamic t (Maybe (Validation Text a)) , _inputOut_enter :: Event t () } input :: forall t m a b. MonadWidget t m => InputIn a -> Event t Text -- reset -> Event t b -- validate -> m (InputOut t a) input inputIn reset validate = do rec let resetValue = R.leftmost [ R.traceEvent "reset" reset , fmap (const "") resetClic ] inputAttr = R.ffor value (\v -> if T.null v && _inputIn_inputType inputIn /= "date" then M.empty else M.singleton "class" "filled") value = R._textInput_value textInput containerAttr = R.ffor validatedValue (\v -> M.singleton "class" $ T.intercalate " " [ "textInput" , if Maybe.fromMaybe False (ValidationUtil.isFailure <$> v) then "error" else "" ]) -- Clear validation errors after reset delayedReset <- R.delay (0.1 :: NominalDiffTime) reset validatedValue <- R.holdDyn Nothing $ R.attachWith (\v (clearValidation, validateEmpty) -> if clearValidation then Nothing else Just (_inputIn_validation inputIn $ (if validateEmpty then "" else v))) (R.current value) (R.leftmost [ const (False, True) <$> resetClic , (\f -> (f, False)) <$> (R.updated . R._textInput_hasFocus $ textInput) , const (False, False) <$> validate , const (True, False) <$> R.traceEvent "delayedReset" delayedReset ]) (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do textInput <- R.textInput $ R.def & R.attributes .~ inputAttr & R.setValue .~ resetValue & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn) & R.textInputConfig_inputType .~ (_inputIn_inputType inputIn) R.el "label" $ R.text (_inputIn_label inputIn) resetClic <- if _inputIn_hasResetButton inputIn then _buttonOut_clic <$> (Button.button $ (Button.defaultButtonIn Icon.cross) { _buttonIn_class = R.constDyn "reset" , _buttonIn_tabIndex = Just (-1) }) else return R.never R.divClass "errorMessage" $ R.dynText . fmap validationError $ validatedValue return (textInput, resetClic) let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput return $ InputOut { _inputOut_raw = value , _inputOut_value = validatedValue , _inputOut_enter = enter } validationError :: Maybe (Validation Text a) -> Text validationError (Just (Failure e)) = e validationError _ = ""