Optimize and refactor payments

18 files changed, 561 insertions, 325 deletions

diff --git a/server/src/Controller/Category.hs b/server/src/Controller/Category.hs
index e536caa..8fbc8c8 100644
--- a/server/src/Controller/Category.hs
+++ b/server/src/Controller/Category.hs
@@ -5,19 +5,18 @@ module Controller.Category
   , delete
   ) where
 
-import           Control.Monad.IO.Class      (liftIO)
-import qualified Data.Text.Lazy              as TL
-import           Network.HTTP.Types.Status   (badRequest400, ok200)
-import           Web.Scotty                  hiding (delete)
+import           Control.Monad.IO.Class    (liftIO)
+import qualified Data.Text.Lazy            as TL
+import           Network.HTTP.Types.Status (badRequest400, ok200)
+import           Web.Scotty                hiding (delete)
 
-import           Common.Model                (CategoryId, CreateCategory (..),
-                                              EditCategory (..))
-import qualified Common.Msg                  as Msg
+import           Common.Model              (CategoryId, CreateCategory (..),
+                                            EditCategory (..))
+import qualified Common.Msg                as Msg
 
-import           Json                        (jsonId)
-import qualified Model.Query                 as Query
-import qualified Persistence.Category        as CategoryPersistence
-import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
+import           Json                      (jsonId)
+import qualified Model.Query               as Query
+import qualified Persistence.Category      as CategoryPersistence
 import qualified Secure
 
 list :: ActionM ()
@@ -45,10 +44,8 @@ delete :: CategoryId -> ActionM ()
 delete categoryId =
   Secure.loggedAction (\_ -> do
     deleted <- liftIO . Query.run $ do
-      paymentCategories <- PaymentCategoryPersistence.listByCategory categoryId
-      if null paymentCategories
-        then CategoryPersistence.delete categoryId
-        else return False
+      -- TODO: delete only if no payment has this category
+      CategoryPersistence.delete categoryId
     if deleted
       then
         status ok200
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 127e3b3..75d0133 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,6 +1,5 @@
 module Controller.Income
   ( list
-  , deprecatedList
   , create
   , edit
   , delete
@@ -17,12 +16,12 @@ import           Common.Model              (CreateIncomeForm (..),
                                             EditIncomeForm (..), Income (..),
                                             IncomeHeader (..), IncomeId,
                                             IncomePage (..), User (..))
-import qualified Common.Model              as CM
 
 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
@@ -37,18 +36,18 @@ list page perPage =
       count <- IncomePersistence.count
 
       users <- UserPersistence.list
-      firstPayment <- PaymentPersistence.firstPunctualDay
-      allIncomes <- IncomePersistence.listAll
+      paymentRange <- PaymentPersistence.getRange
+      allIncomes <- IncomePersistence.listAll -- TODO optimize
 
       let since =
-            CM.useIncomesFrom (map _user_id users) allIncomes firstPayment
+            Payer.useIncomesFrom (map _user_id users) allIncomes (fst <$> paymentRange)
 
       let byUser =
             case since of
               Just s ->
                 M.fromList . flip map users $ \user ->
                   ( _user_id user
-                  , CM.cumulativeIncomesSince currentTime s $
+                  , Payer.cumulativeIncomesSince currentTime s $
                     filter ((==) (_user_id user) . _income_userId) allIncomes
                   )
 
@@ -59,12 +58,6 @@ list page perPage =
       return $ IncomePage (IncomeHeader since byUser) incomes count) >>= json
   )
 
