From 04c59f08f100ba6a0658d1f2b357f7d8b1e14218 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 13 Oct 2019 22:38:35 +0200 Subject: Show income table --- client/src/View/Payment.hs | 154 --------------------------------------------- 1 file changed, 154 deletions(-) delete mode 100644 client/src/View/Payment.hs (limited to 'client/src/View/Payment.hs') 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) - )) -- cgit v1.2.3