From 50fb8fa48d1c4881da20b4ecf6d68a772301e713 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 30 Oct 2018 18:04:58 +0100
Subject: Update table when adding or removing a payment

---
 client/src/View/Payment/Add.hs | 39 +++++++++++++++++++++++++--------------
 1 file changed, 25 insertions(+), 14 deletions(-)

(limited to 'client/src/View/Payment/Add.hs')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 8b1b56e..602f7f3 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -10,12 +10,12 @@ import qualified Data.Maybe             as Maybe
 import qualified Data.Text              as T
 import qualified Data.Time.Calendar     as Calendar
 import qualified Data.Time.Clock        as Time
-import           Reflex.Dom             (Event, MonadWidget)
+import           Reflex.Dom             (Event, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
 import qualified Text.Read              as T
 
 import           Common.Model           (Category (..), CreatePayment (..),
-                                         Frequency (..))
+                                         Frequency (..), Payment (..))
 import qualified Common.Msg             as Msg
 import qualified Common.Util.Time       as Time
 import           Component              (ButtonIn (..), InputIn (..),
@@ -23,48 +23,56 @@ import           Component              (ButtonIn (..), InputIn (..),
                                          SelectOut (..))
 import qualified Component              as Component
 import qualified Util.Ajax              as Ajax
+import qualified Util.Either            as EitherUtil
 import qualified Util.WaitFor           as WaitFor
 
-data AddIn = AddIn
+data AddIn t = AddIn
   { _addIn_categories :: [Category]
+  , _addIn_show       :: Event t ()
   }
 
 data AddOut t = AddOut
-  { _addOut_cancel :: Event t ()
+  { _addOut_cancel       :: Event t ()
+  , _addOut_addedPayment :: Event t Payment
   }
 
-view :: forall t m. MonadWidget t m => AddIn -> m (AddOut t)
+view :: forall t m. MonadWidget t m => AddIn t -> m (AddOut t)
 view addIn = do
   R.divClass "add" $ do
     R.divClass "addHeader" $ R.text $ Msg.get Msg.Payment_Add
 
     R.divClass "addContent" $ do
-      name <- _inputOut_value <$> (Component.input $
-        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+      name <- _inputOut_value <$> (Component.input
+        (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name })
+        (_addIn_show addIn))
 
-      cost <- _inputOut_value <$> (Component.input $
-        Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+      cost <- _inputOut_value <$> (Component.input
+        (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost })
+        (_addIn_show addIn))
 
       currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay
 
-      date <- _inputOut_value <$> (Component.input $
-        Component.defaultInputIn
+      date <- _inputOut_value <$> (Component.input
+        (Component.defaultInputIn
           { _inputIn_label = Msg.get Msg.Payment_Date
           , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay
           , _inputIn_inputType = "date"
           , _inputIn_hasResetButton = False
           })
+        (_addIn_show addIn))
 
       frequency <- _selectOut_value <$> (Component.select $ SelectIn
         { _selectIn_label = Msg.get Msg.Payment_Frequency
         , _selectIn_initialValue = Punctual
         , _selectIn_values = R.constDyn frequencies
+        , _selectIn_reset = _addIn_show addIn
         })
 
       category <- _selectOut_value <$> (Component.select $ SelectIn
         { _selectIn_label = Msg.get Msg.Payment_Category
         , _selectIn_initialValue = 0
         , _selectIn_values = R.constDyn categories
+        , _selectIn_reset = _addIn_show addIn
         })
 
       let payment = CreatePayment
@@ -74,7 +82,7 @@ view addIn = do
             <*> category
             <*> frequency
 
-      cancel <- R.divClass "buttons" $ do
+      (addedPayment, cancel) <- R.divClass "buttons" $ do
         rec
           validate <- Component._buttonOut_clic <$> (Component.button $
             (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
@@ -83,17 +91,20 @@ view addIn = do
               , _buttonIn_submit = True
               })
 
-          (_, waiting) <- WaitFor.waitFor
+          (result, waiting) <- WaitFor.waitFor
             (Ajax.postJson "/payment")
             validate
             payment
 
-        Component._buttonOut_clic <$> (Component.button $
+        cancel <- Component._buttonOut_clic <$> (Component.button $
           (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
             { _buttonIn_class = R.constDyn "undo" })
 
+        return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)
+
       return AddOut
         { _addOut_cancel = cancel
+        , _addOut_addedPayment = addedPayment
         }
 
   where
-- 
cgit v1.2.3