aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/Payment.hs18
-rw-r--r--client/src/View/Payment/Header.hs130
2 files changed, 85 insertions, 63 deletions
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index f4aaf5c..42da8fb 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -8,8 +8,7 @@ import Prelude hiding (init)
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Frequency (..), Init (..), Payment (..))
-import Common.Util.Text as T
+import Common.Model (Init (..))
import View.Payment.Header (HeaderIn (..), HeaderOut (..))
import qualified View.Payment.Header as Header
@@ -31,13 +30,6 @@ widget paymentIn = do
R.divClass "payment" $ do
rec
let init = _paymentIn_init paymentIn
-
- filterPayment s p = search s (_payment_name p) && (_payment_frequency p == Punctual)
-
- payments = fmap
- (\s -> filter (filterPayment s) (_init_payments init))
- (_headerOut_search header)
-
paymentsPerPage = 7
header <- Header.widget $ HeaderIn
@@ -47,14 +39,14 @@ widget paymentIn = do
_ <- Table.widget $ TableIn
{ _tableIn_init = init
, _tableIn_currentPage = _pagesOut_currentPage pages
- , _tableIn_payments = payments
+ , _tableIn_payments = _headerOut_searchPayments header
, _tableIn_perPage = paymentsPerPage
}
pages <- Pages.widget $ PagesIn
- { _pagesIn_total = length <$> payments
+ { _pagesIn_total = length <$> _headerOut_searchPayments header
, _pagesIn_perPage = paymentsPerPage
- , _pagesIn_reset = (fmap $ const ()) . R.updated $ _headerOut_search header
+ , _pagesIn_reset = (fmap $ const ()) . R.updated $ _headerOut_searchName header
}
- return $ PaymentOut {}
+ pure $ PaymentOut {}
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index f64f11d..a694136 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -7,23 +7,26 @@ module View.Payment.Header
import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import qualified Data.List as L hiding (groupBy)
+import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Time as Time
import Prelude hiding (init)
-import Reflex.Dom (Dynamic, MonadWidget)
+import Reflex.Dom (Dynamic, MonadWidget, Reflex)
import qualified Reflex.Dom as R
import Common.Model (Currency, ExceedingPayer (..),
Frequency (..), Income (..), Init (..),
- Payment (..), User (..), UserId)
+ Payment (..), User (..))
import qualified Common.Model as CM
import qualified Common.Msg as Msg
+import qualified Common.Util.Text as T
import qualified Common.View.Format as Format
-import Component (ButtonIn (..), InputIn (..),
- InputOut (..))
+import Component (ButtonIn (..), ButtonOut (..),
+ InputIn (..), InputOut (..),
+ ModalIn (..))
import qualified Component as Component
import qualified Util.List as L
@@ -32,23 +35,37 @@ data HeaderIn t = HeaderIn
}
data HeaderOut t = HeaderOut
- { _headerOut_search :: Dynamic t Text
+ { _headerOut_searchName :: Dynamic t Text
+ , _headerOut_searchPayments :: Dynamic t [Payment]
}
widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
widget headerIn =
R.divClass "header" $ do
- payerAndAdd incomes payments users currency
- search <- searchLine
- infos payments users currency
+ payerAndAdd incomes punctualPayments users currency
+ (searchName, searchFrequency) <- searchLine
+ let searchPayments = getSearchPayments searchName searchFrequency payments
+ infos searchPayments users currency
return $ HeaderOut
- { _headerOut_search = search
+ { _headerOut_searchName = searchName
+ , _headerOut_searchPayments = searchPayments
}
- where init = _headerIn_init headerIn
- incomes = _init_incomes init
- payments = filter ((==) Punctual . _payment_frequency) (_init_payments init)
- users = _init_users init
- currency = _init_currency init
+ where
+ init = _headerIn_init headerIn
+ incomes = _init_incomes init
+ payments = _init_payments init
+ punctualPayments = filter ((==) Punctual . _payment_frequency) payments
+ users = _init_users init
+ currency = _init_currency init
+
+getSearchPayments :: forall t. (Reflex t) => Dynamic t Text -> Dynamic t Frequency -> [Payment] -> Dynamic t [Payment]
+getSearchPayments name frequency payments = do
+ n <- name
+ f <- frequency
+ pure $ flip filter payments (\p ->
+ ( T.search n (_payment_name p)
+ && (_payment_frequency p == f)
+ ))
payerAndAdd :: forall t m. MonadWidget t m => [Income] -> [Payment] -> [User] -> Currency -> m ()
payerAndAdd incomes payments users currency = do
@@ -65,49 +82,62 @@ payerAndAdd incomes payments users currency = do
R.text "+ "
R.text . Format.price currency $ _exceedingPayer_amount p
)
- _ <- Component.button $ ButtonIn
+ addPayment <- _buttonOut_clic <$> (Component.button $ ButtonIn
{ _buttonIn_class = R.constDyn "addPayment"
, _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
, _buttonIn_waiting = R.never
+ })
+ _ <- Component.modal $ ModalIn
+ { _modalIn_show = addPayment
+ , _modalIn_content = R.el "h1" $ R.text "Ajouter un paiement"
}
return ()
-infos :: forall t m. MonadWidget t m => [Payment] -> [User] -> Currency -> m ()
+searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text, Dynamic t Frequency)
+searchLine = do
+ R.divClass "searchLine" $ do
+ searchName <- _inputOut_value <$> (Component.input $ InputIn
+ { _inputIn_reset = R.never
+ , _inputIn_label = Msg.get Msg.Search_Name
+ })
+
+ let frequencies = M.fromList
+ [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+ , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+ ]
+
+ searchFrequency <- R._dropdown_value <$>
+ R.dropdown Punctual (R.constDyn frequencies) R.def
+
+ return (searchName, searchFrequency)
+
+infos :: forall t m. MonadWidget t m => Dynamic t [Payment] -> [User] -> Currency -> m ()
infos payments users currency =
R.divClass "infos" $ do
- R.elClass "span" "total" $ do
- R.text . Msg.get $ Msg.Payment_Worth
- (T.intercalate " "
- [ (Format.number paymentCount)
- , if paymentCount > 1
- then Msg.get Msg.Payment_Many
- else Msg.get Msg.Payment_One
- ])
- (Format.price currency total)
- R.elClass "span" "partition" . R.text $
- T.intercalate ", "
- . map (\(userId, userTotal) ->
- Msg.get $ Msg.Payment_By
- (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
- (Format.price currency userTotal)
- )
- $ totalByUser
- where paymentCount = length payments
- total = sum . map _payment_cost $ payments
-
- totalByUser :: [(UserId, Int)]
- totalByUser =
- L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
- . map (\(u, xs) -> (u, sum . map snd $ xs))
- . L.groupBy fst
- . map (\p -> (_payment_user p, _payment_cost p))
- $ payments
+ R.elClass "span" "total" $ do
+ R.dynText $ do
+ ps <- payments
+ let paymentCount = length ps
+ total = sum . map _payment_cost $ ps
+ pure . Msg.get $ Msg.Payment_Worth
+ (T.intercalate " "
+ [ (Format.number paymentCount)
+ , if paymentCount > 1
+ then Msg.get Msg.Payment_Many
+ else Msg.get Msg.Payment_One
+ ])
+ (Format.price currency total)
-searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text)
-searchLine =
- R.divClass "searchLine" $
- _inputOut_value <$> (Component.input $ InputIn
- { _inputIn_reset = R.never
- , _inputIn_label = Msg.get Msg.Search_Name
- })
+ R.elClass "span" "partition" . R.dynText $ do
+ ps <- payments
+ let totalByUser =
+ L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
+ . map (\(u, xs) -> (u, sum . map snd $ xs))
+ . L.groupBy fst
+ . map (\p -> (_payment_user p, _payment_cost p))
+ $ ps
+ pure . T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) ->
+ Msg.get $ Msg.Payment_By
+ (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
+ (Format.price currency userTotal)