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.hs | 49 +++++++++++++++++++++++++++------------ client/src/View/Payment/Add.hs | 3 +-- client/src/View/Payment/Delete.hs | 35 ++++++++++++++-------------- client/src/View/Payment/Table.hs | 12 ++++------ 4 files changed, 58 insertions(+), 41 deletions(-) (limited to 'client') diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs index 915cc18..46ab642 100644 --- a/client/src/View/Payment.hs +++ b/client/src/View/Payment.hs @@ -45,18 +45,14 @@ widget paymentIn = do paymentCategories <- getPaymentCategories (_init_paymentCategories init) (_createdPayment_paymentCategory <$> _headerOut_addPayment header) + payments + (_tableOut_deletePayment table) - let searchPayments = - getSearchPayments - debouncedSearchName - (_headerOut_searchFrequency header) - payments - - debouncedSearchNameEvt <- - R.debounce (0.5 :: NominalDiffTime) (R.updated $ _headerOut_searchName header) + (searchNameEvent, searchName) <- + debounceSearchName (_headerOut_searchName header) - debouncedSearchName <- - R.holdDyn "" debouncedSearchNameEvt + let searchPayments = + getSearchPayments searchName (_headerOut_searchFrequency header) payments header <- Header.widget $ HeaderIn { _headerIn_init = init @@ -77,34 +73,57 @@ widget paymentIn = do { _pagesIn_total = length <$> searchPayments , _pagesIn_perPage = paymentsPerPage , _pagesIn_reset = R.leftmost $ - [ const () <$> debouncedSearchNameEvt + [ const () <$> searchNameEvent , const () <$> _headerOut_addPayment header ] } pure $ PaymentOut {} +debounceSearchName + :: forall t m. MonadWidget t m + => Dynamic t Text + -> m (Event t Text, Dynamic t Text) +debounceSearchName searchName = do + event <- R.debounce (0.5 :: NominalDiffTime) (R.updated searchName) + dynamic <- R.holdDyn "" event + return (event, dynamic) + getPayments :: forall t m. MonadWidget t m => [Payment] -> Event t Payment - -> Event t PaymentId + -> Event t Payment -> m (Dynamic t [Payment]) getPayments initPayments addPayment deletePayment = R.foldDyn id initPayments $ R.leftmost [ (:) <$> addPayment - , flip fmap deletePayment (\paymentId -> filter ((/= paymentId) . _payment_id)) + , R.ffor deletePayment (\p -> filter ((/= (_payment_id p)) . _payment_id)) ] getPaymentCategories :: forall t m. MonadWidget t m => [PaymentCategory] - -> Event t PaymentCategory + -> Event t PaymentCategory -- add payment category + -> Dynamic t [Payment] -- payments + -> Event t Payment -- delete payment -> m (Dynamic t [PaymentCategory]) -getPaymentCategories initPaymentCategories addPaymentCategory = +getPaymentCategories initPaymentCategories addPaymentCategory payments deletePayment = R.foldDyn id initPaymentCategories $ R.leftmost [ (:) <$> addPaymentCategory + , R.ffor deletePaymentName (\name -> filter ((/=) (T.toLower name) . _paymentCategory_name)) ] + where + deletePaymentName = + R.attachWithMaybe + (\ps p -> + if any (\p2 -> _payment_id p2 /= _payment_id p && lowerName p2 == lowerName p) ps then + Nothing + else + Just (_payment_name p)) + (R.current payments) + deletePayment + lowerName = T.toLower . _payment_name getSearchPayments :: forall t. Reflex t 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