Compute cumulative income with a DB query

11 files changed, 173 insertions, 168 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
diff --git a/server/src/Design/Global.hs b/server/src/Design/Global.hs
index df41cfd..ebd7084 100644
--- a/server/src/Design/Global.hs
+++ b/server/src/Design/Global.hs
@@ -12,6 +12,7 @@ import qualified Design.Constants as Constants
 import qualified Design.Errors    as Errors
 import qualified Design.Form      as Form
 import qualified Design.Helper    as Helper
+import qualified Design.Loadable  as Loadable
 import qualified Design.Media     as Media
 import qualified Design.Modal     as Modal
 import qualified Design.Tooltip   as Tooltip
@@ -28,6 +29,7 @@ global = do
   ".tooltip" ? Tooltip.design
   Views.design
   Form.design
+  Loadable.design
 
   spinKeyframes
   appearKeyframe
@@ -92,14 +94,14 @@ global = do
 
   h1 ? do
     color Color.chestnutRose
-    marginBottom (em 1)
-    lineHeight (em 1.2)
+    lineHeight (em 1.3)
 
     Media.desktop $ fontSize (px 24)
     Media.tablet $ fontSize (px 22)
     Media.mobile $ fontSize (px 20)
 
   ul ? do
+    "margin-top" -: "1vh"
     "margin-bottom" -: "3vh"
     "margin-left" -: "1vh"
     li <? do
diff --git a/server/src/Design/Loadable.hs b/server/src/Design/Loadable.hs
new file mode 100644
index 0000000..6b13f2d
--- /dev/null
+++ b/server/src/Design/Loadable.hs
@@ -0,0 +1,29 @@
+module Design.Loadable
+  ( design
+  ) where
+
+import           Clay
+
+design :: Css
+design = do
+  ".g-Loadable" ? do
+    position relative
+    width (pct 100)
+    height (pct 100)
+
+  ".g-Loadable__Spinner" ? do
+    position absolute
+    top (px 0)
+    left (px 0)
+    width (pct 100)
+    height (pct 100)
+    display none
+
+  ".g-Loadable__Spinner--Loading" ? do
+    display block
+
+  ".g-Loadable__Content" ?
+    transition "opacity" (sec 0.4) ease (sec 0)
+
+  ".g-Loadable__Content--Loading" ?
+    opacity 0.5
diff --git a/server/src/Design/View/Table.hs b/server/src/Design/View/Table.hs
index c77cb7c..56bd389 100644
--- a/server/src/Design/View/Table.hs
+++ b/server/src/Design/View/Table.hs
@@ -15,6 +15,9 @@ design = do
     margin (em 2) (em 2) (em 2) (em 2)
     textAlign (alignSide sideCenter)
 
+  ".table" ? do
+    minHeight (px 540)
+
   ".lines" ? do
     Media.tabletDesktop $ display displayTable
     width (pct 100)
diff --git a/server/src/Design/Views.hs b/server/src/Design/Views.hs
index d36a728..270bb8e 100644
--- a/server/src/Design/Views.hs
+++ b/server/src/Design/Views.hs
@@ -32,15 +32,19 @@ design = do
     "margin" -: "0 2vw"
 
   ".titleButton" ? do
-    h1 ? do
-      Media.tabletDesktop $ float floatLeft
+    display flex
+    marginBottom (em 1)
+
+    Media.tabletDesktop $ do
+      justifyContent spaceBetween
+      alignItems center
+
+    Media.mobile $ do
+      flexDirection column
+      "h1" ? marginBottom (em 0.5)
 
     button ? do
       Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
-      Media.tabletDesktop $ do
-        float floatRight
-        position relative
-        top (px (-8))
       Media.mobile $ do
         width (pct 100)
         marginBottom (px 20)
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index 34bbd3a..16be396 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -2,8 +2,11 @@ module Job.WeeklyReport
   ( weeklyReport
   ) where
 
