Show income header

12 files changed, 125 insertions, 87 deletions

diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index 8e82525..8451ee4 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -5,13 +5,15 @@ module View.Income.Header
   ) where
 
 import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Map               as M
 import qualified Data.Maybe             as Maybe
 import qualified Data.Text              as T
 import qualified Data.Time.Clock        as Clock
 import           Reflex.Dom             (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom             as R
 
-import           Common.Model           (Currency, Income (..), User (..))
+import           Common.Model           (Currency, Income (..),
+                                         IncomeHeader (..), User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
@@ -23,9 +25,9 @@ import qualified View.Income.Form       as Form
 import           View.Income.Init       (Init (..))
 
 data In t = In
-  { _in_init     :: Init
+  { _in_users    :: [User]
+  , _in_header   :: IncomeHeader
   , _in_currency :: Currency
-  , _in_incomes  :: Dynamic t [Income]
   }
 
 data Out t = Out
@@ -38,11 +40,11 @@ view input =
 
     currentTime <- liftIO Clock.getCurrentTime
 
-    R.dyn . R.ffor useIncomesFrom $ \case
-      (Nothing, _) ->
+    case _incomeHeader_since $ _in_header input of
+      Nothing ->
         R.blank
 
-      (Just since, incomes) ->
+      Just since ->
         R.el "div" $ do
 
           R.el "h1" $ do
@@ -50,15 +52,13 @@ view input =
             R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay day))
 
           R.el "ul" $
-            flip mapM_ (_init_users init) $ \user ->
+            flip mapM_ (M.toList . _incomeHeader_byUser $ _in_header input) $ \(userId, amount) ->
               R.el "li" $
-                R.text $ do
-                  let userIncomes = filter ((==) (_user_id user) . _income_userId) incomes
+                R.text $
                   T.intercalate " "
-                    [ _user_name user
+                    [ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser userId (_in_users input)
                     , "−"
-                    , Format.price (_in_currency input) $
-                      CM.cumulativeIncomesSince currentTime since userIncomes
+                    , Format.price (_in_currency input) amount
                     ]
 
     R.divClass "titleButton" $ do
@@ -78,14 +78,3 @@ view input =
       return $ Out
         { _out_add = addIncome
         }
-
-  where
-    init = _in_init input
-
-    useIncomesFrom = R.ffor (_in_incomes input) $ \incomes ->
-      ( CM.useIncomesFrom
-        (map _user_id $_init_users init)
-        incomes
-        (_init_payments init)
-      , incomes
-      )
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index d31775a..d82ab4d 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -11,15 +11,15 @@ import qualified Data.Text           as T
 import           Reflex.Dom          (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom          as R
 
-import           Common.Model        (Currency, Income (..),
-                                      IncomesAndCount (..), User, UserId)
+import           Common.Model        (Currency, Income (..), IncomePage (..),
+                                      User, UserId)
 
 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.Income.Header as Header
+import qualified View.Income.Header  as Header
 import           View.Income.Init    (Init (..))
 import qualified View.Income.Reducer as Reducer
 import qualified View.Income.Table   as Table
@@ -36,22 +36,29 @@ view input = do
     incomes <- Reducer.reducer $ Reducer.In
       { Reducer._in_newPage      = newPage
       , Reducer._in_currentPage  = currentPage
-      , Reducer._in_addIncome    = addIncome
+      , Reducer._in_addIncome    = R.leftmost [headerAddIncome, tableAddIncome]
       , Reducer._in_editIncome   = editIncome
       , Reducer._in_deleteIncome = deleteIncome
       }
 
-    let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+    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 . snd
+    newPage <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
     currentPage <- R.holdDyn 1 newPage
-    addIncome <- eventFromResult $ Table._out_add . fst
-    editIncome <- eventFromResult $ Table._out_edit . fst
-    deleteIncome <- eventFromResult $ Table._out_delete . fst
+    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 $ \(IncomesAndCount incomes count) -> do
+      flip Loadable.view is $ \(IncomePage header incomes count) -> do
+        header <- Header.view $ Header.In
+          { Header._in_users = _in_users input
+          , Header._in_header = header
+          , Header._in_currency = _in_currency input
+          }
+
         table <- Table.view $ Table.In
           { Table._in_currentUser = _in_currentUser input
           , Table._in_currency = _in_currency input
@@ -65,6 +72,6 @@ view input = do
           , Pages._in_page = p
           }
 
-        return (table, pages)
+        return (header, table, pages)
 
   return ()
diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs
index 5b346cb..092d9b3 100644
--- a/client/src/View/Income/Reducer.hs
+++ b/client/src/View/Income/Reducer.hs
@@ -9,7 +9,7 @@ import qualified Data.Text    as T
 import           Reflex.Dom   (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom   as R
 
-import           Common.Model (IncomesAndCount)
+import           Common.Model (IncomePage)
 
 import           Loadable     (Loadable (..))
 import qualified Loadable     as Loadable
@@ -28,9 +28,9 @@ data In t a b c = In
 
 data Action
   = LoadPage Int
-  | GetResult (Either Text IncomesAndCount)
+  | GetResult (Either Text IncomePage)
 
-reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomesAndCount))
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage))
 reducer input = do
 
   postBuild <- R.getPostBuild
