From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 8 Nov 2017 23:47:26 +0100
Subject: Use a better project structure

---
 server/src/Controller/Income.hs | 48 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 server/src/Controller/Income.hs

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
new file mode 100644
index 0000000..148b713
--- /dev/null
+++ b/server/src/Controller/Income.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Controller.Income
+  ( create
+  , editOwn
+  , deleteOwn
+  ) where
+
+import Control.Monad.IO.Class (liftIO)
+import Network.HTTP.Types.Status (ok200, badRequest400)
+import qualified Data.Text.Lazy as TL
+import Web.Scotty
+
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model (CreateIncome(..), EditIncome(..), IncomeId, User(..))
+
+import Json (jsonId)
+import qualified Model.Income as Income
+import qualified Model.Query as Query
+import qualified Secure
+
+create :: CreateIncome -> ActionM ()
+create (CreateIncome date amount) =
+  Secure.loggedAction (\user ->
+    (liftIO . Query.run $ Income.create (_user_id user) date amount) >>= jsonId
+  )
+
+editOwn :: EditIncome -> ActionM ()
+editOwn (EditIncome incomeId date amount) =
+  Secure.loggedAction (\user -> do
+    updated <- liftIO . Query.run $ Income.editOwn (_user_id user) incomeId date amount
+    if updated
+      then status ok200
+      else status badRequest400
+  )
+
+deleteOwn :: IncomeId -> ActionM ()
+deleteOwn incomeId =
+  Secure.loggedAction (\user -> do
+    deleted <- liftIO . Query.run $ Income.deleteOwn user incomeId
+    if deleted
+      then
+        status ok200
+      else do
+        status badRequest400
+        text . TL.fromStrict $ Message.get Key.Income_NotDeleted
+  )
-- 
cgit v1.2.3


From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 13 Nov 2017 23:56:40 +0100
Subject: Setup stylish-haskell

---
 server/src/Controller/Income.hs | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 148b713..c42f6a7 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -6,18 +6,19 @@ module Controller.Income
   , deleteOwn
   ) where
 
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types.Status (ok200, badRequest400)
-import qualified Data.Text.Lazy as TL
-import Web.Scotty
+import           Control.Monad.IO.Class    (liftIO)
+import qualified Data.Text.Lazy            as TL
+import           Network.HTTP.Types.Status (badRequest400, ok200)
+import           Web.Scotty
 
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model (CreateIncome(..), EditIncome(..), IncomeId, User(..))
+import qualified Common.Message            as Message
+import qualified Common.Message.Key        as Key
+import           Common.Model              (CreateIncome (..), EditIncome (..),
+                                            IncomeId, User (..))
 
-import Json (jsonId)
-import qualified Model.Income as Income
-import qualified Model.Query as Query
+import           Json                      (jsonId)
+import qualified Model.Income              as Income
+import qualified Model.Query               as Query
 import qualified Secure
 
 create :: CreateIncome -> ActionM ()
-- 
cgit v1.2.3


From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 19 Nov 2017 00:20:25 +0100
Subject: Show payment count and partition

- Also fixes exceedingPayer in back by using only punctual payments
---
 server/src/Controller/Income.hs | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index c42f6a7..19f0cfc 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module Controller.Income
   ( create
   , editOwn
@@ -11,10 +9,9 @@ import qualified Data.Text.Lazy            as TL
 import           Network.HTTP.Types.Status (badRequest400, ok200)
 import           Web.Scotty
 
-import qualified Common.Message            as Message
-import qualified Common.Message.Key        as Key
 import           Common.Model              (CreateIncome (..), EditIncome (..),
                                             IncomeId, User (..))
+import qualified Common.Msg                as Msg
 
 import           Json                      (jsonId)
 import qualified Model.Income              as Income
@@ -45,5 +42,5 @@ deleteOwn incomeId =
         status ok200
       else do
         status badRequest400
-        text . TL.fromStrict $ Message.get Key.Income_NotDeleted
+        text . TL.fromStrict $ Msg.get Msg.Income_NotDeleted
   )