-deprecatedList :: ActionM ()
-deprecatedList =
-  Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ IncomePersistence.listAll) >>= json
-  )
-
 create :: CreateIncomeForm -> ActionM ()
 create form =
   Secure.loggedAction (\user ->
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index f685f2e..d4d086e 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -1,75 +1,70 @@
 module Controller.Payment
   ( list
-  , listPaymentCategories
   , create
   , edit
   , delete
+  , searchCategory
   ) where
 
-import           Control.Monad.IO.Class      (liftIO)
-import qualified Data.Map                    as M
-import qualified Data.Time.Clock             as Clock
-import           Data.Validation             (Validation (Failure, Success))
-import qualified Network.HTTP.Types.Status   as Status
-import           Web.Scotty                  (ActionM)
-import qualified Web.Scotty                  as S
+import           Control.Monad.IO.Class (liftIO)
+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
 
-import           Common.Model                (Category (..),
-                                              CreatePaymentForm (..),
-                                              EditPaymentForm (..),
-                                              Frequency (Punctual),
-                                              Payment (..), PaymentHeader (..),
-                                              PaymentId, PaymentPage (..),
-                                              SavedPayment (..), User (..))
-import qualified Common.Model                as CM
-import qualified Common.Msg                  as Msg
-import qualified Controller.Helper           as ControllerHelper
-import           Model.CreatePayment         (CreatePayment (..))
-import           Model.EditPayment           (EditPayment (..))
-import qualified Model.Query                 as Query
-import qualified Persistence.Category        as CategoryPersistence
-import qualified Persistence.Income          as IncomePersistence
-import qualified Persistence.Payment         as PaymentPersistence
-import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
-import qualified Persistence.User            as UserPersistence
+import           Common.Model           (Category (..), CreatePaymentForm (..),
+                                         EditPaymentForm (..), Frequency,
+                                         PaymentHeader (..), PaymentId,
+                                         PaymentPage (..), User (..))
+import qualified Common.Msg             as Msg
+
+import qualified Controller.Helper      as ControllerHelper
+import           Model.CreatePayment    (CreatePayment (..))
+import           Model.EditPayment      (EditPayment (..))
+import qualified Model.Query            as Query
+import qualified Payer                  as Payer
+import qualified Persistence.Category   as CategoryPersistence
+import qualified Persistence.Income     as IncomePersistence
+import qualified Persistence.Payment    as PaymentPersistence
+import qualified Persistence.User       as UserPersistence
 import qualified Secure
-import qualified Util.List                   as L
-import qualified Validation.Payment          as PaymentValidation
+import qualified Validation.Payment     as PaymentValidation
 
-list :: Int -> Int -> ActionM ()
-list page perPage =
+list :: Frequency -> Int -> Int -> Text -> ActionM ()
+list frequency page perPage search =
   Secure.loggedAction (\_ -> do
     currentTime <- liftIO Clock.getCurrentTime
     (liftIO . Query.run $ do
-      count <- PaymentPersistence.count
-      payments <- PaymentPersistence.listActivePage page perPage
-      paymentCategories <- PaymentCategoryPersistence.list
+      count <- PaymentPersistence.count frequency search
+      payments <- PaymentPersistence.listActivePage frequency page perPage search
 
       users <- UserPersistence.list
-      incomes <- IncomePersistence.listAll
-      allPayments <- PaymentPersistence.listActive Punctual
+      incomes <- IncomePersistence.listAll -- TODO optimize
+
+      paymentRange <- PaymentPersistence.getRange
+
+      searchRepartition <-
+        case paymentRange of
+          Just (from, to) ->
+            PaymentPersistence.repartition frequency search from (Calendar.addDays 1 to)
+          Nothing ->
+            return M.empty
 
-      let exceedingPayers = CM.getExceedingPayers currentTime users incomes allPayments
+      (preIncomeRepartition, postIncomeRepartition) <-
+        PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
 
-          repartition =
-            M.fromList
-              . map (\(u, xs) -> (u, sum . map snd $ xs))
-              . L.groupBy fst
-              . map (\p -> (_payment_user p, _payment_cost p))
-              $ allPayments
+      let exceedingPayers = Payer.getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition (fst <$> paymentRange)
 
           header = PaymentHeader
             { _paymentHeader_exceedingPayers = exceedingPayers
-            , _paymentHeader_repartition     = repartition
+            , _paymentHeader_repartition     = searchRepartition
             }
 
-      return $ PaymentPage header payments paymentCategories count) >>= S.json
-  )
-
-listPaymentCategories :: ActionM ()
-listPaymentCategories =
-  Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ PaymentCategoryPersistence.list) >>= S.json
+      return $ PaymentPage page header payments count) >>= S.json
   )
 
 create :: CreatePaymentForm -> ActionM ()
@@ -78,10 +73,8 @@ create form =
     (liftIO . Query.run $ do
       cs <- map _category_id <$> CategoryPersistence.list
       case PaymentValidation.createPayment cs form of
-        Success (CreatePayment name cost date category frequency) -> do
-          pc <- PaymentCategoryPersistence.save name category
-          p <- PaymentPersistence.create (_user_id user) name cost date frequency
-          return . Right $ SavedPayment p pc
+        Success (CreatePayment name cost date category frequency) ->
+          Right <$> PaymentPersistence.create (_user_id user) name cost date category frequency
         Failure validationError ->
           return $ Left validationError
     ) >>= ControllerHelper.jsonOrBadRequest
@@ -94,14 +87,11 @@ edit form =
       cs <- map _category_id <$> CategoryPersistence.list
       case PaymentValidation.editPayment cs form of
         Success (EditPayment paymentId name cost date category frequency) -> do
-          editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency
-          case editedPayment of
-            Just (old, new) -> do
-              pc <- PaymentCategoryPersistence.save name category
-              PaymentCategoryPersistence.deleteIfUnused (_payment_name old)
-              return . Right $ SavedPayment new pc
-            Nothing ->
-              return . Left $ Msg.get Msg.Error_PaymentEdit
+          editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency
+          if Maybe.isJust editedPayment then
+            return . Right $ editedPayment
+          else
+            return . Left $ Msg.get Msg.Error_PaymentEdit
         Failure validationError ->
           return $ Left validationError
     ) >>= ControllerHelper.jsonOrBadRequest
@@ -109,18 +99,13 @@ edit form =
 
 delete :: PaymentId -> ActionM ()
 delete paymentId =
-  Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ do
-      payment <- PaymentPersistence.find paymentId
-      case payment of
-        Just p | _payment_user p == _user_id user -> do
-          PaymentPersistence.delete (_user_id user) paymentId
-          PaymentCategoryPersistence.deleteIfUnused (_payment_name p)
-          return True
-        _ ->
-          return False
-    if deleted then
-      S.status Status.ok200
-    else
-      S.status Status.badRequest400
+  Secure.loggedAction (\user ->
+    liftIO . Query.run $ PaymentPersistence.delete (_user_id user) paymentId
+  )
+
+searchCategory :: Text -> ActionM ()
+searchCategory paymentName =
+  Secure.loggedAction (\_ -> do
+    (liftIO $ Query.run (PaymentPersistence.searchCategory paymentName))
+      >>= S.json
   )
diff --git a/server/src/Design/Form.hs b/server/src/Design/Form.hs
index 506343d..5713bfe 100644
--- a/server/src/Design/Form.hs
+++ b/server/src/Design/Form.hs
@@ -77,7 +77,6 @@ design = do
       backgroundColor transparent
 
   ".selectInput" ? do