+import qualified Data.Map               as M
 import           Data.Time.Clock        (UTCTime, getCurrentTime)
 
+import           Common.Model           (User (..))
+
 import           Conf                   (Conf)
 import qualified Model.Query            as Query
 import qualified Persistence.Income     as IncomePersistence
@@ -21,19 +24,27 @@ weeklyReport conf mbLastExecution = do
       return ()
 
     Just lastExecution -> do
-      (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
+      (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
         users <- UserPersistence.list
         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
         weekPayments <- PaymentPersistence.listModifiedSince lastExecution
         weekIncomes <- IncomePersistence.listModifiedSince lastExecution
         (preIncomeRepartition, postIncomeRepartition) <-
           PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
-        return (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
+        return (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
 
       _ <-
         SendMail.sendMail
           conf
-          (WeeklyReport.mail conf users weekPayments preIncomeRepartition postIncomeRepartition (fst <$> paymentRange) weekIncomes lastExecution now)
+          (WeeklyReport.mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition lastExecution now)
 
       return ()
 
diff --git a/server/src/Payer.hs b/server/src/Payer.hs
index d913afe..ab8312e 100644
--- a/server/src/Payer.hs
+++ b/server/src/Payer.hs
@@ -1,25 +1,17 @@
 module Payer
   ( getExceedingPayers
-  , useIncomesFrom
-  , cumulativeIncomesSince
   ) where
 
-import qualified Data.List          as List
-import           Data.Map           (Map)
-import qualified Data.Map           as M
-import qualified Data.Maybe         as Maybe
-import           Data.Time          (NominalDiffTime, UTCTime (..))
-import qualified Data.Time          as Time
-import           Data.Time.Calendar (Day)
+import           Data.Map     (Map)
+import qualified Data.Map     as M
 
-import           Common.Model       (ExceedingPayer (..), Income (..),
-                                     User (..), UserId)
+import           Common.Model (ExceedingPayer (..), User (..), UserId)
 
 data Payer = Payer
   { _payer_userId             :: UserId
   , _payer_preIncomePayments  :: Int
   , _payer_postIncomePayments :: Int
-  , _payer_incomes            :: [Income]
+  , _payer_income             :: Int
   }
 
 data PostPaymentPayer = PostPaymentPayer
@@ -29,43 +21,29 @@ data PostPaymentPayer = PostPaymentPayer
   , _postPaymentPayer_ratio             :: Float
   }
 
-getExceedingPayers :: UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [ExceedingPayer]
-getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition firstPayment =
+getExceedingPayers :: [User] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> [ExceedingPayer]
+getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition =
   let userIds = map _user_id users
-      payers = getPayers userIds incomes preIncomeRepartition postIncomeRepartition
-      exceedingPayersOnPreIncome =
-        exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers
-      mbSince = useIncomesFrom userIds incomes firstPayment
-  in  case mbSince of
-        Just since ->
-          let postPaymentPayers = map (getPostPaymentPayer currentTime since) payers
-              mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers
-          in  case mbMaxRatio of
-                Just maxRatio ->
-                  exceedingPayersFromAmounts
-                    . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p))
-                    $ postPaymentPayers
-                Nothing ->
-                  exceedingPayersOnPreIncome
-        _ ->
-          exceedingPayersOnPreIncome
-
-useIncomesFrom :: [UserId] -> [Income] -> Maybe Day -> Maybe Day
-useIncomesFrom userIds incomes firstPayment =
-  case (firstPayment, incomeDefinedForAll userIds incomes) of
-    (Just d1, Just d2) -> Just (max d1 d2)
-    _                  -> Nothing
-
-dayUTCTime :: Day -> UTCTime
-dayUTCTime = flip UTCTime (Time.secondsToDiffTime 0)
-
-getPayers :: [UserId] -> [Income] -> Map UserId Int -> Map UserId Int -> [Payer]
-getPayers userIds incomes preIncomeRepartition postIncomeRepartition =
+      payers = getPayers userIds cumulativeIncome preIncomeRepartition postIncomeRepartition
+      postPaymentPayers = map getPostPaymentPayer payers
+      mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers
+  in  case mbMaxRatio of
+        Just maxRatio ->
+          exceedingPayersFromAmounts
+            . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p))
+            $ postPaymentPayers
+        Nothing ->
+          exceedingPayersFromAmounts
+            . map (\p -> (_payer_userId p, _payer_preIncomePayments p))
+            $ payers
+
+getPayers :: [UserId] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> [Payer]
+getPayers userIds cumulativeIncome preIncomeRepartition postIncomeRepartition =
   flip map userIds (\userId -> Payer
     { _payer_userId = userId
     , _payer_preIncomePayments = M.findWithDefault 0 userId preIncomeRepartition
     , _payer_postIncomePayments = M.findWithDefault 0 userId postIncomeRepartition
-    , _payer_incomes = filter ((==) userId . _income_userId) incomes
+    , _payer_income = M.findWithDefault 0 userId cumulativeIncome
     }
   )
 