-- 
cgit v1.2.3


From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 28 Jan 2018 12:13:09 +0100
Subject: WIP

---
 server/src/Controller/Income.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 19f0cfc..3f623e5 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -14,20 +14,20 @@ import           Common.Model              (CreateIncome (..), EditIncome (..),
 import qualified Common.Msg                as Msg
 
 import           Json                      (jsonId)
-import qualified Model.Income              as Income
 import qualified Model.Query               as Query
+import qualified Persistence.Income        as IncomePersistence
 import qualified Secure
 
 create :: CreateIncome -> ActionM ()
 create (CreateIncome date amount) =
   Secure.loggedAction (\user ->
-    (liftIO . Query.run $ Income.create (_user_id user) date amount) >>= jsonId
+    (liftIO . Query.run $ IncomePersistence.create (_user_id user) date amount) >>= jsonId
   )
 
 editOwn :: EditIncome -> ActionM ()
 editOwn (EditIncome incomeId date amount) =
   Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ Income.editOwn (_user_id user) incomeId date amount
+    updated <- liftIO . Query.run $ IncomePersistence.editOwn (_user_id user) incomeId date amount
     if updated
       then status ok200
       else status badRequest400
@@ -36,7 +36,7 @@ editOwn (EditIncome incomeId date amount) =
 deleteOwn :: IncomeId -> ActionM ()
 deleteOwn incomeId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ Income.deleteOwn user incomeId
+    deleted <- liftIO . Query.run $ IncomePersistence.deleteOwn user incomeId
     if deleted
       then
         status ok200
-- 
cgit v1.2.3


From fb8f0fe577e28dae69903413b761da50586e0099 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 14:53:41 +0200
Subject: Remove payment category if unused after a payment is deleted

---
 server/src/Controller/Income.hs | 33 +++++++++++++--------------------
 1 file changed, 13 insertions(+), 20 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 3f623e5..ed58ac8 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,17 +1,15 @@
 module Controller.Income
   ( create
-  , editOwn
-  , deleteOwn
+  , edit
+  , 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
+import qualified Network.HTTP.Types.Status as Status
+import           Web.Scotty                hiding (delete)
 
 import           Common.Model              (CreateIncome (..), EditIncome (..),
                                             IncomeId, User (..))
-import qualified Common.Msg                as Msg
 
 import           Json                      (jsonId)
 import qualified Model.Query               as Query
@@ -24,23 +22,18 @@ create (CreateIncome date amount) =
     (liftIO . Query.run $ IncomePersistence.create (_user_id user) date amount) >>= jsonId
   )
 
-editOwn :: EditIncome -> ActionM ()
-editOwn (EditIncome incomeId date amount) =
+edit :: EditIncome -> ActionM ()
+edit (EditIncome incomeId date amount) =
   Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ IncomePersistence.editOwn (_user_id user) incomeId date amount
+    updated <- liftIO . Query.run $ IncomePersistence.edit (_user_id user) incomeId date amount
     if updated
-      then status ok200
-      else status badRequest400
+      then status Status.ok200
+      else status Status.badRequest400
   )
 
-deleteOwn :: IncomeId -> ActionM ()
-deleteOwn incomeId =
+delete :: IncomeId -> ActionM ()
+delete incomeId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ IncomePersistence.deleteOwn user incomeId
-    if deleted
-      then
-        status ok200
-      else do
-        status badRequest400
-        text . TL.fromStrict $ Msg.get Msg.Income_NotDeleted
+    _ <- liftIO . Query.run $ IncomePersistence.delete (_user_id user) incomeId
+    status Status.ok200
   )
-- 
cgit v1.2.3


From 7aadcc97f9df0e2daccbe8a8726d8bc6c63d67f4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 20 Oct 2019 12:02:21 +0200
Subject: Add income

---
 server/src/Controller/Income.hs | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index ed58ac8..e013849 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -5,21 +5,32 @@ module Controller.Income
   ) where
 
 import           Control.Monad.IO.Class    (liftIO)
