Show payment header infos

24 files changed, 346 insertions, 434 deletions

diff --git a/client/client.cabal b/client/client.cabal
index 75c2c1b..78ea7d3 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -61,7 +61,6 @@ Executable client
     Util.Ajax
     Util.Css
     Util.Either
-    Util.List
     Util.Reflex
     Util.Router
     Util.Validation
@@ -76,8 +75,8 @@ Executable client
     View.Income.Table
     View.NotFound
     View.Payment.Form
-    View.Payment.Header
-    View.Payment.Init
+    View.Payment.HeaderForm
+    View.Payment.HeaderInfos
     View.Payment.Payment
     View.Payment.Reducer
     View.Payment.Table
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
deleted file mode 100644
index c8ca347..0000000
--- a/client/src/View/Payment/Header.hs
+++ /dev/null
@@ -1,187 +0,0 @@
-module View.Payment.Header
-  ( view
-  , In(..)
-  , Out(..)
-  ) where
-
-import           Control.Monad          (forM_)
-import           Control.Monad.IO.Class (liftIO)
-import qualified Data.List              as L hiding (groupBy)
-import qualified Data.Map               as M
-import           Data.Maybe             (fromMaybe)
-import           Data.Text              (Text)
-import qualified Data.Text              as T
-import           Data.Time              (NominalDiffTime)
-import qualified Data.Time              as Time
-import qualified Data.Validation        as V
-import           Prelude                hiding (init)
-import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom             as R
-
-import           Common.Model           (Category, Currency,
-                                         ExceedingPayer (..), Frequency (..),
-                                         Income (..), Payment (..),
-                                         PaymentCategory, SavedPayment (..),
-                                         User (..))
-import qualified Common.Model           as CM
-import qualified Common.Msg             as Msg
-import qualified Common.View.Format     as Format
-
-import qualified Component.Button       as Button
-import qualified Component.Input        as Input
-import qualified Component.Modal        as Modal
-import qualified Component.Select       as Select
-import qualified Util.List              as L
-import qualified View.Payment.Form      as Form
-import           View.Payment.Init      (Init (..))
-
-data In t = In
-  { _in_init              :: Init
-  , _in_currency          :: Currency
-  , _in_payments          :: Dynamic t [Payment]
-  , _in_searchPayments    :: Dynamic t [Payment]
-  , _in_paymentCategories :: Dynamic t [PaymentCategory]
-  }
-
-data Out t = Out
-  { _out_searchName      :: Dynamic t Text
-  , _out_searchFrequency :: Dynamic t Frequency
-  , _out_addPayment      :: Event t SavedPayment
-  }
-
-view :: forall t m. MonadWidget t m => In t -> m (Out t)
-view input =
-  R.divClass "header" $ do
-    rec
-      addPayment <-
-        payerAndAdd
-          incomes
-          payments
-          users
-          categories
-          paymentCategories
-          currency
-          searchFrequency
-      let resetSearchName = fmap (const ()) $ addPayment
-      (searchName, searchFrequency)  <- searchLine resetSearchName
-
-      infos (_in_searchPayments input) users currency
-
-    return $ Out
-      { _out_searchName = searchName
-      , _out_searchFrequency = searchFrequency
-      , _out_addPayment = addPayment
-      }
-  where
-    init = _in_init input
-    incomes = _init_incomes init
-    initPayments = _init_payments init
-    payments = _in_payments input
-    users = _init_users init
-    categories = _init_categories init
-    currency = _in_currency input
-    paymentCategories = _in_paymentCategories input
-
-payerAndAdd
-  :: forall t m. MonadWidget t m
-  => [Income]
-  -> Dynamic t [Payment]
-  -> [User]
-  -> [Category]
-  -> Dynamic t [PaymentCategory]
-  -> Currency
-  -> Dynamic t Frequency
-  -> m (Event t SavedPayment)
-payerAndAdd incomes payments users categories paymentCategories currency frequency = do
-  time <- liftIO Time.getCurrentTime
-  R.divClass "payerAndAdd" $ do
-
-    let exceedingPayers =
-          R.ffor payments $ \ps ->
-            CM.getExceedingPayers time users incomes $
-              filter ((==) Punctual . _payment_frequency) ps
-
-    R.divClass "exceedingPayers" $
-      R.simpleList exceedingPayers $ \exceedingPayer ->
-        R.elClass "span" "exceedingPayer" $ do
-          R.elClass "span" "userName" $
-            R.dynText . R.ffor exceedingPayer $ \ep ->
-              fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId ep) users
-          R.elClass "span" "amount" $ do
-            R.text "+ "
-            R.dynText . R.ffor exceedingPayer $ \ep ->
-              Format.price currency $ _exceedingPayer_amount ep
-
-    addPayment <- Button._out_clic <$>
-      (Button.view $
-        (Button.defaultIn (R.text $ Msg.get Msg.Payment_Add))
-          { Button._in_class = R.constDyn "addPayment"
-          })
-
-    Modal.view $ Modal.In
-      { Modal._in_show    = addPayment
-      , Modal._in_content = \_ -> return (R.never, R.never) -- TODO
-      }
-
-searchLine
-  :: forall t m. MonadWidget t m
-  => Event t ()
-  -> m (Dynamic t Text, Dynamic t Frequency)
-searchLine reset = do
-  R.divClass "searchLine" $ do
-    searchName <- Input._out_raw <$> (Input.view
-      ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name })
-      ("" <$ reset)
-      R.never)
-
-    let frequencies = M.fromList
-          [ (Punctual, Msg.get Msg.Payment_PunctualMale)
-          , (Monthly, Msg.get Msg.Payment_MonthlyMale)
-          ]
-
-    searchFrequency <- Select._out_raw <$> (Select.view $ Select.In
-        { Select._in_label        = ""
-        , Select._in_initialValue = Punctual
-        , Select._in_value        = R.never
-        , Select._in_values       = R.constDyn frequencies
-        , Select._in_reset        = R.never
-        , Select._in_isValid      = V.Success
-        , Select._in_validate     = R.never
-        })
-
-    return (searchName, searchFrequency)
-
-infos
-  :: forall t m. MonadWidget t m
-  => Dynamic t [Payment]
-  -> [User]
-  -> Currency -> m ()
-infos payments users currency =
-  R.divClass "infos" $ do
-
-    R.elClass "span" "total" $ do
-      R.dynText $ do
-        ps <- payments
-        let paymentCount = length ps
-            total = sum . map _payment_cost $ ps
-        pure . Msg.get $ Msg.Payment_Worth
-          (T.intercalate " "
-            [ (Format.number paymentCount)
-            , if paymentCount > 1
-                then Msg.get Msg.Payment_Many
-                else Msg.get Msg.Payment_One
-            ])
-          (Format.price currency total)
-
-    R.elClass "span" "partition" . R.dynText $ do
-      ps <- payments
-      let totalByUser =
-            L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
-              . map (\(u, xs) -> (u, sum . map snd $ xs))
-              . L.groupBy fst
-              . map (\p -> (_payment_user p, _payment_cost p))
-              $ ps
-      pure . T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) ->
-        Msg.get $ Msg.Payment_By
-          (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
-          (Format.price currency userTotal)
diff --git a/client/src/View/Payment/HeaderForm.hs b/client/src/View/Payment/HeaderForm.hs
new file mode 100644
index 0000000..07a6b81
--- /dev/null
+++ b/client/src/View/Payment/HeaderForm.hs
@@ -0,0 +1,78 @@
+module View.Payment.HeaderForm
+  ( view
+  ) where
+
+import qualified Data.Map          as M
+import           Data.Text         (Text)
+import qualified Data.Validation   as V
+import           Reflex.Dom        (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom        as R
+
+import           Common.Model      (Category, Currency, ExceedingPayer (..),
+                                    Frequency (..), Income (..), Payment (..),
+                                    PaymentCategory, SavedPayment (..),
+                                    User (..))
+import qualified Common.Msg        as Msg
+
+import qualified Component.Button  as Button
+import qualified Component.Input   as Input
+import qualified Component.Modal   as Modal
+import qualified Component.Select  as Select
+import qualified View.Payment.Form as Form
+
+data In t = In
+  { _in_reset             :: Event t ()
+  , _in_categories        :: [Category]
+  , _in_paymentCategories :: [PaymentCategory]
+  }
+
+data Out = Out
+  { _out_name       :: Event t Text
+  , _out_frequency  :: Event t Frequency
+  , _out_addPayment :: Event t SavedPayment
+  }
+
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input = do
+  R.divClass "g-HeaderForm" $ do
+    searchName <- Input._out_raw <$> (Input.view
+      ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name })
+      ("" <$ _in_reset input)
+      R.never)
+
+    let frequencies = M.fromList
+          [ (Punctual, Msg.get Msg.Payment_PunctualMale)
+          , (Monthly, Msg.get Msg.Payment_MonthlyMale)
+          ]
+
+    searchFrequency <- Select._out_raw <$> (Select.view $ Select.In
+        { Select._in_label        = ""
+        , Select._in_initialValue = Punctual
+        , Select._in_value        = R.never
+        , Select._in_values       = R.constDyn frequencies
+        , Select._in_reset        = R.never
+        , Select._in_isValid      = V.Success
+        , Select._in_validate     = R.never
+        })
+
+    addPaymentButton <- Button._out_clic <$>
+      (Button.view $
+        (Button.defaultIn (R.text $ Msg.get Msg.Payment_Add))
+          { Button._in_class = R.constDyn "addPayment"
+          })
+
+    addPayment <- Modal.view $ Modal.In
+      { Modal._in_show    = addPaymentButton
+      , Modal._in_content =
+        Form.view $ Form.In
+          { Form._in_categories = _in_categories input
+          , Form._in_paymentCategories = _in_paymentCategories input
+          , Form._in_operation = Form.New searchFrequency
+          }
+      }
+
+    return $ Out
+      { _out_name = searchName
+      , _out_frequency = searchFrequency
+      , _out_addPayment = addPayment
+      }
diff --git a/client/src/View/Payment/HeaderInfos.hs b/client/src/View/Payment/HeaderInfos.hs
new file mode 100644
index 0000000..12facc4
--- /dev/null
+++ b/client/src/View/Payment/HeaderInfos.hs
@@ -0,0 +1,96 @@
+module View.Payment.HeaderInfos
+  ( view
+  , In(..)
+  ) where
+
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.List              as L hiding (groupBy)
+import           Data.Map               (Map)
+import qualified Data.Map               as M
+import           Data.Maybe             (fromMaybe)
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import qualified Data.Time              as Time
+import           Reflex.Dom             (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom             as R
+
+import           Common.Model           (Currency, ExceedingPayer (..),
+                                         Payment (..), PaymentHeader (..),
+                                         SavedPayment (..), User (..), UserId)
+import qualified Common.Model           as CM
+import qualified Common.Msg             as Msg
+import qualified Common.View.Format     as Format
+
+import qualified Util.List              as L
+
+data In t = In
+  { _in_users        :: [User]
+  , _in_currency     :: Currency
+  , _in_header       :: PaymentHeader
+  , _in_paymentCount :: Int
+  }
+
+view :: forall t m. MonadWidget t m => In t -> m ()
+view input =
+  R.divClass "g-HeaderInfos" $ do
+      exceedingPayers
+        (_in_users input)
+        (_in_currency input)
+        (_paymentHeader_exceedingPayers header)
+
+      infos
+        (_in_users input)
+        (_in_currency input)
+        (_paymentHeader_repartition header)
+        (_in_paymentCount input)
+
+  where
+    header = _in_header input
+
+exceedingPayers
+  :: forall t m. MonadWidget t m
+  => [User]
+  -> Currency
+  -> [ExceedingPayer]
+  -> m ()
+exceedingPayers users currency payers =
+  R.divClass "g-HeaderInfos__ExceedingPayers" $
+    flip mapM_ payers $ \payer ->
+      R.elClass "span" "exceedingPayer" $ do
+        R.elClass "span" "userName" $
+          R.text $
+            fromMaybe "" . fmap _user_name $ CM.findUser (_exceedingPayer_userId payer) users
+        R.elClass "span" "amount" $ do
+          R.text "+ "
+          R.text . Format.price currency $ _exceedingPayer_amount payer
+
+infos
+  :: forall t m. MonadWidget t m
+  => [User]
+  -> Currency
+  -> Map UserId Int
+  -> Int
+  -> m ()
+infos users currency repartition paymentCount =
+  R.divClass "g-HeaderInfos__Repartition" $ do
+
+    R.elClass "span" "total" $ do
+      R.text $
+        Msg.get $ Msg.Payment_Worth
+          (T.intercalate " "
+            [ (Format.number paymentCount)
+            , if paymentCount > 1
+                then Msg.get Msg.Payment_Many
+                else Msg.get Msg.Payment_One
+            ])
+          (Format.price currency (M.foldl (+) 0 repartition))
+
+    R.elClass "span" "partition" . R.text $
+      let totalByUser =
+            L.sortBy (\(_, t1) (_, t2) -> compare t2 t1)
+              . M.toList
+              $ repartition
+      in  T.intercalate ", " . flip map totalByUser $ \(userId, userTotal) ->
+            Msg.get $ Msg.Payment_By
+              (fromMaybe "" . fmap _user_name $ CM.findUser userId users)
+              (Format.price currency userTotal)
diff --git a/client/src/View/Payment/Init.hs b/client/src/View/Payment/Init.hs
deleted file mode 100644
index d9f85c8..0000000
--- a/client/src/View/Payment/Init.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module View.Payment.Init
-  ( Init(..)
-  ) where
-
-import           Common.Model (Category, Income, Payment, PaymentCategory, User)
-
-data Init = Init
-  { _init_users             :: [User]
-  , _init_payments          :: [Payment]
-  , _init_incomes           :: [Income]
-  , _init_categories        :: [Category]
-  , _init_paymentCategories :: [PaymentCategory]
-  } deriving (Show)
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index bf0186f..f47b627 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -3,29 +3,29 @@ module View.Payment.Payment
   , In(..)
   ) where
 