@@ -85,15 +63,14 @@ exceedingPayersFromAmounts userAmounts =
         $ userAmounts
   where mbMinAmount = safeMinimum . map snd $ userAmounts
 
-getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer
-getPostPaymentPayer currentTime since payer =
+getPostPaymentPayer :: Payer -> PostPaymentPayer
+getPostPaymentPayer payer =
   PostPaymentPayer
     { _postPaymentPayer_userId = _payer_userId payer
     , _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer
-    , _postPaymentPayer_cumulativeIncome = cumulativeIncome
-    , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral cumulativeIncome)
+    , _postPaymentPayer_cumulativeIncome = _payer_income payer
+    , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral $ _payer_income payer)
     }
-  where cumulativeIncome = cumulativeIncomesSince currentTime since (_payer_incomes payer)
 
 getFinalDiff :: Float -> PostPaymentPayer -> Int
 getFinalDiff maxRatio payer =
@@ -101,66 +78,6 @@ getFinalDiff maxRatio payer =
         truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer)
   in  postIncomeDiff + _postPaymentPayer_preIncomePayments payer
 
-incomeDefinedForAll :: [UserId] -> [Income] -> Maybe Day
-incomeDefinedForAll userIds incomes =
-  let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds
-      firstIncomes = map (Maybe.listToMaybe . List.sortOn _income_date) userIncomes
-  in  if all Maybe.isJust firstIncomes
-        then Maybe.listToMaybe . reverse . List.sort . map _income_date . Maybe.catMaybes $ firstIncomes
-        else Nothing
-
-cumulativeIncomesSince :: UTCTime -> Day -> [Income] -> Int
-cumulativeIncomesSince currentTime since incomes =
-  getCumulativeIncome currentTime (getOrderedIncomesSince since incomes)
-
-getOrderedIncomesSince :: Day -> [Income] -> [Income]
-getOrderedIncomesSince since incomes =
-  let mbStarterIncome = getIncomeAt since incomes
-      orderedIncomesSince = filter (\income -> _income_date income >= since) incomes
-  in  (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince
-
-getIncomeAt :: Day -> [Income] -> Maybe Income
-getIncomeAt day incomes =
-  case incomes of
-    [x] ->
-      if _income_date x < day
-        then Just $ x { _income_date = day }
-        else Nothing
-    x1 : x2 : xs ->
-      if _income_date x1 < day && _income_date x2 >= day
-        then Just $ x1 { _income_date = day }
-        else getIncomeAt day (x2 : xs)
-    [] ->
-      Nothing
-
-getCumulativeIncome :: UTCTime -> [Income] -> Int
-getCumulativeIncome currentTime incomes =
-  sum
-    . map durationIncome
-    . getIncomesWithDuration currentTime
-    . List.sortOn incomeTime
-    $ incomes
-
-getIncomesWithDuration :: UTCTime -> [Income] -> [(NominalDiffTime, Int)]
-getIncomesWithDuration currentTime incomes =
-  case incomes of
-    [] ->
-      []
-    [income] ->
-      [(Time.diffUTCTime currentTime (incomeTime income), _income_amount income)]
-    (income1 : income2 : xs) ->
-      (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs))
-
-incomeTime :: Income -> UTCTime
-incomeTime = dayUTCTime . _income_date
-
-durationIncome :: (NominalDiffTime, Int) -> Int
-durationIncome (duration, income) =
-  truncate $ duration * fromIntegral income / (nominalDay * 365 / 12)
-
-nominalDay :: NominalDiffTime
-nominalDay = 86400
-
 safeMinimum :: (Ord a) => [a] -> Maybe a
 safeMinimum [] = Nothing
 safeMinimum xs = Just . minimum $ xs
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index ba7ad19..e689505 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -1,21 +1,24 @@
 module Persistence.Income
   ( count
   , list
-  , listAll
   , listModifiedSince
   , create
   , edit
   , delete
   , definedForAll
+  , getCumulativeIncome
   ) where
 
 import qualified Data.List              as L
