From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- client/src/Component/Button.hs | 41 +++++++++++++++++++++++++++++------------ client/src/Component/Form.hs | 12 ++++++++++++ client/src/Component/Input.hs | 27 +++++++++++++++++++-------- client/src/Component/Modal.hs | 24 +++++++++++++++--------- client/src/Component/Select.hs | 32 ++++++++++++++++++++++++++++++++ 5 files changed, 107 insertions(+), 29 deletions(-) create mode 100644 client/src/Component/Form.hs create mode 100644 client/src/Component/Select.hs (limited to 'client/src/Component') diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs index 3ee9561..bf604f1 100644 --- a/client/src/Component/Button.hs +++ b/client/src/Component/Button.hs @@ -2,10 +2,11 @@ module Component.Button ( ButtonIn(..) , ButtonOut(..) , button - , buttonInDefault + , defaultButtonIn ) where import qualified Data.Map as M +import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) @@ -14,22 +15,36 @@ import qualified Reflex.Dom as R import qualified Icon data ButtonIn t m = ButtonIn - { _buttonIn_class :: Dynamic t Text - , _buttonIn_content :: m () - , _buttonIn_waiting :: Event t Bool + { _buttonIn_class :: Dynamic t Text + , _buttonIn_content :: m () + , _buttonIn_waiting :: Event t Bool + , _buttonIn_tabIndex :: Maybe Int + , _buttonIn_submit :: Bool } -buttonInDefault :: forall t m. (MonadWidget t m) => ButtonIn t m -buttonInDefault = ButtonIn - { _buttonIn_class = R.constDyn "" - , _buttonIn_content = R.blank - , _buttonIn_waiting = R.never +defaultButtonIn :: MonadWidget t m => m () -> ButtonIn t m +defaultButtonIn content = ButtonIn + { _buttonIn_class = R.constDyn "" + , _buttonIn_content = content + , _buttonIn_waiting = R.never + , _buttonIn_tabIndex = Nothing + , _buttonIn_submit = False } +-- defaultButtonIn :: MonadWidget t m => ButtonIn t m +-- defaultButtonIn = ButtonIn +-- { _buttonIn_class = R.constDyn "" +-- , _buttonIn_content = R.blank +-- , _buttonIn_waiting = R.never +-- , _buttonIn_tabIndex = Nothing +-- , _buttonIn_submit = False +-- } + data ButtonOut t = ButtonOut { _buttonOut_clic :: Event t () } + button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t) button buttonIn = do dynWaiting <- R.holdDyn False $ _buttonIn_waiting buttonIn @@ -37,9 +52,11 @@ button buttonIn = do let attr = do buttonClass <- _buttonIn_class buttonIn waiting <- dynWaiting - return $ if waiting - then M.fromList [("type", "button"), ("class", T.intercalate " " [ buttonClass, "waiting" ])] - else M.fromList [("type", "button"), ("class", buttonClass)] + return . M.fromList . catMaybes $ + [ Just ("type", if _buttonIn_submit buttonIn then "submit" else "button") + , (\i -> ("tabindex", T.pack . show $ i)) <$> _buttonIn_tabIndex buttonIn + , Just ("class", T.intercalate " " [ buttonClass, if waiting then "waiting" else "" ]) + ] (e, _) <- R.elDynAttr' "button" attr $ do Icon.loading diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs new file mode 100644 index 0000000..0a89c6e --- /dev/null +++ b/client/src/Component/Form.hs @@ -0,0 +1,12 @@ +module Component.Form + ( form + ) where + +import qualified Data.Map as M +import Reflex.Dom (MonadWidget) +import qualified Reflex.Dom as R + +form :: forall t m a. (MonadWidget t m) => m a -> m a +form content = + R.elAttr "form" (M.singleton "onsubmit" "event.preventDefault()") $ + content diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs index 24aac22..92f8ec9 100644 --- a/client/src/Component/Input.hs +++ b/client/src/Component/Input.hs @@ -2,12 +2,14 @@ module Component.Input ( InputIn(..) , InputOut(..) , input + , defaultInputIn ) where import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T -import Reflex.Dom (Dynamic, Event, MonadWidget, (&), (.~)) +import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex, (&), + (.~)) import qualified Reflex.Dom as R import Component.Button (ButtonIn (..), ButtonOut (..)) @@ -15,8 +17,16 @@ import qualified Component.Button as Button import qualified Icon data InputIn t a b = InputIn - { _inputIn_reset :: Event t a - , _inputIn_label :: Text + { _inputIn_reset :: Event t a + , _inputIn_label :: Text + , _inputIn_initialValue :: Text + } + +defaultInputIn :: (Reflex t) => InputIn t a b +defaultInputIn = InputIn + { _inputIn_reset = R.never + , _inputIn_label = "" + , _inputIn_initialValue = "" } data InputOut t = InputOut @@ -41,14 +51,15 @@ input inputIn = textInput <- R.textInput $ R.def & R.attributes .~ attributes & R.setValue .~ resetValue + & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn) R.el "label" $ R.text (_inputIn_label inputIn) - reset <- Button.button $ ButtonIn - { _buttonIn_class = R.constDyn "reset" - , _buttonIn_content = Icon.cross - , _buttonIn_waiting = R.never - } + reset <- Button.button $ + (Button.defaultButtonIn Icon.cross) + { _buttonIn_class = R.constDyn "reset" + , _buttonIn_tabIndex = Just (-1) + } let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs index bfb5e02..1d70c90 100644 --- a/client/src/Component/Modal.hs +++ b/client/src/Component/Modal.hs @@ -10,18 +10,22 @@ import qualified Data.Map as M import Reflex.Dom (Event, MonadWidget) import qualified Reflex.Dom as R -data ModalIn t m = ModalIn +data ModalIn t m a = ModalIn { _modalIn_show :: Event t () - , _modalIn_content :: m () + , _modalIn_hide :: Event t () + , _modalIn_content :: m a } -data ModalOut = ModalOut {} +data ModalOut a = ModalOut + { _modalOut_content :: a + } -modal :: forall t m. MonadWidget t m => ModalIn t m -> m ModalOut +modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut a) modal modalIn = do rec showModal <- R.holdDyn False $ R.leftmost [ True <$ _modalIn_show modalIn + , False <$ _modalIn_hide modalIn , False <$ curtainClick ] @@ -30,9 +34,11 @@ modal modalIn = do , ("class", "modal") ]) - curtainClick <- R.elDynAttr "div" attr $ do - (curtain, _) <- R.elAttr' "div" (M.singleton "class" "curtain") $ R.blank - R.divClass "content" $ _modalIn_content modalIn - return $ R.domEvent R.Click curtain + (curtainClick, content) <- R.elDynAttr "div" attr $ do + (curtain, _) <- R.elAttr' "div" (M.singleton "class" "modalCurtain") $ R.blank + cont <- R.divClass "modalContent" $ _modalIn_content modalIn + return (R.domEvent R.Click curtain, cont) - return $ ModalOut {} + return $ ModalOut + { _modalOut_content = content + } diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs new file mode 100644 index 0000000..876548e --- /dev/null +++ b/client/src/Component/Select.hs @@ -0,0 +1,32 @@ +module Component.Select + ( SelectIn(..) + , SelectOut(..) + , select + ) where + +import Data.Map (Map) +import Data.Text (Text) +import Reflex.Dom (Dynamic, MonadWidget, Reflex) +import qualified Reflex.Dom as R + +data (Reflex t) => SelectIn t a = SelectIn + { _selectIn_label :: Text + , _selectIn_initialValue :: a + , _selectIn_values :: Dynamic t (Map a Text) + } + +data SelectOut t a = SelectOut + { _selectOut_value :: Dynamic t a + } + +select :: forall t m a. (Ord a) => MonadWidget t m => SelectIn t a -> m (SelectOut t a) +select selectIn = + R.divClass "selectInput" $ do + R.el "label" $ R.text (_selectIn_label selectIn) + + value <- R._dropdown_value <$> + R.dropdown (_selectIn_initialValue selectIn) (_selectIn_values selectIn) R.def + + return SelectOut + { _selectOut_value = value + } -- cgit v1.2.3