aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component/Input.hs
diff options
context:
space:
mode:
authorJoris2021-01-03 13:40:40 +0100
committerJoris2021-01-03 13:54:20 +0100
commit11052951b74b9ad4b6a9412ae490086235f9154b (patch)
tree64526ac926c1bf470ea113f6cac8a33158684e8d /client/src/Component/Input.hs
parent371449b0e312a03162b78797b83dee9d81706669 (diff)
downloadbudget-11052951b74b9ad4b6a9412ae490086235f9154b.tar.gz
budget-11052951b74b9ad4b6a9412ae490086235f9154b.tar.bz2
budget-11052951b74b9ad4b6a9412ae490086235f9154b.zip
Rewrite in Rust
Diffstat (limited to 'client/src/Component/Input.hs')
-rw-r--r--client/src/Component/Input.hs151
1 files changed, 0 insertions, 151 deletions
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
deleted file mode 100644
index bcff377..0000000
--- a/client/src/Component/Input.hs
+++ /dev/null
@@ -1,151 +0,0 @@
-module Component.Input
- ( In(..)
- , Out(..)
- , view
- , defaultIn
- ) 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 qualified Component.Button as Button
-import qualified View.Icon as Icon
-
-data In a = In
- { _in_hasResetButton :: Bool
- , _in_label :: Text
- , _in_initialValue :: Text
- , _in_inputType :: Text
- , _in_validation :: Text -> Validation Text a
- }
-
-defaultIn :: In Text
-defaultIn = In
- { _in_hasResetButton = True
- , _in_label = ""
- , _in_initialValue = ""
- , _in_inputType = "text"
- , _in_validation = V.Success
- }
-
-data Out t a = Out
- { _out_raw :: Dynamic t Text
- , _out_value :: Dynamic t (Validation Text a)
- , _out_enter :: Event t ()
- }
-
-view
- :: forall t m a b. MonadWidget t m
- => In a
- -> Event t Text -- reset
- -> Event t b -- validate
- -> m (Out t a)
-view input reset validate = do
- rec
- let resetValue = R.leftmost
- [ reset
- , fmap (const "") resetClic
- ]
-
- inputAttr = R.ffor value (\v ->
- if T.null v && _in_inputType input /= "date" && _in_inputType input /= "color"
- then M.empty
- else M.singleton "class" "filled")
-
- value = R._textInput_value textInput
-
- containerAttr = R.ffor inputError (\e ->
- M.singleton "class" $ T.intercalate " "
- [ "textInput"
- , if Maybe.isJust e then "error" else ""
- ])
-
- let valueWithValidation = R.ffor value (\v -> (v, _in_validation input $ v))
- inputError <- getInputError valueWithValidation validate
-
- (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
-
- textInput <- R.el "label" $ do
- textInput <- R.textInput $ R.def
- & R.attributes .~ inputAttr
- & R.setValue .~ resetValue
- & R.textInputConfig_initialValue .~ (_in_initialValue input)
- & R.textInputConfig_inputType .~ (_in_inputType input)
-
- R.divClass "label" $
- R.text (_in_label input)
-
- return textInput
-
- resetClic <-
- if _in_hasResetButton input
- then
- Button._out_clic <$> (Button.view $
- (Button.defaultIn Icon.cross)
- { Button._in_class = R.constDyn "reset"
- , Button._in_tabIndex = Just (-1)
- })
- else
- return R.never
-
- R.divClass "errorMessage" $
- R.dynText . fmap (Maybe.fromMaybe "") $ inputError
-
- return (textInput, resetClic)
-
- let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
-
- return $ Out
- { _out_raw = value
- , _out_value = fmap snd valueWithValidation
- , _out_enter = enter
- }
-
-getInputError
- :: forall t m a b c. MonadWidget t m
- => Dynamic t (Text, Validation Text a)
- -> Event t c
- -> m (Dynamic t (Maybe Text))
-getInputError validatedValue validate = do
- let errorDynamic = fmap (\(t, v) -> (t, validationError v)) validatedValue
- errorEvent = R.updated errorDynamic
- delayedError <- R.debounce (1 :: NominalDiffTime) errorEvent
- fmap (fmap fst) $ R.foldDyn
- (\event (err, hasBeenResetted) ->
- case event of
- ModifiedEvent t ->
- (Nothing, T.null t)
-
- ValidateEvent e ->
- (e, False)
-
- DelayEvent e ->
- if hasBeenResetted then
- (Nothing, False)
- else
- (e, False)
- )
- (Nothing, False)
- (R.leftmost
- [ fmap (\(t, _) -> ModifiedEvent t) errorEvent
- , fmap (\(_, e) -> DelayEvent e) delayedError
- , R.attachWith (\(_, e) _ -> ValidateEvent e) (R.current errorDynamic) validate
- ])
-
-validationError :: (Validation Text a) -> Maybe Text
-validationError (Failure e) = Just e
-validationError _ = Nothing
-
-data InputEvent
- = ModifiedEvent Text
- | DelayEvent (Maybe Text)
- | ValidateEvent (Maybe Text)