+import           Data.Map               (Map)
+import qualified Data.Map               as M
 import qualified Data.Maybe             as Maybe
 import qualified Data.Text              as T
 import           Data.Time.Calendar     (Day)
 import           Data.Time.Clock        (UTCTime)
 import           Data.Time.Clock        (getCurrentTime)
-import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
+import           Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)),
+                                         Only (Only))
 import qualified Database.SQLite.Simple as SQLite
 import           Prelude                hiding (id, until)
 
@@ -58,13 +61,6 @@ list page perPage =
         (perPage, (page - 1) * perPage)
   )
 
-listAll :: Query [Income]
-listAll =
-  Query (\conn ->
-    map (\(Row i) -> i) <$>
-      SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
-  )
-
 listModifiedSince :: UTCTime -> Query [Income]
 listModifiedSince since =
   Query (\conn ->
@@ -79,7 +75,7 @@ listModifiedSince since =
           ,   "OR edited_at >= ?"
           ,   "OR deleted_at >= ?"
           ])
-        (Only since)
+        (since, since, since)
   )
 
 create :: UserId -> Day -> Int -> Query Income
@@ -156,6 +152,46 @@ definedForAll users =
   where
     fromRows rows =
       if L.sort users == L.sort (map fst rows) then
-        Maybe.listToMaybe . L.sort . map snd $ rows
+        Maybe.listToMaybe . reverse . L.sort . map snd $ rows
       else
         Nothing
+
+getCumulativeIncome :: Day -> Day -> Query (Map UserId Int)
+getCumulativeIncome start end =
+  Query (\conn -> M.fromList <$> SQLite.queryNamed conn (SQLite.Query query) parameters)
+  where
+    query =
+      T.intercalate "\n" $
+        [ "SELECT user_id, CAST(ROUND(SUM(count)) AS INTEGER) FROM ("
+        , "  SELECT"
+        , "    I1.user_id,"
+        , "    ((JULIANDAY(MIN(I2.date)) - JULIANDAY(I1.date)) * I1.amount * 12 / 365) AS count"
+        , "  FROM (" <> (selectBoundedIncomes ">" ":start") <> ") AS I1"
+        , "  INNER JOIN (" <> (selectBoundedIncomes "<" ":end") <> ") AS I2"
+        , "  ON I2.date > I1.date AND I2.user_id == I1.user_id"
+        , "  GROUP BY I1.date, I1.user_id"
+        , ") GROUP BY user_id"
+        ]
+
+    selectBoundedIncomes op param =
+      T.intercalate "\n" $
+        [ "    SELECT user_id, date, amount FROM ("
+        , "      SELECT"
+        , "        i.user_id, " <> param <> " AS date, i.amount"
+        , "      FROM"
+        , "        (SELECT id, MAX(date) AS max_date"
+        , "        FROM income"
+        , "        WHERE date <= " <> param <> " AND deleted_at IS NULL"
+        , "        GROUP BY user_id) AS m"
+        , "      INNER JOIN income AS i"
+        , "      ON i.id = m.id AND i.date = m.max_date"
+        , "    ) UNION"
+        , "    SELECT user_id, date, amount"
+        , "    FROM income"
+        , "    WHERE date " <> op <> " " <> param <> " AND deleted_at IS NULL"
+        ]
+
+    parameters =
+      [ ":start" := start
+      , ":end" := end
+      ]
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index f75925d..953f0ae 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -163,14 +163,14 @@ listModifiedSince since =
       SQLite.query
         conn
         (SQLite.Query . T.intercalate " " $
-          [ "SELECT *"
+          [ "SELECT " <> fields
           , "FROM payment"
           , "WHERE"
           ,   "created_at >= ?"
           ,   "OR edited_at >= ?"
           ,   "OR deleted_at >= ?"
           ])
-        (Only since)
+        (since, since, since)
   )
 
 