-import qualified Data.Maybe           as Maybe
-import           Data.Text            (Text)
-import qualified Data.Text            as T
-import           Data.Time.Clock      (NominalDiffTime)
-import           Prelude              hiding (init)
-import           Reflex.Dom           (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom           as R
-
-import           Common.Model         (Currency, Frequency, Income (..),
-                                       Payment (..), PaymentCategory (..),
-                                       PaymentId, PaymentPage (..),
-                                       SavedPayment (..), User, UserId)
-import qualified Common.Util.Text     as T
-
-import qualified Component.Pages      as Pages
-import           Loadable             (Loadable (..))
+import qualified Data.Maybe               as Maybe
+import           Data.Text                (Text)
+import qualified Data.Text                as T
+import           Data.Time.Clock          (NominalDiffTime)
+import           Prelude                  hiding (init)
+import           Reflex.Dom               (Dynamic, Event, MonadWidget, Reflex)
+import qualified Reflex.Dom               as R
+
+import           Common.Model             (Currency, Frequency, Income (..),
+                                           Payment (..), PaymentCategory (..),
+                                           PaymentId, PaymentPage (..),
+                                           SavedPayment (..), User, UserId)
+import qualified Common.Util.Text         as T
+
+import qualified Component.Pages          as Pages
+import           Loadable                 (Loadable (..))
 import qualified Loadable
-import qualified Util.Ajax            as AjaxUtil
-import qualified Util.Reflex          as ReflexUtil
-import qualified View.Payment.Header  as Header
-import           View.Payment.Init    (Init (..))
-import qualified View.Payment.Reducer as Reducer
-import qualified View.Payment.Table   as Table
+import qualified Util.Ajax                as AjaxUtil
+import qualified Util.Reflex              as ReflexUtil
+import qualified View.Payment.HeaderInfos as HeaderInfos
+-- import qualified View.Payment.HeaderForm as HeaderForm
+import qualified View.Payment.Reducer     as Reducer
+import qualified View.Payment.Table       as Table
 
 data In t = In
   { _in_currentUser :: UserId
@@ -61,7 +61,14 @@ view input = do
       deletePayment <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
 
       result <- R.dyn . R.ffor ((,) <$> payments <*> currentPage) $ \(is, p) ->
-        flip Loadable.view is $ \(PaymentPage payments paymentCategories count) -> do
+        flip Loadable.view is $ \(PaymentPage header payments paymentCategories count) -> do
+          HeaderInfos.view $ HeaderInfos.In
+            { HeaderInfos._in_users = _in_users input
+            , HeaderInfos._in_currency = _in_currency input
+            , HeaderInfos._in_header = header
+            , HeaderInfos._in_paymentCount = count
+            }
+
           table <- Table.view $ Table.In
             { Table._in_users = _in_users input
             , Table._in_currentUser = _in_currentUser input
diff --git a/common/common.cabal b/common/common.cabal
index 4a6d728..75d6cc8 100644
--- a/common/common.cabal
+++ b/common/common.cabal
@@ -59,6 +59,7 @@ Library
     Common.Model.EditIncome
     Common.Model.EditIncomeForm
     Common.Model.EditPaymentForm
+    Common.Model.ExceedingPayer
     Common.Model.Frequency
     Common.Model.Income
     Common.Model.IncomeHeader
@@ -67,4 +68,5 @@ Library
     Common.Model.InitResult
     Common.Model.Payer
     Common.Model.PaymentCategory
+    Common.Model.PaymentHeader
     Common.Model.PaymentPage
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index bc626d5..fdeac36 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -10,6 +10,7 @@ import           Common.Model.EditIncome        as X
 import           Common.Model.EditIncomeForm    as X
 import           Common.Model.EditPaymentForm   as X
 import           Common.Model.Email             as X
+import           Common.Model.ExceedingPayer    as X
 import           Common.Model.Frequency         as X
 import           Common.Model.Income            as X
 import           Common.Model.IncomeHeader      as X
@@ -19,6 +20,7 @@ import           Common.Model.InitResult        as X
 import           Common.Model.Payer             as X
 import           Common.Model.Payment           as X
 import           Common.Model.PaymentCategory   as X
+import           Common.Model.PaymentHeader     as X
 import           Common.Model.PaymentPage       as X
 import           Common.Model.SavedPayment      as X
 import           Common.Model.SignInForm        as X
diff --git a/common/src/Common/Model/ExceedingPayer.hs b/common/src/Common/Model/ExceedingPayer.hs
new file mode 100644
index 0000000..171b6ff
--- /dev/null
+++ b/common/src/Common/Model/ExceedingPayer.hs
@@ -0,0 +1,16 @@
+module Common.Model.ExceedingPayer
+  ( ExceedingPayer(..)
+  ) where
+
+import           Data.Aeson        (FromJSON, ToJSON)
+import           GHC.Generics      (Generic)
+
+import           Common.Model.User (UserId)
+
+data ExceedingPayer = ExceedingPayer
+  { _exceedingPayer_userId :: UserId
+  , _exceedingPayer_amount :: Int
+  } deriving (Show, Generic)
+
+instance FromJSON ExceedingPayer
+instance ToJSON ExceedingPayer
diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs
index 3c816c8..39a5788 100644
--- a/common/src/Common/Model/Payer.hs
+++ b/common/src/Common/Model/Payer.hs
@@ -1,19 +1,19 @@
 module Common.Model.Payer
-  ( ExceedingPayer(..)
-  , getExceedingPayers
+  ( getExceedingPayers
   , useIncomesFrom
   , cumulativeIncomesSince
   ) where
 
-import qualified Data.List            as List
-import qualified Data.Maybe           as Maybe
-import           Data.Time            (NominalDiffTime, UTCTime (..))
-import qualified Data.Time            as Time
-import           Data.Time.Calendar   (Day)
+import qualified Data.List                   as List
+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.Income  (Income (..))
-import           Common.Model.Payment (Payment (..))
-import           Common.Model.User    (User (..), UserId)
+import           Common.Model.ExceedingPayer (ExceedingPayer (..))
+import           Common.Model.Income         (Income (..))
+import           Common.Model.Payment        (Payment (..))
+import           Common.Model.User           (User (..), UserId)
 
 data Payer = Payer
   { _payer_userId             :: UserId
@@ -29,11 +29,6 @@ data PostPaymentPayer = PostPaymentPayer
   , _postPaymentPayer_ratio             :: Float
   }
 
-data ExceedingPayer = ExceedingPayer
-  { _exceedingPayer_userId :: UserId
-  , _exceedingPayer_amount :: Int
-  } deriving (Show)
-
 getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer]
 getExceedingPayers currentTime users incomes payments =
   let userIds = map _user_id users
diff --git a/common/src/Common/Model/PaymentHeader.hs b/common/src/Common/Model/PaymentHeader.hs
new file mode 100644
index 0000000..a522cd8
--- /dev/null
+++ b/common/src/Common/Model/PaymentHeader.hs
@@ -0,0 +1,18 @@
+module Common.Model.PaymentHeader
+  ( PaymentHeader(..)
+  ) where
+
+import           Data.Aeson                  (FromJSON, ToJSON)
+import           Data.Map                    (Map)
+import           GHC.Generics                (Generic)
+
+import           Common.Model.ExceedingPayer (ExceedingPayer)
+import           Common.Model.User           (UserId)
+
+data PaymentHeader = PaymentHeader
+  { _paymentHeader_exceedingPayers :: [ExceedingPayer]
+  , _paymentHeader_repartition     :: Map UserId Int
+  } deriving (Show, Generic)
+
+instance FromJSON PaymentHeader
+instance ToJSON PaymentHeader
diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs
index 31039c7..76c7511 100644
--- a/common/src/Common/Model/PaymentPage.hs
+++ b/common/src/Common/Model/PaymentPage.hs
@@ -7,9 +7,11 @@ import           GHC.Generics                 (Generic)
 
 import           Common.Model.Payment         (Payment)
 import           Common.Model.PaymentCategory (PaymentCategory)
+import           Common.Model.PaymentHeader   (PaymentHeader)
 
 data PaymentPage = PaymentPage
-  { _paymentPage_payments          :: [Payment]
+  { _paymentPage_header            :: PaymentHeader
+  , _paymentPage_payments          :: [Payment]
   , _paymentPage_paymentCategories :: [PaymentCategory]
   , _paymentPage_totalCount        :: Int
   } deriving (Show, Generic)
diff --git a/server/server.cabal b/server/server.cabal
index b170a18..b4d9e08 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -80,12 +80,8 @@ Executable server
     Design.View.NotFound
     Design.View.Pages
     Design.View.Payment
-    Design.View.Payment.Add
-    Design.View.Payment.Delete
     Design.View.Payment.Form
     Design.View.Payment.Header
-    Design.View.Payment.Pages
-    Design.View.Payment.Table
     Design.View.SignIn
     Design.View.Stat
     Design.View.Table
@@ -117,6 +113,7 @@ Executable server
     Resource
     Secure
     SendMail
+    Util.List
     Util.Time
     Validation.Income
     Validation.Payment
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index 01702cb..f685f2e 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -1,6 +1,5 @@
 module Controller.Payment
-  ( deprecatedList
-  , list
+  ( list
   , listPaymentCategories
   , create
   , edit
@@ -8,48 +7,69 @@ module Controller.Payment
   ) 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                  hiding (delete)
+import           Web.Scotty                  (ActionM)
+import qualified Web.Scotty                  as S
 
 import           Common.Model                (Category (..),
                                               CreatePaymentForm (..),
                                               EditPaymentForm (..),
-                                              Payment (..), PaymentId,
-                                              PaymentPage (..),
+                                              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 qualified Secure
+import qualified Util.List                   as L
 import qualified Validation.Payment          as PaymentValidation
 
-deprecatedList :: ActionM ()
-deprecatedList =
-  Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ PaymentPersistence.listActive) >>= json
-  )
-
 list :: Int -> Int -> ActionM ()
 list page perPage =
-  Secure.loggedAction (\_ ->
+  Secure.loggedAction (\_ -> do
+    currentTime <- liftIO Clock.getCurrentTime
     (liftIO . Query.run $ do
       count <- PaymentPersistence.count
       payments <- PaymentPersistence.listActivePage page perPage
       paymentCategories <- PaymentCategoryPersistence.list
-      return $ PaymentPage payments paymentCategories count
-    ) >>= json
+
+      users <- UserPersistence.list
+      incomes <- IncomePersistence.listAll
+      allPayments <- PaymentPersistence.listActive Punctual
+
+      let exceedingPayers = CM.getExceedingPayers currentTime users incomes allPayments
+
+          repartition =
+            M.fromList
+              . map (\(u, xs) -> (u, sum . map snd $ xs))
+              . L.groupBy fst
+              . map (\p -> (_payment_user p, _payment_cost p))
+              $ allPayments
+
+          header = PaymentHeader
+            { _paymentHeader_exceedingPayers = exceedingPayers
+            , _paymentHeader_repartition     = repartition
+            }
+
+      return $ PaymentPage header payments paymentCategories count) >>= S.json
   )
 
 listPaymentCategories :: ActionM ()
 listPaymentCategories =
   Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ PaymentCategoryPersistence.list) >>= json
+    (liftIO . Query.run $ PaymentCategoryPersistence.list) >>= S.json
   )
 
 create :: CreatePaymentForm -> ActionM ()
@@ -100,7 +120,7 @@ delete paymentId =
         _ ->
           return False
     if deleted then
-      status Status.ok200
+      S.status Status.ok200
     else
-      status Status.badRequest400
+      S.status Status.badRequest400
   )
diff --git a/server/src/Design/Modal.hs b/server/src/Design/Modal.hs
index 4020eb0..1195e10 100644
--- a/server/src/Design/Modal.hs
+++ b/server/src/Design/Modal.hs
@@ -3,11 +3,9 @@ module Design.Modal
   ) where
 
 import           Clay
