Compute cumulative income with a DB query

19 files changed, 262 insertions, 224 deletions

diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index 2b9008a..9a14b3f 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -1,9 +1,12 @@
 module Loadable
   ( Loadable (..)
+  , Loadable2 (..)
   , fromEvent
   , view
+  , view2
   ) where
 
+import qualified Data.Map     as M
 import           Reflex.Dom   (MonadWidget)
 import qualified Reflex.Dom   as R
 
@@ -50,3 +53,37 @@ view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe
 view _ Loading  = (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing
 view _ (Error e)  = R.text e >> return Nothing
 view f (Loaded x) = Just <$> f x
+
+data Loadable2 t a = Loadable2
+  { _loadable_isLoading :: Dynamic t Bool
+  , _loadable_value     :: Dynamic t (Maybe a)
+  }
+
+view2 :: forall t m a b. MonadWidget t m => Loadable2 t a -> (a -> m b) -> m (Event t (Maybe b))
+view2 (Loadable2 isLoading value) f =
+  withLoader isLoading $
+    R.dyn . R.ffor value . viewMaybe $ f
+
+  where
+    viewMaybe _ Nothing  = return Nothing
+    viewMaybe f (Just x) = Just <$> f x
+
+withLoader
+  :: forall t m a. MonadWidget t m
+  => Dynamic t Bool
+  -> m a
+  -> m a
+withLoader isLoading block =
+  R.divClass "g-Loadable" $ do
+    R.elDynAttr "div" (spinnerAttrs <$> isLoading) $
+      R.divClass "spinner" R.blank
+    R.elDynAttr "div" (blockAttrs <$> isLoading) $
+      block
+  where
+    spinnerAttrs l = M.singleton "class" $
+      "g-Loadable__Spinner"
+      <> (if l then " g-Loadable__Spinner--Loading" else "")
+
+    blockAttrs l = M.singleton "class" $
+      "g-Loadable__Content"
+      <> (if l then " g-Loadable__Content--Loading" else "")
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index d82ab4d..fa2585d 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -19,6 +19,7 @@ import           Loadable            (Loadable (..))
 import qualified Loadable
 import qualified Util.Ajax           as AjaxUtil
 import qualified Util.Reflex         as ReflexUtil
+import qualified Util.Reflex         as ReflexUtil
 import qualified View.Income.Header  as Header
 import           View.Income.Init    (Init (..))
 import qualified View.Income.Reducer as Reducer
@@ -33,9 +34,8 @@ data In t = In
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
   rec
-    incomes <- Reducer.reducer $ Reducer.In
-      { Reducer._in_newPage      = newPage
-      , Reducer._in_currentPage  = currentPage
+    incomePage <- Reducer.reducer $ Reducer.In
+      { Reducer._in_page         = page
       , Reducer._in_addIncome    = R.leftmost [headerAddIncome, tableAddIncome]
       , Reducer._in_editIncome   = editIncome
       , Reducer._in_deleteIncome = deleteIncome
@@ -44,15 +44,14 @@ view input = do
     let eventFromResult :: forall a. ((Header.Out t, Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
         eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
 
-    newPage <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
-    currentPage <- R.holdDyn 1 newPage
+    page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
     headerAddIncome <- eventFromResult $ Header._out_add . (\(a, _, _) -> a)
     tableAddIncome <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
     editIncome <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
     deleteIncome <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
 
-    result <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) ->
-      flip Loadable.view is $ \(IncomePage header incomes count) -> do
+    result <- Loadable.view2 incomePage $
+      \(IncomePage page header incomes count) -> do
         header <- Header.view $ Header.In
           { Header._in_users = _in_users input
           , Header._in_header = header
@@ -69,7 +68,7 @@ view input = do
         pages <- Pages.view $ Pages.In
           { Pages._in_total = R.constDyn count
           , Pages._in_perPage = Reducer.perPage
-          , Pages._in_page = p
+          , Pages._in_page = page
           }
 
         return (header, table, pages)
diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs
index 092d9b3..391890f 100644
--- a/client/src/View/Income/Reducer.hs
+++ b/client/src/View/Income/Reducer.hs
@@ -11,53 +11,51 @@ import qualified Reflex.Dom   as R
 
 import           Common.Model (IncomePage)
 
-import           Loadable     (Loadable (..))
-import qualified Loadable     as Loadable
+import           Loadable     (Loadable2 (..))
 import qualified Util.Ajax    as AjaxUtil
+import qualified Util.Either  as EitherUtil
 
 perPage :: Int
 perPage = 7
 
 data In t a b c = In
-  { _in_newPage      :: Event t Int
-  , _in_currentPage  :: Dynamic t Int
+  { _in_page         :: Event t Int
   , _in_addIncome    :: Event t a
   , _in_editIncome   :: Event t b
   , _in_deleteIncome :: Event t c
   }
 
-data Action
-  = LoadPage Int
-  | GetResult (Either Text IncomePage)
-
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage))
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t IncomePage)
 reducer input = do
 
   postBuild <- R.getPostBuild
 
+  currentPage <- R.holdDyn 1 (_in_page input)
+
   let loadPage =
         R.leftmost
           [ 1 <$ postBuild
-          , _in_newPage input
+          , _in_page input
           , 1 <$ _in_addIncome input
-          , R.tag (R.current $ _in_currentPage input) (_in_editIncome input)
-          , R.tag (R.current $ _in_currentPage input) (_in_deleteIncome input)
+          , R.tag (R.current currentPage) (_in_editIncome input)
+          , R.tag (R.current currentPage) (_in_deleteIncome input)
           ]
 
   getResult <- AjaxUtil.get $ fmap pageUrl loadPage
 
-  R.foldDyn
-    (\action _ -> case action of
-      LoadPage _                -> Loading
-      GetResult (Left err)      -> Error err
-      GetResult (Right incomes) -> Loaded incomes
-    )
-    Loading
+  isLoading <- R.holdDyn
+    True
     (R.leftmost
-      [ LoadPage <$> loadPage
-      , GetResult <$> getResult
+      [ True <$ loadPage
+      , False <$ getResult
       ])
 
+  incomePage <- R.holdDyn
+    Nothing
+    (fmap EitherUtil.eitherToMaybe getResult)
+
+  return $ Loadable2 isLoading incomePage
+
   where
     pageUrl p =
       "api/incomes?page="
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 99dce13..064b5b3 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -113,6 +113,7 @@ view input cancel = do
 
       setCategory <-
         R.debounce  (1 :: NominalDiffTime) (R.updated $ Input._out_raw name)
+          >>= (return . R.ffilter (\name -> T.length name >= 3))
           >>= (Ajax.get . (fmap ("/api/payment/category?name=" <>)))
           >>= (return . R.mapMaybe (join . EitherUtil.eitherToMaybe))
 
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index a34d2f4..a97c3df 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -41,7 +41,7 @@ view input = do
   R.dyn . R.ffor categories . Loadable.view $ \categories -> do
 
     rec
-      payments <- Reducer.reducer $ Reducer.In
+      paymentPage <- Reducer.reducer $ Reducer.In
         { Reducer._in_page          = page
         , Reducer._in_search        = HeaderForm._out_search form
         , Reducer._in_frequency     = HeaderForm._out_frequency form
@@ -50,7 +50,7 @@ view input = do
         , Reducer._in_deletePayment = deletePayment
         }
 
-      let eventFromResult :: forall a. (((), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+      let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
           eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
 
       let addPayment =
@@ -59,18 +59,18 @@ view input = do
               , HeaderForm._out_addPayment form
               ]
 
-      page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
-      tableAddPayment <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
-      editPayment <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
-      deletePayment <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
+      page <- eventFromResult $ Pages._out_newPage . snd
+      tableAddPayment <- eventFromResult $ Table._out_add . fst
+      editPayment <- eventFromResult $ Table._out_edit . fst
+      deletePayment <- eventFromResult $ Table._out_delete . fst
 
       form <- HeaderForm.view $ HeaderForm.In
         { HeaderForm._in_reset             = () <$ addPayment
         , HeaderForm._in_categories        = categories
         }
 
-      result <- R.dyn . R.ffor payments $
-        Loadable.view $ \(PaymentPage page frequency header payments count) -> do
+      result <- Loadable.view2 paymentPage $
+        \(PaymentPage page frequency header payments count) -> do
 
           HeaderInfos.view $ HeaderInfos.In
             { HeaderInfos._in_users = _in_users input
@@ -94,7 +94,7 @@ view input = do
             , Pages._in_page = page
             }
 
-          return ((), table, pages)
+          return (table, pages)
 
     return ()
 
diff --git a/client/src/View/Payment/Reducer.hs b/client/src/View/Payment/Reducer.hs
index 0b6c041..d221ff0 100644
--- a/client/src/View/Payment/Reducer.hs
+++ b/client/src/View/Payment/Reducer.hs
@@ -13,9 +13,9 @@ import qualified Reflex.Dom   as R
 
 import           Common.Model (Frequency (..), PaymentPage)
 
-import           Loadable     (Loadable (..))
-import qualified Loadable     as Loadable
+import           Loadable     (Loadable2 (..))
 import qualified Util.Ajax    as AjaxUtil
+import qualified Util.Either  as EitherUtil
 
 perPage :: Int
 perPage = 7
@@ -29,10 +29,6 @@ data In t a b c = In
   , _in_deletePayment :: Event t c
   }
 
-data Action
-  = LoadPage
-  | GetResult (Either Text PaymentPage)
-
 data Params = Params
   { _params_page      :: Int
   , _params_search    :: Text
@@ -48,7 +44,7 @@ data Msg
   | ResetSearch
   deriving Show
 
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable PaymentPage))
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Loadable2 t PaymentPage)
 reducer input = do
 
   postBuild <- R.getPostBuild
@@ -94,19 +90,19 @@ reducer input = do
 
   getResult <- AjaxUtil.get (pageUrl <$> paramsEvent)
 
-
-  R.foldDyn
-    (\action _ -> case action of
-      LoadPage                   -> Loading
-      GetResult (Left err)       -> Error err
-      GetResult (Right payments) -> Loaded payments
-    )
-    Loading
+  isLoading <- R.holdDyn
+    True
     (R.leftmost
-      [ LoadPage <$ paramsEvent
-      , GetResult <$> getResult
+      [ True <$ paramsEvent
+      , False <$ getResult
       ])
 
+  paymentPage <- R.holdDyn
+    Nothing
+    (fmap EitherUtil.eitherToMaybe getResult)
+
+  return $ Loadable2 isLoading paymentPage
+
   where
     pageUrl (Params page search frequency) =
       "api/payments?page="
diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs
index c3f478e..0572141 100644
--- a/common/src/Common/Model/IncomePage.hs
+++ b/common/src/Common/Model/IncomePage.hs
@@ -9,7 +9,8 @@ import           Common.Model.Income       (Income)
 import           Common.Model.IncomeHeader (IncomeHeader)
 
 data IncomePage = IncomePage
-  { _incomePage_header     :: IncomeHeader
+  { _incomePage_page       :: Int
+  , _incomePage_header     :: IncomeHeader
   , _incomePage_incomes    :: [Income]
   , _incomePage_totalCount :: Int
   } deriving (Show, Generic)
diff --git a/server/server.cabal b/server/server.cabal
index 7056b3f..c9ab2c7 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -72,6 +72,7 @@ Executable server
     Design.Form
     Design.Global
     Design.Helper
+    Design.Loadable
     Design.Media
     Design.Modal
     Design.Tooltip
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