aboutsummaryrefslogtreecommitdiff
path: root/client
diff options
context:
space:
mode:
Diffstat (limited to 'client')
-rw-r--r--client/src/View/Payment.hs49
-rw-r--r--client/src/View/Payment/Add.hs3
-rw-r--r--client/src/View/Payment/Delete.hs35
-rw-r--r--client/src/View/Payment/Table.hs12
4 files changed, 58 insertions, 41 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 21:40:51 +0000