@@ -60,7 +60,7 @@ reducer input = do
 
   where
     pageUrl p =
-      "api/v2/incomes?page="
+      "api/incomes?page="
       <> (T.pack . show $ p)
       <> "&perPage="
       <> (T.pack . show $ perPage)
diff --git a/common/common.cabal b/common/common.cabal
index 9f3f65b..651673f 100644
--- a/common/common.cabal
+++ b/common/common.cabal
@@ -24,6 +24,7 @@ Library
   Build-depends:
       aeson
     , base >= 4.11 && < 5
+    , containers
     , text
     , time
     , validation
@@ -60,7 +61,8 @@ Library
     Common.Model.EditPaymentForm
     Common.Model.Frequency
     Common.Model.Income
-    Common.Model.IncomesAndCount
+    Common.Model.IncomeHeader
+    Common.Model.IncomePage
     Common.Model.Init
     Common.Model.InitResult
     Common.Model.Payer
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index 3a5a627..313f26b 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -12,7 +12,8 @@ import           Common.Model.EditPaymentForm   as X
 import           Common.Model.Email             as X
 import           Common.Model.Frequency         as X
 import           Common.Model.Income            as X
-import           Common.Model.IncomesAndCount   as X
+import           Common.Model.IncomeHeader      as X
+import           Common.Model.IncomePage        as X
 import           Common.Model.Init              as X
 import           Common.Model.InitResult        as X
 import           Common.Model.Payer             as X
diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs
new file mode 100644
index 0000000..a1defdf
--- /dev/null
+++ b/common/src/Common/Model/IncomeHeader.hs
@@ -0,0 +1,18 @@
+module Common.Model.IncomeHeader
+  ( IncomeHeader(..)
+  ) where
+
+import           Data.Aeson        (FromJSON, ToJSON)
+import           Data.Map          (Map)
+import           Data.Time.Clock   (UTCTime)
+import           GHC.Generics      (Generic)
+
+import           Common.Model.User (UserId)
+
+data IncomeHeader = IncomeHeader
+  { _incomeHeader_since  :: Maybe UTCTime
+  , _incomeHeader_byUser :: Map UserId Int
+  } deriving (Show, Generic)
+
+instance FromJSON IncomeHeader
+instance ToJSON IncomeHeader
diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs
new file mode 100644
index 0000000..c3f478e
--- /dev/null
+++ b/common/src/Common/Model/IncomePage.hs
@@ -0,0 +1,18 @@
+module Common.Model.IncomePage
+  ( IncomePage(..)
+  ) where
+
+import           Data.Aeson                (FromJSON, ToJSON)
+import           GHC.Generics              (Generic)
+
+import           Common.Model.Income       (Income)
+import           Common.Model.IncomeHeader (IncomeHeader)
+
+data IncomePage = IncomePage
+  { _incomePage_header     :: IncomeHeader
+  , _incomePage_incomes    :: [Income]
+  , _incomePage_totalCount :: Int
+  } deriving (Show, Generic)
+
+instance FromJSON IncomePage
+instance ToJSON IncomePage
diff --git a/common/src/Common/Model/IncomesAndCount.hs b/common/src/Common/Model/IncomesAndCount.hs
deleted file mode 100644
index 4365180..0000000
--- a/common/src/Common/Model/IncomesAndCount.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Common.Model.IncomesAndCount
-  ( IncomesAndCount(..)
-  ) where
-
-import           Data.Aeson          (FromJSON, ToJSON)
-import           GHC.Generics        (Generic)
-
-import           Common.Model.Income (Income)
-
-data IncomesAndCount = IncomesAndCount
-  { _incomesAndCount_incomes :: [Income]
-  , _incomesAndCount_count   :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON IncomesAndCount
-instance ToJSON IncomesAndCount
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 3272cbf..d8d3d89 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,42 +1,61 @@
 module Controller.Income
   ( list
-  , listv2
   , create
   , edit
   , delete
   ) 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           Common.Model              (CreateIncomeForm (..),
-                                            EditIncomeForm (..), IncomeId,
-                                            IncomesAndCount (..), User (..))
+                                            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 Persistence.Income        as IncomePersistence
+import qualified Persistence.Payment       as PaymentPersistence
+import qualified Persistence.User          as UserPersistence
 import qualified Secure
 import qualified Validation.Income         as IncomeValidation
 
-list :: ActionM ()
-list =
-  Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ IncomePersistence.list) >>= json
-  )
-
-listv2 :: Int -> Int -> ActionM ()
-listv2 page perPage =
-  Secure.loggedAction (\_ ->
+list :: Int -> Int -> ActionM ()
+list page perPage =
+  Secure.loggedAction (\_ -> do
+    currentTime <- liftIO Clock.getCurrentTime
     (liftIO . Query.run $ do
       count <- IncomePersistence.count
-      incomes <- IncomePersistence.listv2 page perPage
-      return $ IncomesAndCount incomes count
-    ) >>= json
+
+      users <- UserPersistence.list
+      allPayments <- PaymentPersistence.listPunctual -- TODO: get first payment defined for all
+      allIncomes <- IncomePersistence.listAll
+
+      let since =
+            CM.useIncomesFrom (map _user_id users) allIncomes allPayments
+
+      let byUser =
+            case since of
+              Just s ->
+                M.fromList . flip map users $ \user ->
+                  ( _user_id user
+                  , CM.cumulativeIncomesSince currentTime s $
+                    filter ((==) (_user_id user) . _income_userId) allIncomes
+                  )
+
+              Nothing ->
+                M.empty
+
+      incomes <- IncomePersistence.list page perPage
+      return $ IncomePage (IncomeHeader since byUser) incomes count) >>= json
   )
 
 create :: CreateIncomeForm -> ActionM ()
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index 203c4e8..1a478dc 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -19,7 +19,7 @@ weeklyReport conf mbLastExecution = do
     Nothing -> return ()
     Just lastExecution -> do
       (payments, incomes, users) <- Query.run $
-        (,,) <$> PaymentPersistence.listPunctual <*> IncomePersistence.list <*> UserPersistence.list
+        (,,) <$> PaymentPersistence.listPunctual <*> IncomePersistence.listAll <*> UserPersistence.list
       _ <- SendMail.sendMail conf (WeeklyReport.mail conf users payments incomes lastExecution now)
       return ()
   return now
diff --git a/server/src/Main.hs b/server/src/Main.hs
index 00e8d1c..40b53b6 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -54,13 +54,10 @@ main = do
       paymentId <- S.param "id"
       Payment.delete paymentId
 
-    S.get "/api/v2/incomes" $ do
+    S.get "/api/incomes" $ do
       page <- S.param "page"
       perPage <- S.param "perPage"
-      Income.listv2 page perPage
-
-    S.get "/api/incomes" $
-      Income.list
+      Income.list page perPage
 
     S.post "/api/income" $
       S.jsonData >>= Income.create
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index de55a18..4ae3228 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -1,7 +1,7 @@
 module Persistence.Income
   ( count
   , list
-  , listv2
+  , listAll
   , create
   , edit
   , delete
@@ -43,15 +43,8 @@ count =
       SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL"
   )
 
-list :: Query [Income]
-list =
-  Query (\conn ->
-    map (\(Row i) -> i) <$>
-      SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
-  )
-
-listv2 :: Int -> Int -> Query [Income]
-listv2 page perPage =
+list :: Int -> Int -> Query [Income]
+list page perPage =
   Query (\conn ->
     map (\(Row i) -> i) <$>
       SQLite.query
@@ -60,6 +53,16 @@ listv2 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"
+  )
+
+-- firstIncomeByUser
+-- SELECT user_id, MIN(date) FROM income WHERE deleted_at IS NULL GROUP BY user_id;
+
 create :: UserId -> Day -> Int -> Query Income
 create userId date amount =
   Query (\conn -> do