diff options
Diffstat (limited to 'client/src/Component')
-rw-r--r-- | client/src/Component/Form.hs | 2 | ||||
-rw-r--r-- | client/src/Component/Modal.hs | 33 | ||||
-rw-r--r-- | client/src/Component/Select.hs | 2 |
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) |