From fb8f0fe577e28dae69903413b761da50586e0099 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 14:53:41 +0200
Subject: Remove payment category if unused after a payment is deleted

---
 client/src/View/Payment/Add.hs    |  3 +--
 client/src/View/Payment/Delete.hs | 35 ++++++++++++++++++-----------------
 client/src/View/Payment/Table.hs  | 12 +++++-------
 3 files changed, 24 insertions(+), 26 deletions(-)

(limited to 'client/src/View/Payment')

diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index e0772f7..bd10e5a 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -23,7 +23,6 @@ import           Common.Model              (Category (..), CategoryId,
                                             CreatedPayment (..), Frequency (..),
                                             Payment (..), PaymentCategory (..))
 import qualified Common.Msg                as Msg
-import qualified Common.Util.Text          as Text
 import qualified Common.Util.Time          as Time
 import qualified Common.Validation.Payment as PaymentValidation
 import           Component                 (ButtonIn (..), InputIn (..),
@@ -168,4 +167,4 @@ view addIn = do
 findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
 findCategory paymentName =
   fmap _paymentCategory_category
-    . L.find ((==) (Text.formatSearch paymentName) . _paymentCategory_name)
+    . L.find ((==) (T.toLower paymentName) . _paymentCategory_name)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 4aa10f3..65ce660 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -4,26 +4,26 @@ module View.Payment.Delete
   , DeleteOut(..)
   ) where
 
-import           Data.Text            (Text)
-import qualified Data.Text            as T
-import           Reflex.Dom           (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom           as R
-
-import           Common.Model.Payment (PaymentId)
-import qualified Common.Msg           as Msg
-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           Data.Text    (Text)
+import qualified Data.Text    as T
+import           Reflex.Dom   (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom   as R
+
+import           Common.Model (Payment (..))
+import qualified Common.Msg   as Msg
+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
 
 data DeleteIn t = DeleteIn
-  { _deleteIn_id :: Dynamic t PaymentId
+  { _deleteIn_payment :: Dynamic t Payment
   }
 
 data DeleteOut t = DeleteOut
   { _deleteOut_cancel   :: Event t ()
-  , _deleteOut_validate :: Event t PaymentId
+  , _deleteOut_validate :: Event t Payment
   }
 
 view :: forall t m. MonadWidget t m => (DeleteIn t) -> m (DeleteOut t)
@@ -47,8 +47,9 @@ view deleteIn =
               , _buttonIn_waiting = waiting
               })
 
-          let url = flip fmap (_deleteIn_id deleteIn) (\id ->
-                  T.concat ["/payment/", T.pack . show $ id]
+          let url =
+                R.ffor (_deleteIn_payment deleteIn) (\id ->
+                  T.concat ["/payment/", T.pack . show $ _payment_id id]
                 )
 
           (result, waiting) <- WaitFor.waitFor
@@ -59,5 +60,5 @@ view deleteIn =
 
       return DeleteOut
         { _deleteOut_cancel = cancel
-        , _deleteOut_validate = R.tag (R.current $ _deleteIn_id deleteIn) deletedPayment
+        , _deleteOut_validate = R.tag (R.current $ _deleteIn_payment deleteIn) deletedPayment
         }
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index cdc4bb3..b09f30f 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -13,11 +13,9 @@ import           Reflex.Dom          (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom          as R
 
 import           Common.Model        (Category (..), Init (..), Payment (..),
-                                      PaymentCategory (..), PaymentId,
-                                      User (..))
+                                      PaymentCategory (..), User (..))
 import qualified Common.Model        as CM
 import qualified Common.Msg          as Msg
-import qualified Common.Util.Text    as T
 import qualified Common.View.Format  as Format
 import           Component           (ButtonIn (..), ButtonOut (..),
                                       ModalIn (..), ModalOut (..))
@@ -37,7 +35,7 @@ data TableIn t = TableIn
   }
 
 data TableOut t = TableOut
-  { _tableOut_deletePayment :: Event t PaymentId
+  { _tableOut_deletePayment :: Event t Payment
   }
 
 widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
@@ -84,7 +82,7 @@ paymentRow
   => Init
   -> Dynamic t [PaymentCategory]
   -> Dynamic t Payment
-  -> m (Event t PaymentId)
+  -> m (Event t Payment)
 paymentRow init paymentCategories payment =
   R.divClass "row" $ do
 
@@ -151,13 +149,13 @@ paymentRow init paymentCategories payment =
             [ _deleteOut_cancel . _modalOut_content $ modalOut
             , fmap (const ()) . _deleteOut_validate . _modalOut_content $ modalOut
             ]
-        , _modalIn_content = Delete.view (DeleteIn { _deleteIn_id = fmap _payment_id payment })
+        , _modalIn_content = Delete.view (DeleteIn { _deleteIn_payment = payment })
         }
     return (_deleteOut_validate . _modalOut_content $ modalOut)
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
   paymentCategory <- L.find
-    ((== T.formatSearch paymentName) . _paymentCategory_name)
+    ((== T.toLower paymentName) . _paymentCategory_name)
     paymentCategories
   L.find ((== (_paymentCategory_category paymentCategory)) . _category_id) categories
-- 
cgit v1.2.3