-    marginBottom (em 2)
 
     ".label" ? do
       color Color.silver
diff --git a/server/src/Design/View/Payment.hs b/server/src/Design/View/Payment.hs
index 27b4ef3..d563f5d 100644
--- a/server/src/Design/View/Payment.hs
+++ b/server/src/Design/View/Payment.hs
@@ -4,8 +4,10 @@ module Design.View.Payment
 
 import           Clay
 
-import qualified Design.View.Payment.Header as Header
+import qualified Design.View.Payment.HeaderForm  as HeaderForm
+import qualified Design.View.Payment.HeaderInfos as HeaderInfos
 
 design :: Css
 design = do
-  ".g-HeaderInfos" ? Header.design
+  HeaderForm.design
+  HeaderInfos.design
diff --git a/server/src/Design/View/Payment/HeaderForm.hs b/server/src/Design/View/Payment/HeaderForm.hs
new file mode 100644
index 0000000..6081443
--- /dev/null
+++ b/server/src/Design/View/Payment/HeaderForm.hs
@@ -0,0 +1,40 @@
+module Design.View.Payment.HeaderForm
+  ( design
+  ) where
+
+import           Clay
+
+import qualified Design.Color     as Color
+import qualified Design.Constants as Constants
+import qualified Design.Helper    as Helper
+import qualified Design.Media     as Media
+
+design :: Css
+design = do
+
+  ".g-PaymentHeaderForm" ? do
+    marginBottom (em 2)
+    marginLeft (pct Constants.blockPercentMargin)
+    marginRight (pct Constants.blockPercentMargin)
+    display flex
+    justifyContent spaceBetween
+    alignItems center
+    Media.mobile $ flexDirection column
+
+    ".textInput" ? do
+      display inlineBlock
+      marginBottom (px 0)
+
+      Media.tabletDesktop $ marginRight (px 30)
+      Media.mobile $ do
+        marginBottom (em 1)
+        width (pct 100)
+
+    ".selectInput" ? do
+      Media.tabletDesktop $ display inlineBlock
+      Media.mobile $ marginBottom (em 2)
+
+    ".addPayment" ? do
+      Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
+      Media.mobile $ width (pct 100)
+      flexShrink 0
diff --git a/server/src/Design/View/Payment/Header.hs b/server/src/Design/View/Payment/HeaderInfos.hs
index 49c1a09..acb393b 100644
--- a/server/src/Design/View/Payment/Header.hs
+++ b/server/src/Design/View/Payment/HeaderInfos.hs
@@ -1,4 +1,4 @@
-module Design.View.Payment.Header
+module Design.View.Payment.HeaderInfos
   ( design
   ) where
 
@@ -12,12 +12,14 @@ import qualified Design.Media     as Media
 
 design :: Css
 design = do
-  Media.desktop $ marginBottom (em 2)
-  Media.mobileTablet $ marginBottom (em 1)
-  marginLeft (pct Constants.blockPercentMargin)
-  marginRight (pct Constants.blockPercentMargin)
 
-  ".g-HeaderInfos__ExceedingPayers" ? do
+  ".g-PaymentHeaderInfos" ? do
+    Media.desktop $ marginBottom (em 2)
+    Media.mobileTablet $ marginBottom (em 1)
+    marginLeft (pct Constants.blockPercentMargin)
+    marginRight (pct Constants.blockPercentMargin)
+
+  ".g-PaymentHeaderInfos__ExceedingPayers" ? do
     backgroundColor Color.mossGreen
     borderRadius (px 5) (px 5) (px 5) (px 5)
     color Color.white
@@ -33,27 +35,7 @@ design = do
 
     ".userName" ? marginRight (px 8)
 
-  -- ".addPayment" ? do
-  --   Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
-  --   Media.mobile $ width (pct 100)
-
-  ".g-HeaderForm" ? do
-    marginBottom (em 1)
-    Media.mobile $ textAlign (alignSide sideCenter)
-
-    ".textInput" ? do
-      display inlineBlock
-      marginBottom (px 0)
-
-      Media.tabletDesktop $ marginRight (px 30)
-      Media.mobile $ do
-        marginBottom (em 1)
-        width (pct 100)
-
-    ".selectInput" ? do
-      Media.tabletDesktop $ display inlineBlock
-
-  ".g-HeaderInfos__Repartition" ? do
+  ".g-PaymentHeaderInfos__Repartition" ? do
     Media.tabletDesktop $ lineHeight (px Constants.inputHeight)
     Media.mobile $ lineHeight (px 25)
 
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index 1a478dc..34bbd3a 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -15,11 +15,26 @@ import qualified View.Mail.WeeklyReport as WeeklyReport
 weeklyReport :: Conf -> Maybe UTCTime -> IO UTCTime
 weeklyReport conf mbLastExecution = do
   now <- getCurrentTime
+
   case mbLastExecution of
-    Nothing -> return ()
+    Nothing ->
+      return ()
+
     Just lastExecution -> do
