aboutsummaryrefslogtreecommitdiff
path: root/server/src
diff options
context:
space:
mode:
authorJoris2020-05-30 15:02:24 +0200
committerJoris2020-05-30 15:02:26 +0200
commit706635ed16266962de75f15a83453cfa1b1bab83 (patch)
treea8e2a5e8bb58f8f765751ec0608781f67cbb940b /server/src
parent80d0a1f5207378f80e7c851fba13396b6f78f785 (diff)
Compute cumulative income until now
Previously, last payment date was used to compute the cumulative income. It resulted in big differences of cumulative incomes, if no payment have been added for some days.
Diffstat (limited to 'server/src')
-rw-r--r--server/src/Controller/Payment.hs8
-rw-r--r--server/src/Job/WeeklyReport.hs5
2 files changed, 8 insertions, 5 deletions
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index d6aa34f..4fb4d54 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -9,6 +9,7 @@ module Controller.Payment
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M
import Data.Text (Text)
+import qualified Data.Time.Clock as Clock
import qualified Data.Time.Calendar as Calendar
import Data.Validation (Validation (Failure, Success))
import Web.Scotty (ActionM)
@@ -34,7 +35,8 @@ import qualified Validation.Payment as PaymentValidation
list :: Frequency -> Int -> Int -> Text -> ActionM ()
list frequency page perPage search =
- Secure.loggedAction (\_ ->
+ Secure.loggedAction (\_ -> do
+ currentUtctDay <- liftIO $ Clock.utctDay <$> Clock.getCurrentTime
(liftIO . Query.run $ do
count <- PaymentPersistence.count frequency search
payments <- PaymentPersistence.listActivePage frequency page perPage search
@@ -46,8 +48,8 @@ list frequency page perPage search =
cumulativeIncome <-
case (incomeDefinedForAll, paymentRange) of
- (Just incomeStart, Just (paymentStart, paymentEnd)) ->
- IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) paymentEnd
+ (Just incomeStart, Just (paymentStart, _)) ->
+ IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) currentUtctDay
_ ->
return M.empty
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index ff80ddf..282f2f1 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -3,6 +3,7 @@ module Job.WeeklyReport
) where
import qualified Data.Map as M
+import qualified Data.Time.Clock as Clock
import Data.Time.Clock (UTCTime, getCurrentTime)
import Common.Model (User (..))
@@ -30,8 +31,8 @@ weeklyReport conf mbLastExecution = do
incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
cumulativeIncome <-
case (incomeDefinedForAll, paymentRange) of
- (Just incomeStart, Just (paymentStart, paymentEnd)) ->
- IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) paymentEnd
+ (Just incomeStart, Just (paymentStart, _)) ->
+ IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) (Clock.utctDay now)
_ ->
return M.empty