aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment.hs
diff options
context:
space:
mode:
authorJoris2019-10-13 22:38:35 +0200
committerJoris2019-10-13 22:38:35 +0200
commit04c59f08f100ba6a0658d1f2b357f7d8b1e14218 (patch)
tree0cf226423411428e46b2fa6a66c0da00d77483be /client/src/View/Payment.hs
parent6dfc1c166db387a60630eff980e330518601df5b (diff)
downloadbudget-04c59f08f100ba6a0658d1f2b357f7d8b1e14218.tar.gz
budget-04c59f08f100ba6a0658d1f2b357f7d8b1e14218.tar.bz2
budget-04c59f08f100ba6a0658d1f2b357f7d8b1e14218.zip
Show income table
Diffstat (limited to 'client/src/View/Payment.hs')
-rw-r--r--client/src/View/Payment.hs154
1 files changed, 0 insertions, 154 deletions
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
deleted file mode 100644
index 1072a5e..0000000
--- a/client/src/View/Payment.hs
+++ /dev/null
@@ -1,154 +0,0 @@
-module View.Payment
- ( widget
- , PaymentIn(..)
- ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.Clock (NominalDiffTime)
-import Prelude hiding (init)
-import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom as R
-
-import Common.Model (Frequency, Init (..), Payment (..),
- PaymentCategory (..), PaymentId,
- SavedPayment (..))
-import qualified Common.Util.Text as T
-import View.Payment.Header (HeaderIn (..), HeaderOut (..))
-import qualified View.Payment.Header as Header
-import View.Payment.Pages (PagesIn (..), PagesOut (..))
-import qualified View.Payment.Pages as Pages
-import View.Payment.Table (TableIn (..), TableOut (..))
-import qualified View.Payment.Table as Table
-
-data PaymentIn = PaymentIn
- { _paymentIn_init :: Init
- }
-
-widget :: forall t m. MonadWidget t m => PaymentIn -> m ()
-widget paymentIn = do
- R.elClass "main" "payment" $ do
- rec
- let init = _paymentIn_init paymentIn
-
- paymentsPerPage = 7
-
- addPayment = R.leftmost
- [ _headerOut_addPayment header
- , _tableOut_addPayment table
- ]
-
- payments <- reducePayments
- (_init_payments init)
- (_savedPayment_payment <$> addPayment)
- (_savedPayment_payment <$> _tableOut_editPayment table)
- (_tableOut_deletePayment table)
-
- paymentCategories <- reducePaymentCategories
- (_init_paymentCategories init)
- payments
- (_savedPayment_paymentCategory <$> addPayment)
- (_savedPayment_paymentCategory <$> _tableOut_editPayment table)
- (_tableOut_deletePayment table)
-
- (searchNameEvent, searchName) <-
- debounceSearchName (_headerOut_searchName header)
-
- let searchPayments =
- getSearchPayments searchName (_headerOut_searchFrequency header) payments
-
- header <- Header.widget $ HeaderIn
- { _headerIn_init = init
- , _headerIn_payments = payments
- , _headerIn_searchPayments = searchPayments
- , _headerIn_paymentCategories = paymentCategories
- }
-
- table <- Table.widget $ TableIn
- { _tableIn_init = init
- , _tableIn_currentPage = _pagesOut_currentPage pages
- , _tableIn_payments = searchPayments
- , _tableIn_perPage = paymentsPerPage
- , _tableIn_paymentCategories = paymentCategories
- }
-
- pages <- Pages.widget $ PagesIn
- { _pagesIn_total = length <$> searchPayments
- , _pagesIn_perPage = paymentsPerPage
- , _pagesIn_reset = R.leftmost $
- [ () <$ searchNameEvent
- , () <$ _headerOut_addPayment header
- ]
- }
-
- pure ()
-
-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)
-
-reducePayments
- :: forall t m. MonadWidget t m
- => [Payment]
- -> Event t Payment -- add payment
- -> Event t Payment -- edit payment
- -> Event t Payment -- delete payment
- -> m (Dynamic t [Payment])
-reducePayments initPayments addPayment editPayment deletePayment =
- R.foldDyn id initPayments $ R.leftmost
- [ (:) <$> addPayment
- , R.ffor editPayment (\p -> (p:) . filter ((/= (_payment_id p)) . _payment_id))
- , R.ffor deletePayment (\p -> filter ((/= (_payment_id p)) . _payment_id))
- ]
-
-reducePaymentCategories
- :: forall t m. MonadWidget t m
- => [PaymentCategory]
- -> Dynamic t [Payment] -- payments
- -> Event t PaymentCategory -- add payment category
- -> Event t PaymentCategory -- edit payment category
- -> Event t Payment -- delete payment
- -> m (Dynamic t [PaymentCategory])
-reducePaymentCategories
- initPaymentCategories
- payments
- addPaymentCategory
- editPaymentCategory
- deletePayment
- =
- R.foldDyn id initPaymentCategories $ R.leftmost
- [ (:) <$> addPaymentCategory
- , R.ffor editPaymentCategory (\pc -> (pc:) . filter ((/= (_paymentCategory_name pc)) . _paymentCategory_name))
- , 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
- => Dynamic t Text
- -> Dynamic t Frequency
- -> Dynamic t [Payment]
- -> Dynamic t [Payment]
-getSearchPayments name frequency payments = do
- n <- name
- f <- frequency
- ps <- payments
- pure $ flip filter ps (\p ->
- ( (T.search n (_payment_name p) || T.search n (T.pack . show . _payment_cost $ p))
- && (_payment_frequency p == f)
- ))