aboutsummaryrefslogtreecommitdiff
path: root/server/src
diff options
context:
space:
mode:
Diffstat (limited to 'server/src')
-rw-r--r--server/src/Controller/Income.hs28
-rw-r--r--server/src/Controller/Payment.hs16
-rw-r--r--server/src/Design/Global.hs6
-rw-r--r--server/src/Design/Loadable.hs29
-rw-r--r--server/src/Design/View/Table.hs3
-rw-r--r--server/src/Design/Views.hs16
-rw-r--r--server/src/Job/WeeklyReport.hs17
-rw-r--r--server/src/Payer.hs135
-rw-r--r--server/src/Persistence/Income.hs58
-rw-r--r--server/src/Persistence/Payment.hs12
-rw-r--r--server/src/View/Mail/WeeklyReport.hs21
11 files changed, 173 insertions, 168 deletions
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 ()
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index c860810..42a4436 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -11,7 +11,6 @@ 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
@@ -36,16 +35,23 @@ import qualified Validation.Payment as PaymentValidation
list :: Frequency -> Int -> Int -> Text -> ActionM ()
list frequency page perPage search =
- Secure.loggedAction (\_ -> do
- currentTime <- liftIO Clock.getCurrentTime
+ Secure.loggedAction (\_ ->
(liftIO . Query.run $ do
count <- PaymentPersistence.count frequency search
payments <- PaymentPersistence.listActivePage frequency page perPage search
users <- UserPersistence.list
- incomes <- IncomePersistence.listAll -- TODO optimize
paymentRange <- PaymentPersistence.getRange
+ incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
+
+ cumulativeIncome <-
+ case (incomeDefinedForAll, paymentRange) of
+ (Just incomeStart, Just (paymentStart, paymentEnd)) ->
+ IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) paymentEnd
+
+ _ ->
+ return M.empty
searchRepartition <-
case paymentRange of
@@ -57,7 +63,7 @@ list frequency page perPage search =
(preIncomeRepartition, postIncomeRepartition) <-
PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
- let exceedingPayers = Payer.getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition (fst <$> paymentRange)
+ let exceedingPayers = Payer.getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition
header = PaymentHeader
{ _paymentHeader_exceedingPayers = exceedingPayers
diff --git a/server/src/Design/Global.hs b/server/src/Design/Global.hs
index df41cfd..ebd7084 100644
--- a/server/src/Design/Global.hs
+++ b/server/src/Design/Global.hs
@@ -12,6 +12,7 @@ import qualified Design.Constants as Constants
import qualified Design.Errors as Errors
import qualified Design.Form as Form
import qualified Design.Helper as Helper
+import qualified Design.Loadable as Loadable
import qualified Design.Media as Media
import qualified Design.Modal as Modal
import qualified Design.Tooltip as Tooltip
@@ -28,6 +29,7 @@ global = do
".tooltip" ? Tooltip.design
Views.design
Form.design
+ Loadable.design
spinKeyframes
appearKeyframe
@@ -92,14 +94,14 @@ global = do
h1 ? do
color Color.chestnutRose
- marginBottom (em 1)
- lineHeight (em 1.2)
+ lineHeight (em 1.3)
Media.desktop $ fontSize (px 24)
Media.tablet $ fontSize (px 22)
Media.mobile $ fontSize (px 20)
ul ? do
+ "margin-top" -: "1vh"
"margin-bottom" -: "3vh"
"margin-left" -: "1vh"
li <? do
diff --git a/server/src/Design/Loadable.hs b/server/src/Design/Loadable.hs
new file mode 100644
index 0000000..6b13f2d
--- /dev/null
+++ b/server/src/Design/Loadable.hs
@@ -0,0 +1,29 @@
+module Design.Loadable
+ ( design
+ ) where
+
+import Clay
+
+design :: Css
+design = do
+ ".g-Loadable" ? do
+ position relative
+ width (pct 100)
+ height (pct 100)
+
+ ".g-Loadable__Spinner" ? do
+ position absolute
+ top (px 0)
+ left (px 0)
+ width (pct 100)
+ height (pct 100)
+ display none
+
+ ".g-Loadable__Spinner--Loading" ? do
+ display block
+
+ ".g-Loadable__Content" ?
+ transition "opacity" (sec 0.4) ease (sec 0)
+
+ ".g-Loadable__Content--Loading" ?
+ opacity 0.5
diff --git a/server/src/Design/View/Table.hs b/server/src/Design/View/Table.hs
index c77cb7c..56bd389 100644
--- a/server/src/Design/View/Table.hs
+++ b/server/src/Design/View/Table.hs
@@ -15,6 +15,9 @@ design = do
margin (em 2) (em 2) (em 2) (em 2)
textAlign (alignSide sideCenter)
+ ".table" ? do
+ minHeight (px 540)
+
".lines" ? do
Media.tabletDesktop $ display displayTable
width (pct 100)
diff --git a/server/src/Design/Views.hs b/server/src/Design/Views.hs
index d36a728..270bb8e 100644
--- a/server/src/Design/Views.hs
+++ b/server/src/Design/Views.hs
@@ -32,15 +32,19 @@ design = do
"margin" -: "0 2vw"
".titleButton" ? do
- h1 ? do
- Media.tabletDesktop $ float floatLeft
+ display flex
+ marginBottom (em 1)
+
+ Media.tabletDesktop $ do
+ justifyContent spaceBetween
+ alignItems center
+
+ Media.mobile $ do
+ flexDirection column
+ "h1" ? marginBottom (em 0.5)
button ? do
Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
- Media.tabletDesktop $ do
- float floatRight
- position relative
- top (px (-8))
Media.mobile $ do
width (pct 100)
marginBottom (px 20)
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index 34bbd3a..16be396 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -2,8 +2,11 @@ module Job.WeeklyReport
( weeklyReport
) where
+import qualified Data.Map as M
import Data.Time.Clock (UTCTime, getCurrentTime)
+import Common.Model (User (..))
+
import Conf (Conf)
import qualified Model.Query as Query
import qualified Persistence.Income as IncomePersistence
@@ -21,19 +24,27 @@ weeklyReport conf mbLastExecution = do
return ()
Just lastExecution -> do
- (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
+ (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
users <- UserPersistence.list
paymentRange <- PaymentPersistence.getRange
+ incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
+ cumulativeIncome <-
+ case (incomeDefinedForAll, paymentRange) of
+ (Just incomeStart, Just (paymentStart, paymentEnd)) ->
+ IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) paymentEnd
+
+ _ ->
+ return M.empty
weekPayments <- PaymentPersistence.listModifiedSince lastExecution
weekIncomes <- IncomePersistence.listModifiedSince lastExecution
(preIncomeRepartition, postIncomeRepartition) <-
PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
- return (weekPayments, paymentRange, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
+ return (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
_ <-
SendMail.sendMail
conf
- (WeeklyReport.mail conf users weekPayments preIncomeRepartition postIncomeRepartition (fst <$> paymentRange) weekIncomes lastExecution now)
+ (WeeklyReport.mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition lastExecution now)
return ()
diff --git a/server/src/Payer.hs b/server/src/Payer.hs
index d913afe..ab8312e 100644
--- a/server/src/Payer.hs
+++ b/server/src/Payer.hs
@@ -1,25 +1,17 @@
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 Data.Map (Map)
+import qualified Data.Map as M
-import Common.Model (ExceedingPayer (..), Income (..),
- User (..), UserId)
+import Common.Model (ExceedingPayer (..), User (..), UserId)
data Payer = Payer
{ _payer_userId :: UserId
, _payer_preIncomePayments :: Int
, _payer_postIncomePayments :: Int
- , _payer_incomes :: [Income]
+ , _payer_income :: Int
}
data PostPaymentPayer = PostPaymentPayer
@@ -29,43 +21,29 @@ data PostPaymentPayer = PostPaymentPayer
, _postPaymentPayer_ratio :: Float
}
-getExceedingPayers :: UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [ExceedingPayer]
-getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition firstPayment =
+getExceedingPayers :: [User] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> [ExceedingPayer]
+getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition =
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 =
+ payers = getPayers userIds cumulativeIncome preIncomeRepartition postIncomeRepartition
+ postPaymentPayers = map getPostPaymentPayer payers
+ mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers
+ in case mbMaxRatio of
+ Just maxRatio ->
+ exceedingPayersFromAmounts
+ . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p))
+ $ postPaymentPayers
+ Nothing ->
+ exceedingPayersFromAmounts
+ . map (\p -> (_payer_userId p, _payer_preIncomePayments p))
+ $ payers
+
+getPayers :: [UserId] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> [Payer]
+getPayers userIds cumulativeIncome 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
+ , _payer_income = M.findWithDefault 0 userId cumulativeIncome
}
)
@@ -85,15 +63,14 @@ exceedingPayersFromAmounts userAmounts =
$ userAmounts
where mbMinAmount = safeMinimum . map snd $ userAmounts
-getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer
-getPostPaymentPayer currentTime since payer =
+getPostPaymentPayer :: Payer -> PostPaymentPayer
+getPostPaymentPayer payer =
PostPaymentPayer
{ _postPaymentPayer_userId = _payer_userId payer
, _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer
- , _postPaymentPayer_cumulativeIncome = cumulativeIncome
- , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral cumulativeIncome)
+ , _postPaymentPayer_cumulativeIncome = _payer_income payer
+ , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral $ _payer_income payer)
}
- where cumulativeIncome = cumulativeIncomesSince currentTime since (_payer_incomes payer)
getFinalDiff :: Float -> PostPaymentPayer -> Int
getFinalDiff maxRatio payer =
@@ -101,66 +78,6 @@ getFinalDiff maxRatio payer =
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
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index ba7ad19..e689505 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -1,21 +1,24 @@
module Persistence.Income
( count
, list
- , listAll
, listModifiedSince
, create
, edit
, delete
, definedForAll
+ , getCumulativeIncome
) where
import qualified Data.List as L
+import Data.Map (Map)
+import qualified Data.Map as M
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 Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)),
+ Only (Only))
import qualified Database.SQLite.Simple as SQLite
import Prelude hiding (id, until)
@@ -58,13 +61,6 @@ list 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"
- )
-
listModifiedSince :: UTCTime -> Query [Income]
listModifiedSince since =
Query (\conn ->
@@ -79,7 +75,7 @@ listModifiedSince since =
, "OR edited_at >= ?"
, "OR deleted_at >= ?"
])
- (Only since)
+ (since, since, since)
)
create :: UserId -> Day -> Int -> Query Income
@@ -156,6 +152,46 @@ definedForAll users =
where
fromRows rows =
if L.sort users == L.sort (map fst rows) then
- Maybe.listToMaybe . L.sort . map snd $ rows
+ Maybe.listToMaybe . reverse . L.sort . map snd $ rows
else
Nothing
+
+getCumulativeIncome :: Day -> Day -> Query (Map UserId Int)
+getCumulativeIncome start end =
+ Query (\conn -> M.fromList <$> SQLite.queryNamed conn (SQLite.Query query) parameters)
+ where
+ query =
+ T.intercalate "\n" $
+ [ "SELECT user_id, CAST(ROUND(SUM(count)) AS INTEGER) FROM ("
+ , " SELECT"
+ , " I1.user_id,"
+ , " ((JULIANDAY(MIN(I2.date)) - JULIANDAY(I1.date)) * I1.amount * 12 / 365) AS count"
+ , " FROM (" <> (selectBoundedIncomes ">" ":start") <> ") AS I1"
+ , " INNER JOIN (" <> (selectBoundedIncomes "<" ":end") <> ") AS I2"
+ , " ON I2.date > I1.date AND I2.user_id == I1.user_id"
+ , " GROUP BY I1.date, I1.user_id"
+ , ") GROUP BY user_id"
+ ]
+
+ selectBoundedIncomes op param =
+ T.intercalate "\n" $
+ [ " SELECT user_id, date, amount FROM ("
+ , " SELECT"
+ , " i.user_id, " <> param <> " AS date, i.amount"
+ , " FROM"
+ , " (SELECT id, MAX(date) AS max_date"
+ , " FROM income"
+ , " WHERE date <= " <> param <> " AND deleted_at IS NULL"
+ , " GROUP BY user_id) AS m"
+ , " INNER JOIN income AS i"
+ , " ON i.id = m.id AND i.date = m.max_date"
+ , " ) UNION"
+ , " SELECT user_id, date, amount"
+ , " FROM income"
+ , " WHERE date " <> op <> " " <> param <> " AND deleted_at IS NULL"
+ ]
+
+ parameters =
+ [ ":start" := start
+ , ":end" := end
+ ]
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index f75925d..953f0ae 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -163,14 +163,14 @@ listModifiedSince since =
SQLite.query
conn
(SQLite.Query . T.intercalate " " $
- [ "SELECT *"
+ [ "SELECT " <> fields
, "FROM payment"
, "WHERE"
, "created_at >= ?"
, "OR edited_at >= ?"
, "OR deleted_at >= ?"
])
- (Only since)
+ (since, since, since)
)
@@ -300,7 +300,13 @@ searchCategory paymentName =
fmap (\(CategoryIdRow d) -> d) . Maybe.listToMaybe <$>
SQLite.query
conn
- "SELECT category FROM payment WHERE name LIKE ? LIMIT 1"
+ (SQLite.Query . T.intercalate " " $
+ [ "SELECT category"
+ , "FROM payment"
+ , "WHERE deleted_at is NULL AND name LIKE ?"
+ , "ORDER BY edited_at, created_at"
+ , "LIMIT 1"
+ ])
(Only $ "%" <> paymentName <> "%")
)
diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 1f637bc..3fe224f 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -9,7 +9,6 @@ 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 (..),
@@ -27,8 +26,8 @@ import Model.PaymentResource (PaymentResource (..))
import qualified Payer as Payer
import Resource (Status (..), groupByStatus, statuses)
-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 :: Conf -> [User] -> [Income] -> [Payment] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> UTCTime -> UTCTime -> Mail
+mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end =
Mail
{ M.from = Conf.noReplyMail conf
, M.to = map _user_email users
@@ -37,24 +36,24 @@ mail conf users weekPayments preIncomeRepartition postIncomeRepartition firstPay
, " − "
, Msg.get Msg.WeeklyReport_Title
]
- , M.body = body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end
+ , M.body = body conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition 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 =
+body :: Conf -> [User] -> [Income] -> [Payment] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> UTCTime -> UTCTime -> Text
+body conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end =
T.intercalate "\n" $
- [ exceedingPayers conf end users incomes preIncomeRepartition postIncomeRepartition firstPayment
+ [ exceedingPayers conf users cumulativeIncome preIncomeRepartition postIncomeRepartition
, operations conf users paymentsGroupedByStatus incomesGroupedByStatus
]
where
paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
- incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes
+ incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ weekIncomes
-exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> Text
-exceedingPayers conf time users incomes preIncomeRepartition postIncomeRepartition firstPayment =
+exceedingPayers :: Conf -> [User] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> Text
+exceedingPayers conf users cumulativeIncome preIncomeRepartition postIncomeRepartition =
T.intercalate "\n" . map formatPayer $ payers
where
- payers = Payer.getExceedingPayers time users incomes preIncomeRepartition postIncomeRepartition firstPayment
+ payers = Payer.getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition
formatPayer p = T.concat
[ " * "
, fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 01:31:52 +0000