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/Form.hs   |  2 +-
 client/src/Component/Modal.hs  | 33 ++++++++++++++++++++++-----------
 client/src/Component/Select.hs |  2 +-
 3 files changed, 24 insertions(+), 13 deletions(-)

(limited to 'client/src/Component')

diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs
index 0a89c6e..6ea02fa 100644
--- a/client/src/Component/Form.hs
+++ b/client/src/Component/Form.hs
@@ -6,7 +6,7 @@ import qualified Data.Map   as M
 import           Reflex.Dom (MonadWidget)
 import qualified Reflex.Dom as R
 
-form :: forall t m a. (MonadWidget t m) => m a -> m a
+form :: forall t m a. MonadWidget t m => m a -> m a
 form content =
   R.elAttr "form" (M.singleton "onsubmit" "event.preventDefault()") $
     content
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")
+    ]
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 876548e..17a4958 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -19,7 +19,7 @@ data SelectOut t a = SelectOut
   { _selectOut_value :: Dynamic t a
   }
 
-select :: forall t m a. (Ord a) => MonadWidget t m => SelectIn t a -> m (SelectOut t a)
+select :: forall t m a. (Ord a, MonadWidget t m) => SelectIn t a -> m (SelectOut t a)
 select selectIn =
   R.divClass "selectInput" $ do
     R.el "label" $ R.text (_selectIn_label selectIn)
-- 
cgit v1.2.3