From 40b4994797a797b1fa86cafda789a5c488730c6d Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 28 Oct 2018 17:57:58 +0100
Subject: Delete payment

---
 client/src/Component/Modal.hs | 33 ++++++++++++++++++++++-----------
 1 file changed, 22 insertions(+), 11 deletions(-)

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

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")
+    ]
-- 
cgit v1.2.3