-import           Data.Monoid                ((<>))
+import           Data.Monoid              ((<>))
 
-import qualified Design.View.Payment.Add    as Add
-import qualified Design.View.Payment.Delete as Delete
-import qualified Design.View.Payment.Form   as Form
+import qualified Design.View.Payment.Form as Form
 
 design :: Css
 design = do
@@ -47,9 +45,7 @@ design = do
     sym borderRadius (px 5)
     boxShadow . pure . bsColor (rgba 0 0 0 0.5) $ shadowWithBlur (px 0) (px 0) (px 15)
 
-    ".add" ? Add.design
     ".form" ? Form.design
-    ".delete" ? Delete.design
 
   ".paymentModal" & do
     ".radioGroup" ? ".title" ? display none
diff --git a/server/src/Design/View/Payment.hs b/server/src/Design/View/Payment.hs
index 0d59fa0..27b4ef3 100644
--- a/server/src/Design/View/Payment.hs
+++ b/server/src/Design/View/Payment.hs
@@ -5,11 +5,7 @@ module Design.View.Payment
 import           Clay
 
 import qualified Design.View.Payment.Header as Header
-import qualified Design.View.Payment.Pages  as Pages
-import qualified Design.View.Payment.Table  as Table
 
 design :: Css
 design = do
-  ".header" ? Header.design
-  ".table" ? Table.design
-  ".pages" ? Pages.design
+  ".g-HeaderInfos" ? Header.design
diff --git a/server/src/Design/View/Payment/Delete.hs b/server/src/Design/View/Payment/Delete.hs
deleted file mode 100644
index f3d7e3f..0000000
--- a/server/src/Design/View/Payment/Delete.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Design.View.Payment.Delete
-  ( design
-  ) where
-
-import           Clay
-
-import qualified Design.Color     as Color
-import qualified Design.Constants as Constants
-import qualified Design.Helper    as Helper
-
-design :: Css
-design = do
-  ".deleteHeader" ? do
-    backgroundColor Color.chestnutRose
-    fontSize (px 18)
-    color Color.white
-    sym padding (px 20)
-    textAlign (alignSide sideCenter)
-    borderRadius (px 5) (px 5) (px 0) (px 0)
-
-  ".deleteContent" ? do
-    sym padding (px 20)
-
-    ".buttons" ? do
-      display flex
-      justifyContent spaceAround
-      marginTop (em 1.5)
-
-      ".confirm" ?
-        Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
-      ".undo" ?
-        Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten
-
-      (".confirm" <> ".undo") ?
-        width (px 90)
diff --git a/server/src/Design/View/Payment/Header.hs b/server/src/Design/View/Payment/Header.hs
index 9111374..49c1a09 100644
--- a/server/src/Design/View/Payment/Header.hs
+++ b/server/src/Design/View/Payment/Header.hs
@@ -8,45 +8,36 @@ 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
-  Media.desktop $ marginBottom (em 3)
-  Media.mobileTablet $ marginBottom (em 2)
+  Media.desktop $ marginBottom (em 2)
+  Media.mobileTablet $ marginBottom (em 1)
   marginLeft (pct Constants.blockPercentMargin)
   marginRight (pct Constants.blockPercentMargin)
 
