aboutsummaryrefslogtreecommitdiff
path: root/src/server/Job/MonthlyPayment.hs
blob: bac7062f8c0921442181db00e07e251ad48b838a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
module Job.MonthlyPayment
  ( monthlyPayment
  ) where

import Control.Monad.IO.Class (liftIO)

import Data.Time.Clock (UTCTime, getCurrentTime)

import Database.Persist (entityVal, insert)

import Model.Database
import qualified Model.Payment as Payment
import Model.Frequency

import Utils.Time (timeToDay)

monthlyPayment :: Maybe UTCTime -> IO UTCTime
monthlyPayment _ = runDb $ do
  monthlyPayments <- map entityVal <$> Payment.listMonthly
  now <- liftIO $ getCurrentTime
  actualDay <- liftIO $ timeToDay now
  let punctualPayments = map (\p -> p { paymentFrequency = Punctual, paymentDate = actualDay, paymentCreatedAt = now }) monthlyPayments
  _ <- sequence $ map insert punctualPayments
  return now