@@ -300,7 +300,13 @@ searchCategory paymentName =
     fmap (\(CategoryIdRow d) -> d) . Maybe.listToMaybe <$>
       SQLite.query
         conn
-        "SELECT category FROM payment WHERE name LIKE ? LIMIT 1"
+        (SQLite.Query . T.intercalate " " $
+          [ "SELECT category"
+          , "FROM payment"
+          , "WHERE deleted_at is NULL AND name LIKE ?"
+          , "ORDER BY edited_at, created_at"
+          , "LIMIT 1"
+          ])
         (Only $ "%" <> paymentName <> "%")
   )
 
diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 1f637bc..3fe224f 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -9,7 +9,6 @@ import           Data.Maybe            (catMaybes, fromMaybe)
 import           Data.Monoid           ((<>))
 import           Data.Text             (Text)
 import qualified Data.Text             as T
-import           Data.Time.Calendar    (Day)
 import           Data.Time.Clock       (UTCTime)
 
 import           Common.Model          (ExceedingPayer (..), Income (..),
@@ -27,8 +26,8 @@ import           Model.PaymentResource (PaymentResource (..))
 import qualified Payer                 as Payer
 import           Resource              (Status (..), groupByStatus, statuses)
 
-mail :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Mail
-mail conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
+mail :: Conf -> [User] -> [Income] -> [Payment] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> UTCTime -> UTCTime -> Mail
+mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end =
   Mail
     { M.from = Conf.noReplyMail conf
     , M.to = map _user_email users
@@ -37,24 +36,24 @@ mail conf users weekPayments preIncomeRepartition postIncomeRepartition firstPay
         , " − "
         , Msg.get Msg.WeeklyReport_Title
         ]
-    , M.body = body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end
+    , M.body = body conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end
     }
 
-body :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Text
-body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
+body :: Conf -> [User] -> [Income] -> [Payment] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> UTCTime -> UTCTime -> Text
+body conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end =
   T.intercalate "\n" $
-    [ exceedingPayers conf end users incomes preIncomeRepartition postIncomeRepartition firstPayment
+    [ exceedingPayers conf users cumulativeIncome preIncomeRepartition postIncomeRepartition
     , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
     ]
       where
         paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
-        incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes
+        incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ weekIncomes
 
-exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> Text
-exceedingPayers conf time users incomes preIncomeRepartition postIncomeRepartition firstPayment =
+exceedingPayers :: Conf -> [User] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> Text
+exceedingPayers conf users cumulativeIncome preIncomeRepartition postIncomeRepartition =
   T.intercalate "\n" . map formatPayer $ payers
   where
-    payers = Payer.getExceedingPayers time users incomes preIncomeRepartition postIncomeRepartition firstPayment
+    payers = Payer.getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition
     formatPayer p = T.concat
       [ "  * "
       , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users