+import           Data.Validation           (Validation (Failure, Success))
 import qualified Network.HTTP.Types.Status as Status
 import           Web.Scotty                hiding (delete)
 
-import           Common.Model              (CreateIncome (..), EditIncome (..),
-                                            IncomeId, User (..))
+import           Common.Model              (CreateIncomeForm (..),
+                                            EditIncome (..), IncomeId,
+                                            User (..))
 
-import           Json                      (jsonId)
+import qualified Controller.Helper         as ControllerHelper
+import           Model.CreateIncome        (CreateIncome (..))
 import qualified Model.Query               as Query
 import qualified Persistence.Income        as IncomePersistence
 import qualified Secure
+import qualified Validation.Income         as IncomeValidation
 
-create :: CreateIncome -> ActionM ()
-create (CreateIncome date amount) =
+create :: CreateIncomeForm -> ActionM ()
+create form =
   Secure.loggedAction (\user ->
-    (liftIO . Query.run $ IncomePersistence.create (_user_id user) date amount) >>= jsonId
+    (liftIO . Query.run $ do
+      case IncomeValidation.createIncome form of
+        Success (CreateIncome amount date) -> do
+          Right <$> (IncomePersistence.create (_user_id user) date amount)
+
+        Failure validationError ->
+          return $ Left validationError
+    ) >>= ControllerHelper.jsonOrBadRequest
   )
 
 edit :: EditIncome -> ActionM ()
-- 
cgit v1.2.3


From 602c52acfcfa494b07fec05c20b317b60ea8a6f3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 20 Oct 2019 21:31:57 +0200
Subject: Load init data per page with AJAX

---
 server/src/Controller/Income.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index e013849..b40976b 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,5 +1,6 @@
 module Controller.Income
-  ( create
+  ( list
+  , create
   , edit
   , delete
   ) where
@@ -20,6 +21,12 @@ import qualified Persistence.Income        as IncomePersistence
 import qualified Secure
 import qualified Validation.Income         as IncomeValidation
 
+list :: ActionM ()
+list =
+  Secure.loggedAction (\_ ->
+    (liftIO . Query.run $ IncomePersistence.list) >>= json
+  )
+
 create :: CreateIncomeForm -> ActionM ()
 create form =
   Secure.loggedAction (\user ->
-- 
cgit v1.2.3


From e4b32ce15f8c92f3b477d3f3d4d301ba08f9b5e3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 23 Oct 2019 22:35:27 +0200
Subject: Edit an income

---
 server/src/Controller/Income.hs | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index b40976b..236e032 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -11,11 +11,12 @@ import qualified Network.HTTP.Types.Status as Status
 import           Web.Scotty                hiding (delete)
 
 import           Common.Model              (CreateIncomeForm (..),
-                                            EditIncome (..), IncomeId,
+                                            EditIncomeForm (..), IncomeId,
                                             User (..))
 
 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 Secure
@@ -40,13 +41,17 @@ create form =
     ) >>= ControllerHelper.jsonOrBadRequest
   )
 
-edit :: EditIncome -> ActionM ()
-edit (EditIncome incomeId date amount) =
-  Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ IncomePersistence.edit (_user_id user) incomeId date amount
-    if updated
-      then status Status.ok200
-      else status Status.badRequest400
+edit :: EditIncomeForm -> ActionM ()
+edit form =
+  Secure.loggedAction (\user ->
+    (liftIO . Query.run $ do
+      case IncomeValidation.editIncome form of
+        Success (EditIncome incomeId amount date) -> do
+          Right <$> (IncomePersistence.edit (_user_id user) incomeId date amount)
+
+        Failure validationError ->
+          return $ Left validationError
+    ) >>= ControllerHelper.jsonOrBadRequest
   )
 
 delete :: IncomeId -> ActionM ()
-- 
cgit v1.2.3


