aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Component')
-rw-r--r--client/src/Component/Button.hs41
-rw-r--r--client/src/Component/Form.hs12
-rw-r--r--client/src/Component/Input.hs27
-rw-r--r--client/src/Component/Modal.hs24
-rw-r--r--client/src/Component/Select.hs32
5 files changed, 107 insertions, 29 deletions
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
+ }
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 03:05:26 +0000