diff options
Diffstat (limited to 'client/src/Component')
-rw-r--r-- | client/src/Component/Button.hs | 4 | ||||
-rw-r--r-- | client/src/Component/Modal.hs | 38 |
2 files changed, 40 insertions, 2 deletions
diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs index 754b903..3ee9561 100644 --- a/client/src/Component/Button.hs +++ b/client/src/Component/Button.hs @@ -1,8 +1,8 @@ module Component.Button ( ButtonIn(..) - , buttonInDefault , ButtonOut(..) , button + , buttonInDefault ) where import qualified Data.Map as M @@ -19,7 +19,7 @@ data ButtonIn t m = ButtonIn , _buttonIn_waiting :: Event t Bool } -buttonInDefault :: forall t m. MonadWidget t m => ButtonIn t m +buttonInDefault :: forall t m. (MonadWidget t m) => ButtonIn t m buttonInDefault = ButtonIn { _buttonIn_class = R.constDyn "" , _buttonIn_content = R.blank diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs new file mode 100644 index 0000000..bfb5e02 --- /dev/null +++ b/client/src/Component/Modal.hs @@ -0,0 +1,38 @@ +{-# 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 + +data ModalIn t m = ModalIn + { _modalIn_show :: Event t () + , _modalIn_content :: m () + } + +data ModalOut = ModalOut {} + +modal :: forall t m. MonadWidget t m => ModalIn t m -> m ModalOut +modal modalIn = do + rec + showModal <- R.holdDyn False $ R.leftmost + [ True <$ _modalIn_show modalIn + , False <$ curtainClick + ] + + let attr = flip fmap showModal (\s -> M.fromList $ + [ ("style", if s then "display:block" else "display:none") + , ("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 + + return $ ModalOut {} |