-  ".payerAndAdd" ? do
-    Media.tabletDesktop $ display flex
+  ".g-HeaderInfos__ExceedingPayers" ? do
+    backgroundColor Color.mossGreen
+    borderRadius (px 5) (px 5) (px 5) (px 5)
+    color Color.white
+    lineHeight (px Constants.inputHeight)
+    paddingLeft (px 10)
+    paddingRight (px 10)
     marginBottom (em 1)
 
-    ".exceedingPayers" ? do
-      backgroundColor Color.mossGreen
-      borderRadius (px 5) (px 5) (px 5) (px 5)
-      color Color.white
-      lineHeight (px Constants.inputHeight)
-      paddingLeft (px 10)
-      paddingRight (px 10)
+    Media.mobile $ do
+      textAlign (alignSide sideCenter)
 
-      Media.tabletDesktop $ do
-        "flex-grow" -: "1"
-        marginRight (px 15)
+    ".exceedingPayer:not(:last-child)::after" ? content (stringContent ", ")
 
-      Media.mobile $ do
-        marginBottom (em 1)
-        textAlign (alignSide sideCenter)
-
-      ".exceedingPayer:not(:last-child)::after" ? content (stringContent ", ")
-
-      ".userName" ? marginRight (px 8)
+    ".userName" ? marginRight (px 8)
 
