diff options
Diffstat (limited to 'common/src')
| -rw-r--r-- | common/src/Common/Model/IncomeHeader.hs | 12 | ||||
| -rw-r--r-- | common/src/Common/Model/Payer.hs | 71 |
2 files changed, 45 insertions, 38 deletions
diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs index a1defdf..87c7aae 100644 --- a/common/src/Common/Model/IncomeHeader.hs +++ b/common/src/Common/Model/IncomeHeader.hs @@ -2,15 +2,15 @@ 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 Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.User (UserId) +import Common.Model.User (UserId) data IncomeHeader = IncomeHeader - { _incomeHeader_since :: Maybe UTCTime + { _incomeHeader_since :: Maybe Day , _incomeHeader_byUser :: Map UserId Int } deriving (Show, Generic) diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs index 40228d5..3c816c8 100644 --- a/common/src/Common/Model/Payer.hs +++ b/common/src/Common/Model/Payer.hs @@ -9,6 +9,7 @@ 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 (..)) @@ -36,10 +37,11 @@ data ExceedingPayer = ExceedingPayer getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer] getExceedingPayers currentTime users incomes payments = let userIds = map _user_id users - payers = getPayers currentTime userIds incomes payments + payers = getPayers userIds incomes payments exceedingPayersOnPreIncome = exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers - mbSince = useIncomesFrom userIds incomes payments + firstPayment = safeHead . List.sort . map _payment_date $ payments + mbSince = useIncomesFrom userIds incomes firstPayment in case mbSince of Just since -> let postPaymentPayers = map (getPostPaymentPayer currentTime since) payers @@ -54,25 +56,30 @@ getExceedingPayers currentTime users incomes payments = _ -> exceedingPayersOnPreIncome -useIncomesFrom :: [UserId] -> [Income] -> [Payment] -> Maybe UTCTime -useIncomesFrom userIds incomes payments = - let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments - mbIncomeTime = incomeDefinedForAll userIds incomes - in case (firstPaymentTime, mbIncomeTime) of - (Just t1, Just t2) -> Just (max t1 t2) - _ -> Nothing +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 -paymentTime :: Payment -> UTCTime -paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date +dayUTCTime :: Day -> UTCTime +dayUTCTime = flip UTCTime (Time.secondsToDiffTime 0) -getPayers :: UTCTime -> [UserId] -> [Income] -> [Payment] -> [Payer] -getPayers currentTime userIds incomes payments = +getPayers :: [UserId] -> [Income] -> [Payment] -> [Payer] +getPayers userIds incomes payments = let incomesDefined = incomeDefinedForAll userIds incomes in flip map userIds (\userId -> Payer { _payer_userId = userId , _payer_preIncomePayments = totalPayments - (\p -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined)) + (\p -> + case incomesDefined of + Just d -> + _payment_date p < d + + Nothing -> + True + ) userId payments , _payer_postIncomePayments = @@ -80,7 +87,7 @@ getPayers currentTime userIds incomes payments = (\p -> case incomesDefined of Nothing -> False - Just t -> paymentTime p >= t + Just t -> _payment_date p >= t ) userId payments @@ -104,7 +111,7 @@ exceedingPayersFromAmounts userAmounts = $ userAmounts where mbMinAmount = safeMinimum . map snd $ userAmounts -getPostPaymentPayer :: UTCTime -> UTCTime -> Payer -> PostPaymentPayer +getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer getPostPaymentPayer currentTime since payer = PostPaymentPayer { _postPaymentPayer_userId = _payer_userId payer @@ -120,35 +127,35 @@ getFinalDiff maxRatio payer = truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer) in postIncomeDiff + _postPaymentPayer_preIncomePayments payer -incomeDefinedForAll :: [UserId] -> [Income] -> Maybe UTCTime +incomeDefinedForAll :: [UserId] -> [Income] -> Maybe Day incomeDefinedForAll userIds incomes = let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds - firstIncomes = map (safeHead . List.sortOn incomeTime) userIncomes + firstIncomes = map (safeHead . List.sortOn _income_date) userIncomes in if all Maybe.isJust firstIncomes - then safeHead . reverse . List.sort . map incomeTime . Maybe.catMaybes $ firstIncomes + then safeHead . reverse . List.sort . map _income_date . Maybe.catMaybes $ firstIncomes else Nothing -cumulativeIncomesSince :: UTCTime -> UTCTime -> [Income] -> Int +cumulativeIncomesSince :: UTCTime -> Day -> [Income] -> Int cumulativeIncomesSince currentTime since incomes = getCumulativeIncome currentTime (getOrderedIncomesSince since incomes) -getOrderedIncomesSince :: UTCTime -> [Income] -> [Income] -getOrderedIncomesSince time incomes = - let mbStarterIncome = getIncomeAt time incomes - orderedIncomesSince = filter (\income -> incomeTime income >= time) 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 :: UTCTime -> [Income] -> Maybe Income -getIncomeAt time incomes = +getIncomeAt :: Day -> [Income] -> Maybe Income +getIncomeAt day incomes = case incomes of [x] -> - if incomeTime x < time - then Just $ x { _income_date = utctDay time } + if _income_date x < day + then Just $ x { _income_date = day } else Nothing x1 : x2 : xs -> - if incomeTime x1 < time && incomeTime x2 >= time - then Just $ x1 { _income_date = utctDay time } - else getIncomeAt time (x2 : xs) + if _income_date x1 < day && _income_date x2 >= day + then Just $ x1 { _income_date = day } + else getIncomeAt day (x2 : xs) [] -> Nothing @@ -171,7 +178,7 @@ getIncomesWithDuration currentTime incomes = (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs)) incomeTime :: Income -> UTCTime -incomeTime = flip UTCTime (Time.secondsToDiffTime 0) . _income_date +incomeTime = dayUTCTime . _income_date durationIncome :: (NominalDiffTime, Int) -> Int durationIncome (duration, income) = |