aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component/Select.hs
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Component/Select.hs')
-rw-r--r--client/src/Component/Select.hs80
1 files changed, 0 insertions, 80 deletions
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
deleted file mode 100644
index 70f5f58..0000000
--- a/client/src/Component/Select.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-module Component.Select
- ( view
- , In(..)
- , Out(..)
- ) where
-
-import Data.Map (Map)
-import qualified Data.Map as M
-import qualified Data.Maybe as Maybe
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Validation (Validation)
-import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom as R
-
-import qualified Util.Validation as ValidationUtil
-
-data (Reflex t) => In t a b c = In
- { _in_label :: Text
- , _in_initialValue :: a
- , _in_value :: Event t a
- , _in_values :: Dynamic t (Map a Text)
- , _in_reset :: Event t b
- , _in_isValid :: a -> Validation Text a
- , _in_validate :: Event t c
- }
-
-data Out t a = Out
- { _out_raw :: Dynamic t a
- , _out_value :: Dynamic t (Validation Text a)
- }
-
-view :: forall t m a b c. (Ord a, MonadWidget t m) => In t a b c -> m (Out t a)
-view input = do
- rec
- let containerAttr = R.ffor showedError (\e ->
- M.singleton "class" $ T.intercalate " "
- [ "input selectInput"
- , if Maybe.isJust e then "error" else ""
- ])
-
- validatedValue =
- fmap (_in_isValid input) value
-
- maybeError =
- fmap ValidationUtil.maybeError validatedValue
-
- showedError <- R.holdDyn Nothing $ R.leftmost
- [ Nothing <$ _in_reset input
- , R.updated maybeError
- , R.attachWith const (R.current maybeError) (_in_validate input)
- ]
-
- value <- R.elDynAttr "div" containerAttr $ do
- let initialValue = _in_initialValue input
-
- let setValue = R.leftmost
- [ initialValue <$ (_in_reset input)
- , _in_value input
- ]
-
- value <- R.el "label" $ do
- R.divClass "label" $
- R.text (_in_label input)
-
- R._dropdown_value <$>
- R.dropdown
- initialValue
- (_in_values input)
- (R.def { R._dropdownConfig_setValue = setValue })
-
- R.divClass "errorMessage" . R.dynText $
- R.ffor showedError (Maybe.fromMaybe "")
-
- return value
-
- return Out
- { _out_raw = value
- , _out_value = validatedValue
- }