diff options
Diffstat (limited to 'client/src/View')
| -rw-r--r-- | client/src/View/Payment.hs | 18 | ||||
| -rw-r--r-- | client/src/View/Payment/Header.hs | 130 |
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) |