aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Component')
-rw-r--r--client/src/Component/Modal.hs63
1 files changed, 36 insertions, 27 deletions
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index fac417e..96c2679 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -1,7 +1,7 @@
module Component.Modal
- ( ModalIn(..)
- , ModalOut(..)
- , modal
+ ( Input(..)
+ , Content
+ , view
) where
import Control.Monad (void)
@@ -17,29 +17,26 @@ 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.Reflex as ReflexUtil
-data ModalIn t m a = ModalIn
- { _modalIn_show :: Event t ()
- , _modalIn_hide :: Event t ()
- , _modalIn_content :: m a
- }
+-- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
+type Content t m a = Event t () -> m (Event t (), Event t a)
-data ModalOut t a = ModalOut
- { _modalOut_content :: a
- , _modalOut_hide :: Event t ()
+data Input t m a = Input
+ { _input_show :: Event t ()
+ , _input_content :: Content t m a
}
-modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut t a)
-modal modalIn = do
+view :: forall t m a. MonadWidget t m => Input t m a -> m (Event t a)
+view input = do
rec
- let show = Show <$ (_modalIn_show modalIn)
+ let show = Show <$ (_input_show input)
startHiding =
R.attachWithMaybe
(\a _ -> if a then Just StartHiding else Nothing)
(R.current canBeHidden)
- (R.leftmost [ _modalIn_hide modalIn, curtainClick ])
+ (R.leftmost [ hide, curtainClick ])
canBeHidden <-
R.holdDyn True $ R.leftmost
@@ -56,18 +53,25 @@ modal modalIn = do
modalClass <-
R.holdDyn "" (fmap getModalClass action)
- (elem, (curtainClick, content)) <-
- R.buildElement "div" (fmap getAttributes modalClass) $ do
- (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
- content <- R.divClass "g-Modal__Content" $ _modalIn_content modalIn
- return (R.domEvent R.Click curtain, content)
+ (elem, dyn) <-
+ R.buildElement "div" (getAttributes <$> modalClass) $
+ ReflexUtil.visibleIfEvent
+ (isVisible <$> action)
+ (R.blank >> return (R.never, R.never, R.never))
+ (do
+ (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
+ let curtainClick = R.domEvent R.Click curtain
+ (hide, content) <- R.divClass "g-Modal__Content" (_input_content input curtainClick)
+ return (curtainClick, hide, content))
+
- performShowEffects action elem
+ performShowEffects action elem
- return $ ModalOut
- { _modalOut_content = content
- , _modalOut_hide = curtainClick
- }
+ let curtainClick = R.switchDyn $ (\(a, _, _) -> a) <$> dyn
+ let hide = R.switchDyn $ (\(_, b, _) -> b) <$> dyn
+ let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
+
+ return content
getAttributes :: Text -> LM.Map Text Text
getAttributes modalClass =
@@ -80,7 +84,7 @@ performShowEffects
-> Element.Element
-> m ()
performShowEffects showEvent elem = do
- body <- Dom.getBody
+ body <- ReflexUtil.getBody
let showEffects =
flip fmap showEvent (\case
@@ -105,3 +109,8 @@ getModalClass :: Action -> Text
getModalClass Show = "g-Modal--Show"
getModalClass StartHiding = "g-Modal--Hiding"
getModalClass _ = ""
+
+isVisible :: Action -> Bool
+isVisible Show = True
+isVisible StartHiding = True
+isVisible EndHiding = False