From b5244184920b4d7a8d64eada2eca21e9a6ea2df9 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 30 Oct 2018 20:44:12 +0100
Subject: Use waitfor with delete confirm button

---
 client/src/Util/WaitFor.hs        |  9 ++++-----
 client/src/View/Payment/Add.hs    |  3 +--
 client/src/View/Payment/Delete.hs | 12 +++++-------
 client/src/View/SignIn.hs         |  3 +--
 4 files changed, 11 insertions(+), 16 deletions(-)

(limited to 'client')

diff --git a/client/src/Util/WaitFor.hs b/client/src/Util/WaitFor.hs
index 7d5e7c5..46882aa 100644
--- a/client/src/Util/WaitFor.hs
+++ b/client/src/Util/WaitFor.hs
@@ -9,10 +9,9 @@ import qualified Reflex.Dom as R
 waitFor
   :: forall t m a b. MonadWidget t m
   => (Event t a -> m (Event t b))
-  -> Event t ()
-  -> Dynamic t a
+  -> Event t a
   -> m (Event t b, Event t Bool)
-waitFor op start input = do
-  result <- op (R.tag (R.current input) start) >>= R.debounce (0.5 :: NominalDiffTime)
-  let waiting = R.leftmost [ const True <$> start , const False <$> result ]
+waitFor op input = do
+  result <- op input >>= R.debounce (0.2 :: NominalDiffTime)
+  let waiting = R.leftmost [ const True <$> input , const False <$> result ]
   return (result, waiting)
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 602f7f3..1864e76 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -93,8 +93,7 @@ view addIn = do
 
           (result, waiting) <- WaitFor.waitFor
             (Ajax.postJson "/payment")
-            validate
-            payment
+            (R.tag (R.current payment) validate)
 
         cancel <- Component._buttonOut_clic <$> (Component.button $
           (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 330ef9f..81c7c57 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -15,7 +15,7 @@ import           Component            (ButtonIn (..), ButtonOut (..))
 import qualified Component            as Component
 import qualified Util.Ajax            as Ajax
 import qualified Util.Either          as EitherUtil
--- import qualified Util.WaitFor           as WaitFor
+import qualified Util.WaitFor         as WaitFor
 
 data DeleteIn t = DeleteIn
   { _deleteIn_id :: Dynamic t PaymentId
@@ -39,18 +39,16 @@ view deleteIn =
             (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
               { _buttonIn_class = R.constDyn "confirm"
               , _buttonIn_submit = True
+              , _buttonIn_waiting = waiting
               })
 
           let url = flip fmap (_deleteIn_id deleteIn) (\id ->
                   T.concat ["/payment/", T.pack . show $ id]
                 )
 
-          result <- Ajax.delete url confirm
-
-          -- (_, waiting) <- WaitFor.waitFor
-          --   (Ajax.delete "/payment")
-          --   validate
-          --   payment
+          (result, waiting) <- WaitFor.waitFor
+            (Ajax.delete url)
+            confirm
 
         cancel <- Component._buttonOut_clic <$> (Component.button $
           (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index 7f53299..428997e 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -41,8 +41,7 @@ view signInMessage =
 
         (signInResult, waiting) <- WaitFor.waitFor
           (\email -> Ajax.postJson "/askSignIn" (SignIn <$> email))
-          (_buttonOut_clic button)
-          (_inputOut_value input)
+          (R.tag (R.current (_inputOut_value input)) (_buttonOut_clic button))
 
       showSignInResult signInMessage signInResult
 
-- 
cgit v1.2.3