diff options
Diffstat (limited to 'client/src/View/Payment/Table.hs')
| -rw-r--r-- | client/src/View/Payment/Table.hs | 31 |
1 files changed, 17 insertions, 14 deletions
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs index ba16bf5..6432274 100644 --- a/client/src/View/Payment/Table.hs +++ b/client/src/View/Payment/Table.hs @@ -29,21 +29,22 @@ import qualified Icon import qualified Util.Dom as Dom data TableIn t = TableIn - { _tableIn_init :: Init - , _tableIn_currentPage :: Dynamic t Int - , _tableIn_payments :: Dynamic t [Payment] - , _tableIn_perPage :: Int + { _tableIn_init :: Init + , _tableIn_currentPage :: Dynamic t Int + , _tableIn_payments :: Dynamic t [Payment] + , _tableIn_perPage :: Int + , _tableIn_paymentCategories :: Dynamic t [PaymentCategory] } data TableOut t = TableOut - { _tableOut_deletedPayment :: Event t PaymentId + { _tableOut_deletePayment :: Event t PaymentId } widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t) widget tableIn = do R.divClass "table" $ do - deletedPayment <- R.divClass "lines" $ do + deletePayment <- R.divClass "lines" $ do R.divClass "header" $ do R.divClass "cell name" $ R.text $ Msg.get Msg.Payment_Name R.divClass "cell cost" $ R.text $ Msg.get Msg.Payment_Cost @@ -53,13 +54,14 @@ widget tableIn = do R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank - (R.switch . R.current . fmap R.leftmost) <$> (R.simpleList paymentRange (paymentRow init)) + (R.switch . R.current . fmap R.leftmost) <$> + (R.simpleList paymentRange (paymentRow init paymentCategories)) Dom.divClassVisibleIf (null <$> payments) "emptyTableMsg" $ R.text $ Msg.get Msg.Payment_Empty return $ TableOut - { _tableOut_deletedPayment = deletedPayment + { _tableOut_deletePayment = deletePayment } where @@ -67,6 +69,7 @@ widget tableIn = do currentPage = _tableIn_currentPage tableIn payments = _tableIn_payments tableIn paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage + paymentCategories = _tableIn_paymentCategories tableIn getPaymentRange :: Int -> [Payment] -> Int -> [Payment] getPaymentRange perPage payments currentPage = @@ -76,8 +79,8 @@ getPaymentRange perPage payments currentPage = . L.sortOn _payment_date $ payments -paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m (Event t PaymentId) -paymentRow init payment = +paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t [PaymentCategory] -> Dynamic t Payment -> m (Event t PaymentId) +paymentRow init 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 @@ -88,10 +91,10 @@ paymentRow init payment = Just u -> _user_name u _ -> "" - let category = flip fmap payment $ \p -> findCategory - (_init_categories init) - (_init_paymentCategories init) - (_payment_name p) + let category = do + p <- payment + pcs <- paymentCategories + return $ findCategory (_init_categories init) pcs (_payment_name p) R.divClass "cell category" $ do let attrs = flip fmap category $ \maybeCategory -> case maybeCategory of Just c -> M.fromList |