From 2d79ab0e0a11f55255fc21a5dfab1598d3beeba3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 11 Aug 2019 22:40:09 +0200
Subject: Add payment clone

---
 client/src/Component/Modal.hs | 63 ++++++++++++++++++++++++-------------------
 1 file changed, 36 insertions(+), 27 deletions(-)

(limited to 'client/src/Component/Modal.hs')

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
-- 
cgit v1.2.3