From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Nov 2019 16:19:53 +0100
Subject: Compute cumulative income with a DB query

---
 server/src/Controller/Payment.hs | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'server/src/Controller/Payment.hs')

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
-- 
cgit v1.2.3