From b97ad942495352c3fc1e0c820cfba82a9693ac7a Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 27 Oct 2019 20:26:29 +0100
Subject: WIP Set up server side paging for incomes

---
 server/src/Controller/Income.hs | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 236e032..3272cbf 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,5 +1,6 @@
 module Controller.Income
   ( list
+  , listv2
   , create
   , edit
   , delete
@@ -12,7 +13,7 @@ import           Web.Scotty                hiding (delete)
 
 import           Common.Model              (CreateIncomeForm (..),
                                             EditIncomeForm (..), IncomeId,
-                                            User (..))
+                                            IncomesAndCount (..), User (..))
 
 import qualified Controller.Helper         as ControllerHelper
 import           Model.CreateIncome        (CreateIncome (..))
@@ -28,6 +29,16 @@ list =
     (liftIO . Query.run $ IncomePersistence.list) >>= json
   )
 
+listv2 :: Int -> Int -> ActionM ()
+listv2 page perPage =
+  Secure.loggedAction (\_ ->
+    (liftIO . Query.run $ do
+      count <- IncomePersistence.count
+      incomes <- IncomePersistence.listv2 page perPage
+      return $ IncomesAndCount incomes count
+    ) >>= json
+  )
+
 create :: CreateIncomeForm -> ActionM ()
 create form =
   Secure.loggedAction (\user ->
-- 
cgit v1.2.3


From 9dbb4e6f7c2f0edc1126626e2ff498144c6b9947 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Nov 2019 11:28:42 +0100
Subject: Show income header

---
 server/src/Controller/Income.hs | 49 ++++++++++++++++++++++++++++-------------
 1 file changed, 34 insertions(+), 15 deletions(-)

(limited to 'server/src/Controller/Income.hs')

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 ()
-- 
cgit v1.2.3


From 182f3d3fea9985c0e403087fe253981c68e57102 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Nov 2019 11:33:20 +0100
Subject: Fix payment page

---
 server/src/Controller/Income.hs | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index d8d3d89..4a41bd3 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,5 +1,6 @@
 module Controller.Income
   ( list
+  , deprecatedList
   , create
   , edit
   , delete
@@ -58,6 +59,12 @@ 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 ->
-- 
cgit v1.2.3


From 0f85cbd8ee736b1996e3966bac1f5e47ed7d27a9 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Nov 2019 15:47:11 +0100
Subject: Fetch the first payment date instead of every payment to get
 cumulative income

---
 server/src/Controller/Income.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 4a41bd3..127e3b3 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -37,11 +37,11 @@ list page perPage =
       count <- IncomePersistence.count
 
       users <- UserPersistence.list
-      allPayments <- PaymentPersistence.listPunctual -- TODO: get first payment defined for all
+      firstPayment <- PaymentPersistence.firstPunctualDay
       allIncomes <- IncomePersistence.listAll
 
       let since =
-            CM.useIncomesFrom (map _user_id users) allIncomes allPayments
+            CM.useIncomesFrom (map _user_id users) allIncomes firstPayment
 
       let byUser =
             case since of
-- 
cgit v1.2.3


From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 17 Nov 2019 18:08:28 +0100
Subject: Optimize and refactor payments

---
 server/src/Controller/Income.hs | 17 +++++------------
 1 file changed, 5 insertions(+), 12 deletions(-)

(limited to 'server/src/Controller/Income.hs')

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 ->
-- 
cgit v1.2.3


From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Nov 2019 16:19:53 +0100
Subject: Compute cumulative income with a DB query

---
 server/src/Controller/Income.hs | 28 ++++++++++------------------
 1 file changed, 10 insertions(+), 18 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 75d0133..784a2db 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -13,7 +13,7 @@ import qualified Network.HTTP.Types.Status as Status
 import           Web.Scotty                hiding (delete)
 
 import           Common.Model              (CreateIncomeForm (..),
-                                            EditIncomeForm (..), Income (..),
+                                            EditIncomeForm (..),
                                             IncomeHeader (..), IncomeId,
                                             IncomePage (..), User (..))
 
@@ -21,7 +21,6 @@ import qualified Controller.Helper         as ControllerHelper
 import           Model.CreateIncome        (CreateIncome (..))
 import           Model.EditIncome          (EditIncome (..))
 import qualified Model.Query               as Query
-import qualified Payer                     as Payer
 import qualified Persistence.Income        as IncomePersistence
 import qualified Persistence.Payment       as PaymentPersistence
 import qualified Persistence.User          as UserPersistence
@@ -36,26 +35,19 @@ list page perPage =
       count <- IncomePersistence.count
 
       users <- UserPersistence.list
-      paymentRange <- PaymentPersistence.getRange
-      allIncomes <- IncomePersistence.listAll -- TODO optimize
-
-      let since =
-            Payer.useIncomesFrom (map _user_id users) allIncomes (fst <$> paymentRange)
+      let userIds = _user_id <$> users
 
-      let byUser =
-            case since of
-              Just s ->
-                M.fromList . flip map users $ \user ->
-                  ( _user_id user
-                  , Payer.cumulativeIncomesSince currentTime s $
-                    filter ((==) (_user_id user) . _income_userId) allIncomes
-                  )
+      paymentRange <- PaymentPersistence.getRange
+      incomeDefinedForAll <- IncomePersistence.definedForAll userIds
+      let since = max <$> (fst <$> paymentRange) <*> incomeDefinedForAll
 
-              Nothing ->
-                M.empty
+      cumulativeIncome <-
+        case since of
+          Just s -> IncomePersistence.getCumulativeIncome s (Clock.utctDay currentTime)
+          Nothing -> return M.empty
 
       incomes <- IncomePersistence.list page perPage
-      return $ IncomePage (IncomeHeader since byUser) incomes count) >>= json
+      return $ IncomePage page (IncomeHeader since cumulativeIncome) incomes count) >>= json
   )
 
 create :: CreateIncomeForm -> ActionM ()
