From 4dc84dbda7ba3ea60d13e6f81eeec556974b7c72 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 7 Nov 2019 07:59:41 +0100 Subject: Show payment header infos --- server/src/Controller/Payment.hs | 54 +++++++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 17 deletions(-) (limited to 'server/src/Controller') diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs index 01702cb..f685f2e 100644 --- a/server/src/Controller/Payment.hs +++ b/server/src/Controller/Payment.hs @@ -1,6 +1,5 @@ module Controller.Payment - ( deprecatedList - , list + ( list , listPaymentCategories , create , edit @@ -8,48 +7,69 @@ module Controller.Payment ) where import Control.Monad.IO.Class (liftIO) +import qualified Data.Map as M +import qualified Data.Time.Clock as Clock import Data.Validation (Validation (Failure, Success)) import qualified Network.HTTP.Types.Status as Status -import Web.Scotty hiding (delete) +import Web.Scotty (ActionM) +import qualified Web.Scotty as S import Common.Model (Category (..), CreatePaymentForm (..), EditPaymentForm (..), - Payment (..), PaymentId, - PaymentPage (..), + Frequency (Punctual), + Payment (..), PaymentHeader (..), + PaymentId, PaymentPage (..), SavedPayment (..), User (..)) +import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Controller.Helper as ControllerHelper import Model.CreatePayment (CreatePayment (..)) import Model.EditPayment (EditPayment (..)) import qualified Model.Query as Query import qualified Persistence.Category as CategoryPersistence +import qualified Persistence.Income as IncomePersistence import qualified Persistence.Payment as PaymentPersistence import qualified Persistence.PaymentCategory as PaymentCategoryPersistence +import qualified Persistence.User as UserPersistence import qualified Secure +import qualified Util.List as L import qualified Validation.Payment as PaymentValidation -deprecatedList :: ActionM () -deprecatedList = - Secure.loggedAction (\_ -> - (liftIO . Query.run $ PaymentPersistence.listActive) >>= json - ) - list :: Int -> Int -> ActionM () list page perPage = - Secure.loggedAction (\_ -> + Secure.loggedAction (\_ -> do + currentTime <- liftIO Clock.getCurrentTime (liftIO . Query.run $ do count <- PaymentPersistence.count payments <- PaymentPersistence.listActivePage page perPage paymentCategories <- PaymentCategoryPersistence.list - return $ PaymentPage payments paymentCategories count - ) >>= json + + users <- UserPersistence.list + incomes <- IncomePersistence.listAll + allPayments <- PaymentPersistence.listActive Punctual + + let exceedingPayers = CM.getExceedingPayers currentTime users incomes allPayments + + repartition = + M.fromList + . map (\(u, xs) -> (u, sum . map snd $ xs)) + . L.groupBy fst + . map (\p -> (_payment_user p, _payment_cost p)) + $ allPayments + + header = PaymentHeader + { _paymentHeader_exceedingPayers = exceedingPayers + , _paymentHeader_repartition = repartition + } + + return $ PaymentPage header payments paymentCategories count) >>= S.json ) listPaymentCategories :: ActionM () listPaymentCategories = Secure.loggedAction (\_ -> - (liftIO . Query.run $ PaymentCategoryPersistence.list) >>= json + (liftIO . Query.run $ PaymentCategoryPersistence.list) >>= S.json ) create :: CreatePaymentForm -> ActionM () @@ -100,7 +120,7 @@ delete paymentId = _ -> return False if deleted then - status Status.ok200 + S.status Status.ok200 else - status Status.badRequest400 + S.status Status.badRequest400 ) -- cgit v1.2.3