diff options
Diffstat (limited to 'server/src/Controller')
| -rw-r--r-- | server/src/Controller/Income.hs | 28 | ||||
| -rw-r--r-- | server/src/Controller/Payment.hs | 16 |
2 files changed, 21 insertions, 23 deletions
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs index 75d0133..784a2db 100644 --- a/server/src/Controller/Income.hs +++ b/server/src/Controller/Income.hs @@ -13,7 +13,7 @@ import qualified Network.HTTP.Types.Status as Status import Web.Scotty hiding (delete) import Common.Model (CreateIncomeForm (..), - EditIncomeForm (..), Income (..), + EditIncomeForm (..), IncomeHeader (..), IncomeId, IncomePage (..), User (..)) @@ -21,7 +21,6 @@ import qualified Controller.Helper as ControllerHelper import Model.CreateIncome (CreateIncome (..)) import Model.EditIncome (EditIncome (..)) import qualified Model.Query as Query -import qualified Payer as Payer import qualified Persistence.Income as IncomePersistence import qualified Persistence.Payment as PaymentPersistence import qualified Persistence.User as UserPersistence @@ -36,26 +35,19 @@ list page perPage = count <- IncomePersistence.count users <- UserPersistence.list - paymentRange <- PaymentPersistence.getRange - allIncomes <- IncomePersistence.listAll -- TODO optimize - - let since = - Payer.useIncomesFrom (map _user_id users) allIncomes (fst <$> paymentRange) + let userIds = _user_id <$> users - let byUser = - case since of - Just s -> - M.fromList . flip map users $ \user -> - ( _user_id user - , Payer.cumulativeIncomesSince currentTime s $ - filter ((==) (_user_id user) . _income_userId) allIncomes - ) + paymentRange <- PaymentPersistence.getRange + incomeDefinedForAll <- IncomePersistence.definedForAll userIds + let since = max <$> (fst <$> paymentRange) <*> incomeDefinedForAll - Nothing -> - M.empty + cumulativeIncome <- + case since of + Just s -> IncomePersistence.getCumulativeIncome s (Clock.utctDay currentTime) + Nothing -> return M.empty incomes <- IncomePersistence.list page perPage - return $ IncomePage (IncomeHeader since byUser) incomes count) >>= json + return $ IncomePage page (IncomeHeader since cumulativeIncome) incomes count) >>= json ) create :: CreateIncomeForm -> ActionM () diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs index c860810..42a4436 100644 --- a/server/src/Controller/Payment.hs +++ b/server/src/Controller/Payment.hs @@ -11,7 +11,6 @@ import qualified Data.Map as M import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Time.Calendar as Calendar -import qualified Data.Time.Clock as Clock import Data.Validation (Validation (Failure, Success)) import Web.Scotty (ActionM) import qualified Web.Scotty as S @@ -36,16 +35,23 @@ import qualified Validation.Payment as PaymentValidation list :: Frequency -> Int -> Int -> Text -> ActionM () list frequency page perPage search = - Secure.loggedAction (\_ -> do - currentTime <- liftIO Clock.getCurrentTime + Secure.loggedAction (\_ -> (liftIO . Query.run $ do count <- PaymentPersistence.count frequency search payments <- PaymentPersistence.listActivePage frequency page perPage search users <- UserPersistence.list - incomes <- IncomePersistence.listAll -- TODO optimize paymentRange <- PaymentPersistence.getRange + incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users) + + cumulativeIncome <- + case (incomeDefinedForAll, paymentRange) of + (Just incomeStart, Just (paymentStart, paymentEnd)) -> + IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) paymentEnd + + _ -> + return M.empty searchRepartition <- case paymentRange of @@ -57,7 +63,7 @@ list frequency page perPage search = (preIncomeRepartition, postIncomeRepartition) <- PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users - let exceedingPayers = Payer.getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition (fst <$> paymentRange) + let exceedingPayers = Payer.getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition header = PaymentHeader { _paymentHeader_exceedingPayers = exceedingPayers |