src/server/Model/Payer.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
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)