-      (payments, incomes, users) <- Query.run $
-        (,,) <$> PaymentPersistence.listPunctual <*> IncomePersistence.listAll <*> UserPersistence.list
-      _ <- SendMail.sendMail conf (WeeklyReport.mail conf users payments incomes lastExecution now)
+      (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
+        users <- UserPersistence.list
+        paymentRange <- PaymentPersistence.getRange
+        weekPayments <- PaymentPersistence.listModifiedSince lastExecution
+        weekIncomes <- IncomePersistence.listModifiedSince lastExecution
+        (preIncomeRepartition, postIncomeRepartition) <-
+          PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
+        return (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
+
+      _ <-
+        SendMail.sendMail
+          conf
+          (WeeklyReport.mail conf users weekPayments preIncomeRepartition postIncomeRepartition (fst <$> paymentRange) weekIncomes lastExecution now)
+
       return ()
+
   return now
diff --git a/server/src/Main.hs b/server/src/Main.hs
index 5068d10..f4d75a0 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -42,9 +42,15 @@ main = do
       User.list
 
     S.get "/api/payments" $ do
+      frequency <- S.param "frequency"
       page <- S.param "page"
       perPage <- S.param "perPage"
-      Payment.list page perPage
+      search <- S.param "search"
+      Payment.list (read frequency) page perPage search
+
+    S.get "/api/payment/category" $ do
+      name <- S.param "name"
+      Payment.searchCategory name
 
     S.post "/api/payment" $
       S.jsonData >>= Payment.create
@@ -61,9 +67,6 @@ main = do
       perPage <- S.param "perPage"
       Income.list page perPage
 
-    S.get "/api/deprecated/incomes" $ do
-      Income.deprecatedList
-
     S.post "/api/income" $
       S.jsonData >>= Income.create
 
@@ -74,9 +77,6 @@ main = do
       incomeId <- S.param "id"
       Income.delete incomeId
 
-    S.get "/api/paymentCategories" $
-      Payment.listPaymentCategories
-
     S.get "/api/categories" $
       Category.list
 
diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs
index 0cc4a03..bcdce61 100644
--- a/server/src/Model/SignIn.hs
+++ b/server/src/Model/SignIn.hs
@@ -7,7 +7,7 @@ module Model.SignIn
   ) where
 
 import           Data.Int               (Int64)
-import           Data.Maybe             (listToMaybe)
+import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
 import           Data.Time.Clock        (getCurrentTime)
 import           Data.Time.Clock        (UTCTime)
@@ -47,7 +47,7 @@ createSignInToken signInEmail =
 getSignIn :: Text -> Query (Maybe SignIn)
 getSignIn signInToken =
   Query (\conn -> do
-    listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn])
+    Maybe.listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn])
   )
 
 signInTokenToUsed :: SignInId -> Query ()
diff --git a/server/src/Payer.hs b/server/src/Payer.hs
new file mode 100644
index 0000000..d913afe
--- /dev/null
+++ b/server/src/Payer.hs
@@ -0,0 +1,170 @@
+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           Common.Model       (ExceedingPayer (..), Income (..),
+                                     User (..), UserId)
+
+data Payer = Payer
+  { _payer_userId             :: UserId
+  , _payer_preIncomePayments  :: Int
+  , _payer_postIncomePayments :: Int
+  , _payer_incomes            :: [Income]
+  }
+
+data PostPaymentPayer = PostPaymentPayer
+  { _postPaymentPayer_userId            :: UserId
+  , _postPaymentPayer_preIncomePayments :: Int
+  , _postPaymentPayer_cumulativeIncome  :: Int
+  , _postPaymentPayer_ratio             :: Float
+  }
+
+getExceedingPayers :: UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [ExceedingPayer]
+getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition firstPayment =
+  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 =
+  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
+    }
+  )
+
+exceedingPayersFromAmounts :: [(UserId, Int)] -> [ExceedingPayer]
+exceedingPayersFromAmounts userAmounts =
+  case mbMinAmount of
+    Nothing ->
+      []
+    Just minAmount ->
+      filter (\payer -> _exceedingPayer_amount payer > 0)
+        . map (\userAmount ->
+           ExceedingPayer
+             { _exceedingPayer_userId = fst userAmount
+             , _exceedingPayer_amount = snd userAmount - minAmount
+             }
+        )
+        $ userAmounts
+  where mbMinAmount = safeMinimum . map snd $ userAmounts
+
+getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer
+getPostPaymentPayer currentTime since payer =
+  PostPaymentPayer
+    { _postPaymentPayer_userId = _payer_userId payer
+    , _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer
+    , _postPaymentPayer_cumulativeIncome = cumulativeIncome
+    , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral cumulativeIncome)
+    }
+  where cumulativeIncome = cumulativeIncomesSince currentTime since (_payer_incomes payer)
+
+getFinalDiff :: Float -> PostPaymentPayer -> Int
+getFinalDiff maxRatio payer =
+  let postIncomeDiff =
+        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
+
+safeMaximum :: (Ord a) => [a] -> Maybe a
+safeMaximum [] = Nothing
+safeMaximum xs = Just . maximum $ xs
diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
index 2afe5db..00cf0a5 100644
--- a/server/src/Persistence/Category.hs
+++ b/server/src/Persistence/Category.hs
@@ -5,7 +5,7 @@ module Persistence.Category
   , delete
   ) where
 
-import           Data.Maybe             (isJust, listToMaybe)
+import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
 import           Data.Time.Clock        (getCurrentTime)
 import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
