aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Component')
-rw-r--r--client/src/Component/Input.hs20
-rw-r--r--client/src/Component/Modal.hs66
-rw-r--r--client/src/Component/Select.hs10
3 files changed, 64 insertions, 32 deletions
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index c1eb4e8..57018a6 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -16,18 +16,16 @@ import Component.Button (ButtonIn (..), ButtonOut (..))
import qualified Component.Button as Button
import qualified Icon
-data InputIn t a b = InputIn
- { _inputIn_reset :: Event t a
- , _inputIn_hasResetButton :: Bool
+data InputIn = InputIn
+ { _inputIn_hasResetButton :: Bool
, _inputIn_label :: Text
, _inputIn_initialValue :: Text
, _inputIn_inputType :: Text
}
-defaultInputIn :: (Reflex t) => InputIn t a b
+defaultInputIn :: InputIn
defaultInputIn = InputIn
- { _inputIn_reset = R.never
- , _inputIn_hasResetButton = True
+ { _inputIn_hasResetButton = True
, _inputIn_label = ""
, _inputIn_initialValue = ""
, _inputIn_inputType = "text"
@@ -38,12 +36,16 @@ data InputOut t = InputOut
, _inputOut_enter :: Event t ()
}
-input :: forall t m a b. MonadWidget t m => InputIn t a b -> m (InputOut t)
-input inputIn =
+input
+ :: forall t m a b. MonadWidget t m
+ => InputIn
+ -> Event t a -- reset
+ -> m (InputOut t)
+input inputIn reset =
R.divClass "textInput" $ do
rec
let resetValue = R.leftmost
- [ fmap (const "") (_inputIn_reset inputIn)
+ [ fmap (const "") reset
, fmap (const "") resetClic
]
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index 72091c9..b86fee0 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -4,16 +4,18 @@ module Component.Modal
, modal
) where
-import Control.Monad (void)
-import qualified Data.Map as M
-import qualified Data.Map.Lazy as LM
-import Data.Text (Text)
-import qualified GHCJS.DOM.Node as Node
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-import qualified Reflex.Dom.Class as R
+import Control.Monad (void)
+import qualified Data.Map as M
+import qualified Data.Map.Lazy as LM
+import Data.Text (Text)
+import qualified GHCJS.DOM.Element as Element
+import qualified GHCJS.DOM.Node as Node
+import JSDOM.Types (JSString)
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
+import qualified Reflex.Dom.Class as R
-import qualified Util.Dom as Dom
+import qualified Util.Dom as Dom
data ModalIn t m a = ModalIn
{ _modalIn_show :: Event t ()
@@ -28,20 +30,21 @@ data ModalOut a = 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
- ]
+ let showEvent = R.leftmost
+ [ True <$ _modalIn_show modalIn
+ , False <$ _modalIn_hide modalIn
+ , False <$ curtainClick
+ ]
- (elem, (curtainClick, content)) <- R.buildElement "div" (getAttributes <$> showModal) $ 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)
+ showModal <- R.holdDyn False showEvent
- body <- Dom.getBody
- let moveBackdrop = (const $ (Node.appendChild body elem)) `fmap` (_modalIn_show modalIn)
- R.performEvent_ $ void `fmap` moveBackdrop
+ (elem, (curtainClick, content)) <-
+ R.buildElement "div" (getAttributes <$> showModal) $ 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)
+
+ performShowEffects showEvent elem
return $ ModalOut
{ _modalOut_content = content
@@ -53,3 +56,24 @@ getAttributes show =
[ ("style", if show then "display:block" else "display:none")
, ("class", "modal")
]
+
+performShowEffects
+ :: forall t m a. MonadWidget t m
+ => Event t Bool
+ -> Element.Element
+ -> m ()
+performShowEffects showEvent elem = do
+ body <- Dom.getBody
+
+ let showEffects =
+ flip fmap showEvent (\show -> do
+ if show
+ then
+ do
+ Node.appendChild body elem
+ Element.setClassName body ("modal" :: JSString)
+ else
+ Element.setClassName body ("" :: JSString)
+ )
+
+ R.performEvent_ $ void `fmap` showEffects
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 17a4958..7cb6726 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -6,13 +6,14 @@ module Component.Select
import Data.Map (Map)
import Data.Text (Text)
-import Reflex.Dom (Dynamic, MonadWidget, Reflex)
+import Reflex.Dom (Dynamic, Event, 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)
+ , _selectIn_reset :: Event t ()
}
data SelectOut t a = SelectOut
@@ -24,8 +25,13 @@ select selectIn =
R.divClass "selectInput" $ do
R.el "label" $ R.text (_selectIn_label selectIn)
+ let initialValue = _selectIn_initialValue selectIn
+
value <- R._dropdown_value <$>
- R.dropdown (_selectIn_initialValue selectIn) (_selectIn_values selectIn) R.def
+ R.dropdown
+ initialValue
+ (_selectIn_values selectIn)
+ (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) })
return SelectOut
{ _selectOut_value = value