aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/Payment.hs8
-rw-r--r--client/src/View/Payment/Header.hs66
2 files changed, 53 insertions, 21 deletions
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 934f720..15892c4 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -4,6 +4,7 @@ module View.Payment
, PaymentOut(..)
) where
+import Prelude hiding (init)
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
@@ -29,13 +30,14 @@ widget paymentIn = do
R.divClass "payment" $ do
rec
_ <- Header.widget $ HeaderIn
- { _headerIn_init = _paymentIn_init $ paymentIn
+ { _headerIn_init = init
}
_ <- Table.widget $ TableIn
- { _tableIn_init = _paymentIn_init paymentIn
+ { _tableIn_init = init
, _tableIn_currentPage = _pagesOut_currentPage pagesOut
}
pagesOut <- Pages.widget $ PagesIn
- { _pagesIn_payments = _init_payments . _paymentIn_init $ paymentIn
+ { _pagesIn_payments = _init_payments init
}
return $ PaymentOut {}
+ where init = _paymentIn_init paymentIn
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 67b4eb4..3f2adc3 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -4,22 +4,29 @@ module View.Payment.Header
, HeaderOut(..)
) where
-import qualified Data.List as L hiding (groupBy)
-import Data.Maybe (fromMaybe)
-import qualified Data.Text as T
-import Prelude hiding (init)
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
+import Control.Monad (forM_)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.List as L hiding (groupBy)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import qualified Data.Time as Time
+import Prelude hiding (init)
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
-import Common.Model (Currency, Frequency (..), Init (..),
- Payment (..), User (..), UserId)
-import qualified Common.Msg as Msg
-import qualified Common.View.Format as Format
+import Common.Model (Currency, ExceedingPayer (..),
+ Frequency (..), Income (..), Init (..),
+ Payment (..), User (..), UserId)
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
+import qualified Common.View.Format as Format
-import qualified Util.List as L
+import Component (ButtonIn (..))
+import qualified Component as Component
+import qualified Util.List as L
data HeaderIn t = HeaderIn
- { _headerIn_init :: Init
+ { _headerIn_init :: Init
}
data HeaderOut = HeaderOut
@@ -29,13 +36,37 @@ data HeaderOut = HeaderOut
widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut
widget headerIn =
R.divClass "header" $ do
+ payerAndAdd incomes payments users currency
infos payments users currency
return $ HeaderOut {}
where init = _headerIn_init headerIn
- payments = _init_payments init
+ incomes = _init_incomes init
+ payments = filter ((==) Punctual . _payment_frequency) (_init_payments init)
users = _init_users init
currency = _init_currency init
+payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m ()
+payerAndAdd incomes payments users currency = do
+ time <- liftIO Time.getCurrentTime
+ R.divClass "payerAndAdd" $ do
+ R.divClass "exceedingPayers" $
+ forM_
+ (CM.getExceedingPayers time users incomes payments)
+ (\p ->
+ R.elClass "span" "exceedingPayer" $ do
+ R.elClass "span" "userName" $
+ R.text . fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId p) users
+ R.elClass "span" "amount" $ do
+ R.text "+ "
+ R.text . Format.price currency $ _exceedingPayer_amount p
+ )
+ _ <- Component.button $ ButtonIn
+ { _buttonIn_class = R.constDyn "addPayment"
+ , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
+ , _buttonIn_waiting = R.never
+ }
+ return ()
+
infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m ()
infos payments users currency =
R.divClass "infos" $ do
@@ -52,14 +83,13 @@ infos payments users currency =
T.intercalate ", "
. map (\(userId, userTotal) ->
Msg.get $ Msg.Payment_By
- (fromMaybe "" . fmap _user_name . L.find ((==) userId . _user_id) $ users)
+ (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
(Format.price currency userTotal)
)
$ totalByUser
- where punctualPayments = filter ((==) Punctual . _payment_frequency) payments
- paymentCount = length punctualPayments
- total = sum . map _payment_cost $ punctualPayments
+ where paymentCount = length payments
+ total = sum . map _payment_cost $ payments
totalByUser :: [(UserId, Int)]
totalByUser =
@@ -67,4 +97,4 @@ infos payments users currency =
. map (\(u, xs) -> (u, sum . map snd $ xs))
. L.groupBy fst
. map (\p -> (_payment_user p, _payment_cost p))
- $ punctualPayments
+ $ payments