@@ -48,9 +48,9 @@ create categoryName categoryColor =
 edit :: CategoryId -> Text -> Text -> Query Bool
 edit categoryId categoryName categoryColor =
   Query (\conn -> do
-    mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
+    mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
       (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
-    if isJust mbCategory
+    if Maybe.isJust mbCategory
       then do
         now <- getCurrentTime
         SQLite.execute
@@ -65,9 +65,9 @@ edit categoryId categoryName categoryColor =
 delete :: CategoryId -> Query Bool
 delete categoryId =
   Query (\conn -> do
-    mbCategory <- fmap (\(Row c) -> c) . listToMaybe <$>
+    mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
       (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
-    if isJust mbCategory
+    if Maybe.isJust mbCategory
       then do
         now <- getCurrentTime
         SQLite.execute
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index cb2ef10..ba7ad19 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -2,17 +2,22 @@ module Persistence.Income
   ( count
   , list
   , listAll
+  , listModifiedSince
   , create
   , edit
   , delete
+  , definedForAll
   ) where
 
-import           Data.Maybe             (listToMaybe)
+import qualified Data.List              as L
+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 qualified Database.SQLite.Simple as SQLite
-import           Prelude                hiding (id)
+import           Prelude                hiding (id, until)
 
 import           Common.Model           (Income (..), IncomeId, PaymentId,
                                          UserId)
@@ -31,15 +36,15 @@ instance FromRow Row where
     SQLite.field <*>
     SQLite.field)
 
-data Count = Count Int
+data CountRow = CountRow Int
 
-instance FromRow Count where
-  fromRow = Count <$> SQLite.field
+instance FromRow CountRow where
+  fromRow = CountRow <$> SQLite.field
 
 count :: Query Int
 count =
   Query (\conn ->
-    (\[Count n] -> n) <$>
+    (Maybe.fromMaybe 0 . fmap (\(CountRow n) -> n) . Maybe.listToMaybe) <$>
       SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL"
   )
 
@@ -60,6 +65,23 @@ listAll =
       SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
   )
 
+listModifiedSince :: UTCTime -> Query [Income]
+listModifiedSince since =
+  Query (\conn ->
+    map (\(Row i) -> i) <$>
+      SQLite.query
+        conn
+        (SQLite.Query . T.intercalate " " $
+          [ "SELECT *"
+          , "FROM income"
+          , "WHERE"
+          ,   "created_at >= ?"
+          ,   "OR edited_at >= ?"
+          ,   "OR deleted_at >= ?"
+          ])
+        (Only since)
+  )
+
 create :: UserId -> Day -> Int -> Query Income
 create userId date amount =
   Query (\conn -> do
@@ -83,7 +105,7 @@ create userId date amount =
 edit :: UserId -> IncomeId -> Day -> Int -> Query (Maybe Income)
 edit userId incomeId incomeDate incomeAmount =
   Query (\conn -> do
-    mbIncome <- fmap (\(Row i) -> i) . listToMaybe <$>
+    mbIncome <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$>
       SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
     case mbIncome of
       Just income ->
@@ -114,3 +136,26 @@ delete userId paymentId =
       "UPDATE income SET deleted_at = datetime('now') WHERE id = ? AND user_id = ?"
       (paymentId, userId)
   )
+
+data UserDayRow = UserDayRow (UserId, Day)
+
+instance FromRow UserDayRow where
+  fromRow = do
+    user <- SQLite.field
+    day <- SQLite.field
+    return $ UserDayRow (user, day)
+
+definedForAll :: [UserId] -> Query (Maybe Day)
+definedForAll users =
+  Query (\conn ->
+    (fromRows . fmap (\(UserDayRow (user, day)) -> (user, day))) <$>
+      SQLite.query_
+        conn
+        "SELECT user_id, MIN(date) FROM income WHERE deleted_at IS NULL GROUP BY user_id;"
+  )
+  where
+    fromRows rows =
+      if L.sort users == L.sort (map fst rows) then
+        Maybe.listToMaybe . L.sort . map snd $ rows
+      else
+        Nothing
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index 7835c98..f75925d 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -1,33 +1,57 @@
 module Persistence.Payment
   ( count
   , find
-  , firstPunctualDay
-  , listActive
+  , getRange
   , listActivePage
-  , listPunctual
+  , listModifiedSince
   , listActiveMonthlyOrderedByName
   , create
   , createMany
   , edit
   , delete
+  , searchCategory
+  , repartition
+  , getPreAndPostPaymentRepartition
   ) where
 
-import           Data.Maybe                     (listToMaybe)
+import           Data.Map                       (Map)
+import qualified Data.Map                       as M
+import qualified Data.Maybe                     as Maybe
 import           Data.Text                      (Text)
 import qualified Data.Text                      as T
 import           Data.Time.Calendar             (Day)
+import qualified Data.Time.Calendar             as Calendar
+import           Data.Time.Clock                (UTCTime)
 import           Data.Time.Clock                (getCurrentTime)
 import           Database.SQLite.Simple         (FromRow (fromRow), Only (Only),
                                                  ToRow)
 import qualified Database.SQLite.Simple         as SQLite
 import           Database.SQLite.Simple.ToField (ToField (toField))
-import           Prelude                        hiding (id)
+import           Prelude                        hiding (id, until)
 
-import           Common.Model                   (Frequency (..), Payment (..),
-                                                 PaymentId, UserId)
+import           Common.Model                   (CategoryId, Frequency (..),
+                                                 Payment (..), PaymentId,
+                                                 User (..), UserId)
 
 import           Model.Query                    (Query (Query))
 import           Persistence.Frequency          (FrequencyField (..))
+import qualified Persistence.Income             as IncomePersistence
+
+
+
+fields :: Text
+fields = T.intercalate "," $
+  [ "id"
+  , "user_id"
+  , "name"
+  , "cost"
+  , "date"
+  , "category"
+  , "frequency"
+  , "created_at"
+  , "edited_at"
+  , "deleted_at"
+  ]
 
 newtype Row = Row Payment
 
@@ -38,6 +62,7 @@ instance FromRow Row where
     SQLite.field <*>
     SQLite.field <*>
     SQLite.field <*>
+    SQLite.field <*>
     (fmap (\(FrequencyField f) -> f) $ SQLite.field) <*>
     SQLite.field <*>
     SQLite.field <*>
@@ -51,6 +76,7 @@ instance ToRow InsertRow where
     , toField (_payment_name p)
     , toField (_payment_cost p)
     , toField (_payment_date p)
+    , toField (_payment_category p)
     , toField (FrequencyField (_payment_frequency p))
     , toField (_payment_createdAt p)
     ]
@@ -60,73 +86,94 @@ data Count = Count Int
 instance FromRow Count where
   fromRow = Count <$> SQLite.field
 
-count :: Query Int
-count =
+count :: Frequency -> Text -> Query Int
+count frequency search =
   Query (\conn ->
     (\[Count n] -> n) <$>
-      SQLite.query_ conn "SELECT COUNT(*) FROM payment WHERE deleted_at IS NULL"
+      SQLite.query
+        conn
+        (SQLite.Query $ T.intercalate " "
+          [ "SELECT COUNT(*)"
+          , "FROM payment"
+          , "WHERE"
+          ,   "deleted_at IS NULL"
+          ,   "AND frequency = ?"
+          ,   "AND name LIKE ?"
+          ])
+        (FrequencyField frequency, "%" <> search <> "%")
   )
 
 find :: PaymentId -> Query (Maybe Payment)
 find paymentId =
   Query (\conn -> do
-    fmap (\(Row p) -> p) . listToMaybe <$>
-      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+    fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
+      SQLite.query
+        conn
+        (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ?")
+        (Only paymentId)
   )
 
-data DayRow = DayRow Day
+data RangeRow = RangeRow (Day, Day)
 
-instance FromRow DayRow where
-  fromRow = DayRow <$> SQLite.field
+instance FromRow RangeRow where
+  fromRow = (\f t -> RangeRow (f, t)) <$> SQLite.field <*> SQLite.field
 
-firstPunctualDay :: Query (Maybe Day)
-firstPunctualDay =
+getRange :: Query (Maybe (Day, Day))
+getRange =
   Query (\conn -> do
-    fmap (\(DayRow d) -> d) . listToMaybe <$>
+    fmap (\(RangeRow (f, t)) -> (f, t)) . Maybe.listToMaybe <$>
       SQLite.query
         conn
-        "SELECT date FROM payment WHERE frequency = ? AND deleted_at IS NULL ORDER BY date LIMIT 1"
+        (SQLite.Query $ T.intercalate " "
+          [ "SELECT MIN(date), MAX(date)"
+          , "FROM payment"
+          , "WHERE"
+          ,   "frequency = ?"
+          ,   "AND deleted_at IS NULL"
+          ])
         (Only (FrequencyField Punctual))
   )
 
-listActive :: Frequency -> Query [Payment]
-listActive frequency =
-  Query (\conn -> do
-    map (\(Row p) -> p) <$>
-      SQLite.query
-        conn
-        "SELECT * FROM payment WHERE deleted_at IS NULL AND frequency = ?"
-        (Only (FrequencyField frequency))
-  )
-
-listActivePage :: Int -> Int -> Query [Payment]
-listActivePage page perPage =
+listActivePage :: Frequency -> Int -> Int -> Text -> Query [Payment]
+listActivePage frequency page perPage search =
   Query (\conn ->
     map (\(Row p) -> p) <$>
       SQLite.query
         conn
         (SQLite.Query $ T.intercalate " "
-          [ "SELECT *"
+          [ "SELECT"
+          , fields
           , "FROM payment"
-          , "WHERE deleted_at IS NULL AND frequency = ?"
+          , "WHERE"
+          ,   "deleted_at IS NULL"
+          ,   "AND frequency = ?"
+          ,   "AND name LIKE ?"
           , "ORDER BY date DESC"
           , "LIMIT ?"
           , "OFFSET ?"
           ]
         )
-        (FrequencyField Punctual, perPage, (page - 1) * perPage)
+        (FrequencyField frequency, "%" <> search <> "%", perPage, (page - 1) * perPage)
   )
 
-listPunctual :: Query [Payment]
-listPunctual =
-  Query (\conn -> do
-    map (\(Row p) -> p) <$>
+listModifiedSince :: UTCTime -> Query [Payment]
+listModifiedSince since =
+  Query (\conn ->
+    map (\(Row i) -> i) <$>
       SQLite.query
         conn
-        (SQLite.Query "SELECT * FROM payment WHERE frequency = ?")
-        (Only (FrequencyField Punctual))
+        (SQLite.Query . T.intercalate " " $
+          [ "SELECT *"
+          , "FROM payment"
+          , "WHERE"
+          ,   "created_at >= ?"
+          ,   "OR edited_at >= ?"
+          ,   "OR deleted_at >= ?"
+          ])
+        (Only since)
   )
 
+
 listActiveMonthlyOrderedByName :: Query [Payment]
 listActiveMonthlyOrderedByName =
   Query (\conn -> do
@@ -134,7 +181,8 @@ listActiveMonthlyOrderedByName =
       SQLite.query
         conn
         (SQLite.Query $ T.intercalate " "
-          [ "SELECT *"
+          [ "SELECT"
+          , fields
           , "FROM payment"
           , "WHERE deleted_at IS NULL AND frequency = ?"
           , "ORDER BY name DESC"
@@ -142,17 +190,17 @@ listActiveMonthlyOrderedByName =
         (Only (FrequencyField Monthly))
   )
 
-create :: UserId -> Text -> Int -> Day -> Frequency -> Query Payment
-create userId name cost date frequency =
+create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Payment
+create userId name cost date category frequency =
   Query (\conn -> do
     time <- getCurrentTime
     SQLite.execute
       conn
       (SQLite.Query $ T.intercalate " "
-        [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
-        , "VALUES (?, ?, ?, ?, ?, ?)"
+        [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)"
+        , "VALUES (?, ?, ?, ?, ?, ?, ?)"
         ])
-      (userId, name, cost, date, FrequencyField frequency, time)
+      (userId, name, cost, date, category, FrequencyField frequency, time)
     paymentId <- SQLite.lastInsertRowId conn
     return $ Payment
       { _payment_id        = paymentId
@@ -160,6 +208,7 @@ create userId name cost date frequency =
       , _payment_name      = name
       , _payment_cost      = cost
       , _payment_date      = date
+      , _payment_category  = category
       , _payment_frequency = frequency
       , _payment_createdAt = time
       , _payment_editedAt  = Nothing
@@ -173,19 +222,19 @@ createMany payments =
     SQLite.executeMany
       conn
       (SQLite.Query $ T.intercalate ""
-        [ "INSERT INTO payment (user_id, name, cost, date, frequency, created_at)"
-        , "VALUES (?, ?, ?, ?, ?, ?)"
+        [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)"
+        , "VALUES (?, ?, ?, ?, ?, ?, ?)"
         ])
       (map InsertRow payments)
   )
 
-edit :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query (Maybe (Payment, Payment))
-edit userId paymentId name cost date frequency =
+edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query (Maybe Payment)
+edit userId paymentId name cost date category frequency =
   Query (\conn -> do
-    mbPayment <- fmap (\(Row p) -> p) . listToMaybe <$>
+    mbPayment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
       SQLite.query
         conn
-        "SELECT * FROM payment WHERE id = ? and user_id = ?"
+        (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ? and user_id = ?")
         (paymentId, userId)
     case mbPayment of
       Just payment -> do
@@ -200,6 +249,7 @@ edit userId paymentId name cost date frequency =
             , "  name = ?,"
             , "  cost = ?,"
             , "  date = ?,"
+            , "  category = ?,"
             , "  frequency = ?"
             , "WHERE"
             , "  id = ?"
@@ -209,16 +259,18 @@ edit userId paymentId name cost date frequency =
           , name
           , cost
           , date
+          , category
           , FrequencyField frequency
           , paymentId
           , userId
           )
-        return . Just . (,) payment $ Payment
+        return . Just $ Payment
           { _payment_id        = paymentId
           , _payment_user      = userId
           , _payment_name      = name
           , _payment_cost      = cost
           , _payment_date      = date
+          , _payment_category  = category
           , _payment_frequency = frequency
           , _payment_createdAt = _payment_createdAt payment
           , _payment_editedAt  = Just now
@@ -236,3 +288,59 @@ delete userId paymentId =
       "UPDATE payment SET deleted_at = datetime('now') WHERE id = ? AND user_id = ?"
       (paymentId, userId)
   )
+
+data CategoryIdRow = CategoryIdRow CategoryId
+
+instance FromRow CategoryIdRow where
+  fromRow = CategoryIdRow <$> SQLite.field
+
+searchCategory :: Text -> Query (Maybe CategoryId)
+searchCategory paymentName =
+  Query (\conn ->
+    fmap (\(CategoryIdRow d) -> d) . Maybe.listToMaybe <$>
+      SQLite.query
+        conn
+        "SELECT category FROM payment WHERE name LIKE ? LIMIT 1"
+        (Only $ "%" <> paymentName <> "%")
+  )
+
+data UserCostRow = UserCostRow (UserId, Int)
+
+instance FromRow UserCostRow where
+  fromRow = do
+    user <- SQLite.field
+    cost <- SQLite.field
+    return $ UserCostRow (user, cost)
+
+repartition :: Frequency -> Text -> Day -> Day -> Query (Map UserId Int)
+repartition frequency search from to =
+  Query (\conn ->
+    M.fromList . fmap (\(UserCostRow r) -> r) <$> SQLite.query
+      conn
+      (SQLite.Query . T.intercalate " " $
+        [ "SELECT user_id, SUM(cost)"
+        , "FROM payment"
+        , "WHERE"
+        ,   "deleted_at IS NULL"
+        ,   "AND frequency = ?"
+        ,   "AND name LIKE ?"
+        ,   "AND date >= ?"
+        ,   "AND date < ?"
+        , "GROUP BY user_id"
+        ])
+      (FrequencyField frequency, "%" <> search <> "%", from, to)
+  )
+
+getPreAndPostPaymentRepartition :: Maybe (Day, Day) -> [User] -> Query (Map UserId Int, Map UserId Int)
+getPreAndPostPaymentRepartition paymentRange users = do
+  case paymentRange of
+    Just (from, to) -> do
+      incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
+      (,)
+        <$> (repartition Punctual "" from (Maybe.fromMaybe (Calendar.addDays 1 to) incomeDefinedForAll))
+        <*> (case incomeDefinedForAll of
+          Just d  -> repartition Punctual "" d (Calendar.addDays 1 to)
+          Nothing -> return M.empty)
+
+    Nothing ->
+      return (M.empty, M.empty)
diff --git a/server/src/Persistence/PaymentCategory.hs b/server/src/Persistence/PaymentCategory.hs
deleted file mode 100644
index 46be7f5..0000000
--- a/server/src/Persistence/PaymentCategory.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-module Persistence.PaymentCategory
-  ( list
-  , listByCategory
-  , save
-  , deleteIfUnused
-  ) where
-
-import qualified Data.Maybe             as Maybe
-import           Data.Text              (Text)
-import qualified Data.Text              as T
-import           Data.Time.Clock        (getCurrentTime)
-import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
-import qualified Database.SQLite.Simple as SQLite
-
-import           Common.Model           (CategoryId, PaymentCategory (..))
-
-import           Model.Query            (Query (Query))
-
-newtype Row = Row PaymentCategory
-
-instance FromRow Row where
-  fromRow = Row <$> (PaymentCategory <$>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field <*>
-    SQLite.field)
-
-list :: Query [PaymentCategory]
-list =
-  Query (\conn -> do
-    map (\(Row pc) -> pc) <$>
-      SQLite.query_ conn "SELECT * from payment_category"
-  )
-
-listByCategory :: CategoryId -> Query [PaymentCategory]
-listByCategory cat =
-  Query (\conn -> do
-    map (\(Row pc) -> pc) <$>
-      SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat)
-  )
-
-save :: Text -> CategoryId -> Query PaymentCategory
-save newName categoryId =
-  Query (\conn -> do
-    now <- getCurrentTime
-    paymentCategory <- fmap (\(Row pc) -> pc) . Maybe.listToMaybe <$>
-      (SQLite.query
-        conn
-        "SELECT * FROM payment_category WHERE name = ?"
-        (Only formattedNewName))
-    case paymentCategory of
-      Just pc ->
-        do
-          SQLite.execute
-            conn
-            "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?"
-            (categoryId, now, formattedNewName)
-          return $ PaymentCategory
-            (_paymentCategory_id pc)
-            formattedNewName
-            categoryId
-            (_paymentCategory_createdAt pc)
-            (Just now)
-      Nothing ->
-        do
-          SQLite.execute
-            conn
-            "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)"
-            (formattedNewName, categoryId, now)
-          paymentCategoryId <- SQLite.lastInsertRowId conn
-          return $ PaymentCategory
-            paymentCategoryId
-            formattedNewName
-            categoryId
-            now
-            Nothing
-  )
-  where
-    formattedNewName = T.toLower newName
-
-deleteIfUnused :: Text -> Query ()
-deleteIfUnused name =
-  Query (\conn ->
-    SQLite.execute
-      conn
-      "DELETE FROM payment_category WHERE name = lower(?) AND name NOT IN (SELECT DISTINCT lower(name) FROM payment WHERE lower(name) = lower(?) AND deleted_at IS NULL)"
-      (name, name)
-  ) >> return ()
diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs
index 4ec2dcf..3c3a2b1 100644
--- a/server/src/Persistence/User.hs
+++ b/server/src/Persistence/User.hs
@@ -3,7 +3,7 @@ module Persistence.User
   , get
   ) where
 
-import           Data.Maybe             (listToMaybe)
+import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
 import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
 import qualified Database.SQLite.Simple as SQLite
@@ -32,6 +32,6 @@ list =
 get :: Text -> Query (Maybe User)
 get userEmail =
   Query (\conn -> do
-    fmap (\(Row u) -> u) . listToMaybe <$>
+    fmap (\(Row u) -> u) . Maybe.listToMaybe <$>
       SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
   )
diff --git a/server/src/Util/List.hs b/server/src/Util/List.hs
deleted file mode 100644
index 4e22ba8..0000000
--- a/server/src/Util/List.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Util.List
-  ( groupBy
-  ) where
-
-import           Control.Arrow ((&&&))
-import           Data.Function (on)
-import qualified Data.List     as L
-
-groupBy :: forall a b. (Ord b) => (a -> b) -> [a] -> [(b, [a])]
-groupBy f =
-  map (f . head &&& id)
-    . L.groupBy ((==) `on` f)
-    . L.sortBy (compare `on` f)
diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 7e88d98..1f637bc 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -9,6 +9,7 @@ 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 (..),
@@ -23,10 +24,11 @@ import           Model.IncomeResource  (IncomeResource (..))
 import           Model.Mail            (Mail (Mail))
 import qualified Model.Mail            as M
 import           Model.PaymentResource (PaymentResource (..))
+import qualified Payer                 as Payer
 import           Resource              (Status (..), groupByStatus, statuses)
 
-mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
-mail conf users payments incomes start end =
+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
     { M.from = Conf.noReplyMail conf
     , M.to = map _user_email users
@@ -35,24 +37,24 @@ mail conf users payments incomes start end =
         , " − "
         , Msg.get Msg.WeeklyReport_Title
         ]
-    , M.body = body conf users payments incomes start end
+    , M.body = body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end
     }
 
-body :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Text
-body conf users payments incomes 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 =
   T.intercalate "\n" $
-    [ exceedingPayers conf end users incomes (filter (null . _payment_deletedAt) payments)
+    [ exceedingPayers conf end users incomes preIncomeRepartition postIncomeRepartition firstPayment
     , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
     ]
       where
-        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ payments
+        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
         incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes
 
-exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
-exceedingPayers conf time users incomes payments =
+exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> Text
+exceedingPayers conf time users incomes preIncomeRepartition postIncomeRepartition firstPayment =
   T.intercalate "\n" . map formatPayer $ payers
   where
-    payers = CM.getExceedingPayers time users incomes payments
+    payers = Payer.getExceedingPayers time users incomes preIncomeRepartition postIncomeRepartition firstPayment
     formatPayer p = T.concat
       [ "  * "
       , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users