Compute cumulative income with a DB query

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