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