aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View/Payment')
-rw-r--r--client/src/View/Payment/Form.hs4
-rw-r--r--client/src/View/Payment/Header.hs6
-rw-r--r--client/src/View/Payment/Init.hs13
-rw-r--r--client/src/View/Payment/Payment.hs165
-rw-r--r--client/src/View/Payment/Table.hs21
5 files changed, 136 insertions, 73 deletions
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 7819836..c817831 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -165,8 +165,8 @@ view input = do
ajax =
case _input_httpMethod input of
- Post -> Ajax.postJson
- Put -> Ajax.putJson
+ Post -> Ajax.post
+ Put -> Ajax.put
findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
findCategory paymentName =
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 9db4c7c..9ad90a9 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -20,7 +20,7 @@ import qualified Reflex.Dom as R
import Common.Model (Category, Currency,
ExceedingPayer (..), Frequency (..),
- Income (..), Init (..), Payment (..),
+ Income (..), Payment (..),
PaymentCategory, SavedPayment (..),
User (..))
import qualified Common.Model as CM
@@ -34,9 +34,11 @@ import qualified Component as Component
import qualified Component.Modal as Modal
import qualified Util.List as L
import qualified View.Payment.Add as Add
+import View.Payment.Init (Init (..))
data HeaderIn t = HeaderIn
{ _headerIn_init :: Init
+ , _headerIn_currency :: Currency
, _headerIn_payments :: Dynamic t [Payment]
, _headerIn_searchPayments :: Dynamic t [Payment]
, _headerIn_paymentCategories :: Dynamic t [PaymentCategory]
@@ -78,7 +80,7 @@ widget headerIn =
payments = _headerIn_payments headerIn
users = _init_users init
categories = _init_categories init
- currency = _init_currency init
+ currency = _headerIn_currency headerIn
paymentCategories = _headerIn_paymentCategories headerIn
payerAndAdd
diff --git a/client/src/View/Payment/Init.hs b/client/src/View/Payment/Init.hs
new file mode 100644
index 0000000..d9f85c8
--- /dev/null
+++ b/client/src/View/Payment/Init.hs
@@ -0,0 +1,13 @@
+module View.Payment.Init
+ ( Init(..)
+ ) where
+
+import Common.Model (Category, Income, Payment, PaymentCategory, User)
+
+data Init = Init
+ { _init_users :: [User]
+ , _init_payments :: [Payment]
+ , _init_incomes :: [Income]
+ , _init_categories :: [Category]
+ , _init_paymentCategories :: [PaymentCategory]
+ } deriving (Show)
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index cfdb441..ec350e2 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -1,5 +1,6 @@
module View.Payment.Payment
- ( view
+ ( init
+ , view
, PaymentIn(..)
) where
@@ -10,78 +11,118 @@ 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 Common.Model (Currency, Frequency, Income (..),
+ Payment (..), PaymentCategory (..),
+ PaymentId, SavedPayment (..), User,
+ UserId)
import qualified Common.Util.Text as T
+
+import Model.Loadable (Loadable (..))
+import qualified Model.Loadable as Loadable
+import qualified Util.Ajax as AjaxUtil
import View.Payment.Header (HeaderIn (..), HeaderOut (..))
import qualified View.Payment.Header as Header
+import View.Payment.Init (Init (..))
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
+init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
+init = do
+ postBuild <- R.getPostBuild
+
+ incomesEvent <- AjaxUtil.get (R.tag (R.constant "api/incomes") postBuild)
+ incomes <- Loadable.fromEvent incomesEvent
+
+ usersEvent <- AjaxUtil.get (R.tag (R.constant "api/users") postBuild)
+ users <- Loadable.fromEvent usersEvent
+
+ paymentsEvent <- AjaxUtil.get (R.tag (R.constant "api/payments") postBuild)
+ payments <- Loadable.fromEvent paymentsEvent
+
+ paymentCategoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/paymentCategories") postBuild)
+ paymentCategories <- Loadable.fromEvent paymentCategoriesEvent
+
+ categoriesEvent <- AjaxUtil.get (R.tag (R.constant "api/categories") postBuild)
+ categories <- Loadable.fromEvent categoriesEvent
+
+ return $ do
+ us <- users
+ ps <- payments
+ is <- incomes
+ cs <- categories
+ pcs <- paymentCategories
+ return $ Init <$> us <*> ps <*> is <*> cs <*> pcs
+
+data PaymentIn t = PaymentIn
+ { _paymentIn_currentUser :: UserId
+ , _paymentIn_currency :: Currency
+ , _paymentIn_init :: Dynamic t (Loadable Init)
}
-view :: forall t m. MonadWidget t m => PaymentIn -> m ()
+view :: forall t m. MonadWidget t m => PaymentIn t -> m ()
view 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 ()
+ R.dyn . R.ffor (_paymentIn_init paymentIn) . Loadable.view $ \init ->
+
+ R.elClass "main" "payment" $ do
+ rec
+ let addPayment = R.leftmost
+ [ _headerOut_addPayment header
+ , _tableOut_addPayment table
+ ]
+
+ paymentsPerPage = 7
+
+ 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_currency = _paymentIn_currency paymentIn
+ , _headerIn_payments = payments
+ , _headerIn_searchPayments = searchPayments
+ , _headerIn_paymentCategories = paymentCategories
+ }
+
+ table <- Table.widget $ TableIn
+ { _tableIn_init = init
+ , _tableIn_currency = _paymentIn_currency paymentIn
+ , _tableIn_currentUser = _paymentIn_currentUser paymentIn
+ , _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 ()
+
+ return ()
debounceSearchName
:: forall t m. MonadWidget t m
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index bf6b604..5ffa037 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -13,10 +13,10 @@ import Prelude hiding (init)
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Category (..), Frequency (Punctual),
- Init (..), Payment (..),
+import Common.Model (Category (..), Currency,
+ Frequency (Punctual), Payment (..),
PaymentCategory (..), SavedPayment,
- User (..))
+ User (..), UserId)
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
@@ -26,12 +26,15 @@ import qualified Component.Modal as Modal
import qualified View.Payment.Clone as Clone
import qualified View.Payment.Delete as Delete
import qualified View.Payment.Edit as Edit
+import View.Payment.Init (Init (..))
import qualified Icon
import qualified Util.Reflex as ReflexUtil
data TableIn t = TableIn
{ _tableIn_init :: Init
+ , _tableIn_currency :: Currency
+ , _tableIn_currentUser :: UserId
, _tableIn_currentPage :: Dynamic t Int
, _tableIn_payments :: Dynamic t [Payment]
, _tableIn_perPage :: Int
@@ -61,7 +64,7 @@ widget tableIn = do
R.divClass "cell" $ R.blank
result <-
- (R.simpleList paymentRange (paymentRow init paymentCategories))
+ (R.simpleList paymentRange (paymentRow init currency currentUser paymentCategories))
return $
( R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
@@ -80,6 +83,8 @@ widget tableIn = do
where
init = _tableIn_init tableIn
+ currency = _tableIn_currency tableIn
+ currentUser = _tableIn_currentUser tableIn
currentPage = _tableIn_currentPage tableIn
payments = _tableIn_payments tableIn
paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
@@ -96,17 +101,19 @@ getPaymentRange perPage payments currentPage =
paymentRow
:: forall t m. MonadWidget t m
=> Init
+ -> Currency
+ -> UserId
-> Dynamic t [PaymentCategory]
-> Dynamic t Payment
-> m (Event t SavedPayment, Event t SavedPayment, Event t Payment)
-paymentRow init paymentCategories payment =
+paymentRow init currency currentUser paymentCategories payment =
R.divClass "row" $ do
R.divClass "cell name" $
R.dynText $ fmap _payment_name payment
R.divClass "cell cost" $
- R.dynText $ fmap (Format.price (_init_currency init) . _payment_cost) payment
+ R.dynText $ fmap (Format.price currency . _payment_cost) payment
let user = R.ffor payment (\p ->
CM.findUser (_payment_user p) (_init_users init))
@@ -162,7 +169,7 @@ paymentRow init paymentCategories payment =
let isFromCurrentUser =
R.ffor
payment
- (\p -> _payment_user p == _init_currentUser init)
+ (\p -> _payment_user p == currentUser)
editPayment <-
R.divClass "cell button" $
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 08:56:36 +0000