-    ".addPayment" ? do
-      Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
-      Media.mobile $ width (pct 100)
+  -- ".addPayment" ? do
+  --   Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
+  --   Media.mobile $ width (pct 100)
 
-  ".searchLine" ? do
+  ".g-HeaderForm" ? do
     marginBottom (em 1)
     Media.mobile $ textAlign (alignSide sideCenter)
 
@@ -62,7 +53,7 @@ design = do
     ".selectInput" ? do
       Media.tabletDesktop $ display inlineBlock
 
-  ".infos" ? do
+  ".g-HeaderInfos__Repartition" ? do
     Media.tabletDesktop $ lineHeight (px Constants.inputHeight)
     Media.mobile $ lineHeight (px 25)
 
diff --git a/server/src/Design/View/Payment/Pages.hs b/server/src/Design/View/Payment/Pages.hs
deleted file mode 100644
index 2028c1b..0000000
--- a/server/src/Design/View/Payment/Pages.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-module Design.View.Payment.Pages
-  ( 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
-  display flex
-  justifyContent center
-
-  Media.desktop $ do
-    padding (px 40) (px 30) (px 30) (px 30)
-
-  Media.tablet $ do
-    padding (px 30) (px 30) (px 30) (px 30)
-
-  Media.mobile $ do
-    padding (px 20) (px 0) (px 20) (px 0)
-    lineHeight (px 40)
-
-  svg ? "path" ? ("fill" -: Color.toString Color.dustyGray)
-
-  ".page" ? do
-    display inlineBlock
-    fontWeight bold
-
-    Media.desktop $ do
-      Helper.button Color.white Color.dustyGray (px 50) Constants.focusDarken
-
-    Media.tabletDesktop $ do
-      border solid (px 2) Color.dustyGray
-      marginRight (px 10)
-
-    Media.tablet $ do
-      Helper.button Color.white Color.dustyGray (px 40) Constants.focusDarken
-      fontSize (px 15)
-
-    Media.mobile $ do
-      Helper.button Color.white Color.dustyGray (px 30) Constants.focusDarken
-      fontSize (px 12)
-      border solid (px 1) Color.dustyGray
-      marginRight (px 5)
-
-    ":not(.current)" & cursor pointer
-
-    ".current" & do
-      borderColor Color.chestnutRose
-      color Color.chestnutRose
diff --git a/server/src/Design/View/Payment/Table.hs b/server/src/Design/View/Payment/Table.hs
deleted file mode 100644
index 67828c9..0000000
--- a/server/src/Design/View/Payment/Table.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Design.View.Payment.Table
-  ( design
-  ) where
-
-import           Clay
-
-import qualified Design.Media as Media
-
-design :: Css
-design = do
-  ".cell" ? do
-    ".name" & do
-      Media.tabletDesktop $ width (pct 30)
-
-    ".cost" & do
-      Media.tabletDesktop $ width (pct 10)
-
-    ".user" & do
-      Media.tabletDesktop $ width (pct 15)
-
-    ".category" & do
-      Media.tabletDesktop $ width (pct 10)
-
-    ".date" & do
-      Media.tabletDesktop $ width (pct 15)
-      Media.desktop $ do
-        ".shortDate" ? display none
-        ".longDate" ? display inline
-      Media.tablet $ do
-        ".shortDate" ? display inline
-        ".longDate" ? display none
-      Media.mobile $ do
-        ".shortDate" ? display none
-        ".longDate" ? display inline
-        marginBottom (em 0.5)
diff --git a/server/src/Design/Views.hs b/server/src/Design/Views.hs
index 5c9e307..d36a728 100644
--- a/server/src/Design/Views.hs
+++ b/server/src/Design/Views.hs
@@ -20,7 +20,7 @@ import qualified Design.View.Table         as Table
 design :: Css
 design = do
   header ? Header.design
-  ".payment" ? Payment.design
+  Payment.design
   ".signIn" ? SignIn.design
   ".stat" ? Stat.design
   ".notfound" ? NotFound.design
diff --git a/server/src/Main.hs b/server/src/Main.hs
index a4d8635..5068d10 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -41,9 +41,6 @@ main = do
     S.get "/api/users"$
       User.list
 
-    S.get "/api/deprecated/payments" $
-      Payment.deprecatedList
-
     S.get "/api/payments" $ do
       page <- S.param "page"
       perPage <- S.param "perPage"
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index e01753f..7835c98 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -89,11 +89,14 @@ firstPunctualDay =
         (Only (FrequencyField Punctual))
   )
 
