aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/App.hs16
-rw-r--r--client/src/View/Header.hs2
-rw-r--r--client/src/View/Income/Form.hs4
-rw-r--r--client/src/View/Income/Header.hs11
-rw-r--r--client/src/View/Income/Income.hs73
-rw-r--r--client/src/View/Income/Init.hs11
-rw-r--r--client/src/View/Income/Table.hs17
-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
-rw-r--r--client/src/View/SignIn.hs2
13 files changed, 232 insertions, 113 deletions
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index 3292336..b468e56 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -7,7 +7,8 @@ import Prelude hiding (error, init)
import Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Init, InitResult (..))
+import Common.Model (Currency, Init (..), InitResult (..),
+ UserId)
import qualified Common.Msg as Msg
import Model.Route (Route (..))
@@ -60,14 +61,19 @@ widget initResult =
signedWidget :: MonadWidget t m => Init -> Dynamic t Route -> m ()
signedWidget init route = do
R.dyn . R.ffor route $ \case
- RootRoute ->
+ RootRoute -> do
+ paymentInit <- Payment.init
Payment.view $ PaymentIn
- { _paymentIn_init = init
+ { _paymentIn_currentUser = _init_currentUser init
+ , _paymentIn_currency = _init_currency init
+ , _paymentIn_init = paymentInit
}
- IncomeRoute ->
+ IncomeRoute -> do
+ incomeInit <- Income.init
Income.view $ IncomeIn
- { _incomeIn_init = init
+ { _incomeIn_currency = _init_currency init
+ , _incomeIn_init = incomeInit
}
NotFoundRoute ->
diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs
index 9a4de89..bd69e47 100644
--- a/client/src/View/Header.hs
+++ b/client/src/View/Header.hs
@@ -73,7 +73,7 @@ links route = do
nameSignOut :: forall t m. MonadWidget t m => InitResult -> m (Event t ())
nameSignOut initResult = case initResult of
- (InitSuccess init) -> do
+ InitSuccess init -> do
rec
attr <- R.holdDyn
(M.singleton "class" "nameSignOut")
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
index b8a9094..2bfc23f 100644
--- a/client/src/View/Income/Form.hs
+++ b/client/src/View/Income/Form.hs
@@ -109,5 +109,5 @@ view formIn = do
where
ajax =
case _formIn_httpMethod formIn of
- Post -> Ajax.postJson
- Put -> Ajax.putJson
+ Post -> Ajax.post
+ Put -> Ajax.put
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index e384161..4e08955 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -11,19 +11,22 @@ import qualified Data.Time.Clock as Clock
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Income (..), Init (..), User (..))
+import Common.Model (Currency, Income (..), User (..))
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
+
import Component (ButtonOut (..))
import qualified Component
import qualified Component.Modal as Modal
import qualified Util.Date as DateUtil
import qualified View.Income.Add as Add
+import View.Income.Init (Init (..))
data HeaderIn t = HeaderIn
- { _headerIn_init :: Init
- , _headerIn_incomes :: Dynamic t [Income]
+ { _headerIn_init :: Init
+ , _headerIn_currency :: Currency
+ , _headerIn_incomes :: Dynamic t [Income]
}
data HeaderOut t = HeaderOut
@@ -55,7 +58,7 @@ view headerIn =
T.intercalate " "
[ _user_name user
, "−"
- , Format.price (_init_currency init) $
+ , Format.price (_headerIn_currency headerIn) $
CM.cumulativeIncomesSince currentTime since userIncomes
]
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index 167aedf..91682a0 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -1,40 +1,73 @@
module View.Income.Income
- ( view
+ ( init
+ , view
, IncomeIn(..)
) where
+import Prelude hiding (init)
import Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Init (..))
+import Common.Model (Currency)
+
+import Model.Loadable (Loadable (..))
+import qualified Model.Loadable as Loadable
+import qualified Util.Ajax as AjaxUtil
import View.Income.Header (HeaderIn (..), HeaderOut (..))
import qualified View.Income.Header as Header
+import View.Income.Init (Init (..))
import View.Income.Table (IncomeTableIn (..))
import qualified View.Income.Table as Table
-data IncomeIn = IncomeIn
- { _incomeIn_init :: Init
+data IncomeIn t = IncomeIn
+ { _incomeIn_currency :: Currency
+ , _incomeIn_init :: Dynamic t (Loadable Init)
}
-view :: forall t m. MonadWidget t m => IncomeIn -> m ()
-view incomeIn =
- R.elClass "main" "income" $ do
+init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
+init = do
+ postBuild <- R.getPostBuild
+
+ usersEvent <- AjaxUtil.get (R.tag (R.constant "api/users") postBuild)
+ users <- Loadable.fromEvent usersEvent
+
+ incomesEvent <- AjaxUtil.get (R.tag (R.constant "api/incomes") postBuild)
+ incomes <- Loadable.fromEvent incomesEvent
+
+ paymentsEvent <- AjaxUtil.get (R.tag (R.constant "api/payments") postBuild)
+ payments <- Loadable.fromEvent paymentsEvent
+
+ return $ do
+ us <- users
+ is <- incomes
+ ps <- payments
+ return $ Init <$> us <*> is <*> ps
+
+view :: forall t m. MonadWidget t m => IncomeIn t -> m ()
+view incomeIn = do
+ R.dyn . R.ffor (_incomeIn_init incomeIn) . Loadable.view $ \init ->
+
+ R.elClass "main" "income" $ do
+
+ rec
- rec
+ incomes <- R.foldDyn
+ (:)
+ (_init_incomes init)
+ (_headerOut_addIncome header)
- incomes <- R.foldDyn
- (:)
- (_init_incomes . _incomeIn_init $ incomeIn)
- (_headerOut_addIncome header)
+ header <- Header.view $ HeaderIn
+ { _headerIn_init = init
+ , _headerIn_currency = _incomeIn_currency incomeIn
+ , _headerIn_incomes = incomes
+ }
- header <- Header.view $ HeaderIn
- { _headerIn_init = _incomeIn_init incomeIn
- , _headerIn_incomes = incomes
+ Table.view $ IncomeTableIn
+ { _tableIn_init = init
+ , _tableIn_currency = _incomeIn_currency incomeIn
+ , _tableIn_incomes = incomes
}
- Table.view $ IncomeTableIn
- { _tableIn_init = _incomeIn_init incomeIn
- , _tableIn_incomes = incomes
- }
+ return ()
- return ()
+ return ()
diff --git a/client/src/View/Income/Init.hs b/client/src/View/Income/Init.hs
new file mode 100644
index 0000000..4f3ef99
--- /dev/null
+++ b/client/src/View/Income/Init.hs
@@ -0,0 +1,11 @@
+module View.Income.Init
+ ( Init(..)
+ ) where
+
+import Common.Model (Income, Payment, User)
+
+data Init = Init
+ { _init_users :: [User]
+ , _init_incomes :: [Income]
+ , _init_payments :: [Payment]
+ } deriving (Show)
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index 5363ca5..d42848b 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -9,16 +9,19 @@ import Data.Text (Text)
import Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Income (..), Init (..), User (..))
+import Common.Model (Currency, Income (..), User (..))
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
+
import Component (TableIn (..))
import qualified Component
+import View.Income.Init (Init (..))
data IncomeTableIn t = IncomeTableIn
- { _tableIn_init :: Init
- , _tableIn_incomes :: Dynamic t [Income]
+ { _tableIn_init :: Init
+ , _tableIn_currency :: Currency
+ , _tableIn_incomes :: Dynamic t [Income]
}
view :: forall t m. MonadWidget t m => IncomeTableIn t -> m ()
@@ -27,7 +30,7 @@ view tableIn = do
Component.table $ TableIn
{ _tableIn_headerLabel = headerLabel
, _tableIn_rows = R.ffor (_tableIn_incomes tableIn) $ reverse . L.sortOn _income_date
- , _tableIn_cell = cell (_tableIn_init tableIn)
+ , _tableIn_cell = cell (_tableIn_init tableIn) (_tableIn_currency tableIn)
, _tableIn_perPage = 7
, _tableIn_resetPage = R.never
}
@@ -45,8 +48,8 @@ headerLabel UserHeader = Msg.get Msg.Income_Name
headerLabel DateHeader = Msg.get Msg.Income_Date
headerLabel AmountHeader = Msg.get Msg.Income_Amount
-cell :: Init -> Header -> Income -> Text
-cell init header income =
+cell :: Init -> Currency -> Header -> Income -> Text
+cell init currency header income =
case header of
UserHeader ->
Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) (_init_users init)
@@ -55,4 +58,4 @@ cell init header income =
Format.longDay . _income_date $ income
AmountHeader ->
- Format.price (_init_currency init) . _income_amount $ income
+ Format.price currency . _income_amount $ income
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" $
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index 8c248bd..4fe495b 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -50,7 +50,7 @@ view signInMessage =
let form = SignInForm <$> _inputOut_raw input
(signInResult, waiting) <- WaitFor.waitFor
- (Ajax.postJson "/api/askSignIn")
+ (Ajax.post "/api/askSignIn")
(ValidationUtil.fireMaybe
((\f -> f <$ SignInValidation.signIn f) <$> form)
validate)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 05:24:16 +0000