aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Component')
-rw-r--r--client/src/Component/Form.hs2
-rw-r--r--client/src/Component/Modal.hs33
-rw-r--r--client/src/Component/Select.hs2
3 files changed, 24 insertions, 13 deletions
diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs
index 0a89c6e..6ea02fa 100644
--- a/client/src/Component/Form.hs
+++ b/client/src/Component/Form.hs
@@ -6,7 +6,7 @@ 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 :: 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/Modal.hs b/client/src/Component/Modal.hs
index 1d70c90..72091c9 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -1,14 +1,19 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
module Component.Modal
( ModalIn(..)
, ModalOut(..)
, modal
) where
-import qualified Data.Map as M
-import Reflex.Dom (Event, MonadWidget)
-import qualified Reflex.Dom 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.Node as Node
+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
data ModalIn t m a = ModalIn
{ _modalIn_show :: Event t ()
@@ -29,16 +34,22 @@ modal modalIn = do
, False <$ curtainClick
]
- let attr = flip fmap showModal (\s -> M.fromList $
- [ ("style", if s then "display:block" else "display:none")
- , ("class", "modal")
- ])
-
- (curtainClick, content) <- R.elDynAttr "div" attr $ do
+ (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)
+ body <- Dom.getBody
+ let moveBackdrop = (const $ (Node.appendChild body elem)) `fmap` (_modalIn_show modalIn)
+ R.performEvent_ $ void `fmap` moveBackdrop
+
return $ ModalOut
{ _modalOut_content = content
}
+
+getAttributes :: Bool -> LM.Map Text Text
+getAttributes show =
+ M.fromList $
+ [ ("style", if show then "display:block" else "display:none")
+ , ("class", "modal")
+ ]
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 876548e..17a4958 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -19,7 +19,7 @@ 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 :: 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)