-listActive :: Query [Payment]
-listActive =
+listActive :: Frequency -> Query [Payment]
+listActive frequency =
   Query (\conn -> do
     map (\(Row p) -> p) <$>
-      SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
+      SQLite.query
+        conn
+        "SELECT * FROM payment WHERE deleted_at IS NULL AND frequency = ?"
+        (Only (FrequencyField frequency))
   )
 
 listActivePage :: Int -> Int -> Query [Payment]
@@ -102,8 +105,16 @@ listActivePage page perPage =
     map (\(Row p) -> p) <$>
       SQLite.query
         conn
-        "SELECT * FROM payment WHERE deleted_at IS NULL ORDER BY date DESC LIMIT ? OFFSET ?"
-        (perPage, (page - 1) * perPage)
+        (SQLite.Query $ T.intercalate " "
+          [ "SELECT *"
+          , "FROM payment"
+          , "WHERE deleted_at IS NULL AND frequency = ?"
+          , "ORDER BY date DESC"
+          , "LIMIT ?"
+          , "OFFSET ?"
+          ]
+        )
+        (FrequencyField Punctual, perPage, (page - 1) * perPage)
   )
 
 listPunctual :: Query [Payment]
diff --git a/server/src/Util/List.hs b/server/src/Util/List.hs
new file mode 100644
index 0000000..4e22ba8
--- /dev/null
+++ b/server/src/Util/List.hs
@@ -0,0 +1,13 @@
+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)