-- 
cgit v1.2.3


From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 8 Dec 2019 11:39:37 +0100
Subject: Add category page

---
 server/src/Controller/Income.hs | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'server/src/Controller/Income.hs')

diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 784a2db..96ccbbc 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -8,7 +8,7 @@ module Controller.Income
 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           Data.Validation           (Validation (..))
 import qualified Network.HTTP.Types.Status as Status
 import           Web.Scotty                hiding (delete)
 
@@ -16,6 +16,7 @@ import           Common.Model              (CreateIncomeForm (..),
                                             EditIncomeForm (..),
                                             IncomeHeader (..), IncomeId,
                                             IncomePage (..), User (..))
+import qualified Common.Msg                as Msg
 
 import qualified Controller.Helper         as ControllerHelper
 import           Model.CreateIncome        (CreateIncome (..))
@@ -60,7 +61,7 @@ create form =
 
         Failure validationError ->
           return $ Left validationError
-    ) >>= ControllerHelper.jsonOrBadRequest
+    ) >>= ControllerHelper.okOrBadRequest
   )
 
 edit :: EditIncomeForm -> ActionM ()
@@ -68,12 +69,17 @@ edit form =
   Secure.loggedAction (\user ->
     (liftIO . Query.run $ do
       case IncomeValidation.editIncome form of
-        Success (EditIncome incomeId amount date) -> do
-          Right <$> (IncomePersistence.edit (_user_id user) incomeId date amount)
+        Success (EditIncome incomeId amount date) ->
+          do
+            isSuccess <- IncomePersistence.edit (_user_id user) incomeId date amount
+            return $ if isSuccess then
+              Right ()
+            else
+              Left $ Msg.get Msg.Error_IncomeEdit
 
         Failure validationError ->
           return $ Left validationError
-    ) >>= ControllerHelper.jsonOrBadRequest
+    ) >>= ControllerHelper.okOrBadRequest
   )
 
 delete :: IncomeId -> ActionM ()
-- 
cgit v1.2.3