diff options
Diffstat (limited to 'src/server/Model/Payer.hs')
-rw-r--r-- | src/server/Model/Payer.hs | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/src/server/Model/Payer.hs b/src/server/Model/Payer.hs new file mode 100644 index 0000000..3893765 --- /dev/null +++ b/src/server/Model/Payer.hs @@ -0,0 +1,46 @@ +module Model.Payer + ( getPayers + ) + where + +import Control.Monad.IO.Class (liftIO) + +import Data.Time.Clock (getCurrentTime) +import Data.List (find) +import Data.Maybe (fromMaybe, fromMaybe) + +import Database.Persist + +import Model.Database +import Model.Payer.Payment (getTotalPaymentsBefore, getTotalPaymentsAfter) +import Model.Payer.Income (incomeDefinedForAll) +import Model.User (getUsers) +import Model.Income (getIncomes) + +import qualified Model.Json.Payer as Json +import qualified Model.Json.Income as Json + +getPayers :: Persist [Json.Payer] +getPayers = do + userIds <- map entityKey <$> getUsers + incomes <- getIncomes + now <- liftIO getCurrentTime + incomeIsDefined <- fromMaybe now <$> incomeDefinedForAll + preIncomePaymentSums <- getTotalPaymentsBefore incomeIsDefined + postIncomePaymentSums <- getTotalPaymentsAfter incomeIsDefined + return $ map (getPayer incomes preIncomePaymentSums postIncomePaymentSums) userIds + +getPayer :: [Income] -> [(UserId, Int)] -> [(UserId, Int)] -> UserId -> Json.Payer +getPayer incomes preIncomePaymentSums postIncomePaymentSums userId = + Json.Payer + { Json.userId = userId + , Json.preIncomePaymentSum = findOrDefault userId 0 preIncomePaymentSums + , Json.postIncomePaymentSum = findOrDefault userId 0 postIncomePaymentSums + , Json.incomes = + map (\income -> Json.Income (incomeCreation income) (incomeAmount income)) + . filter ((==) userId . incomeUserId) + $ incomes + } + +findOrDefault :: (Eq a) => a -> b -> [(a, b)] -> b +findOrDefault a b = fromMaybe b . fmap snd . find ((==) a . fst) |