diff options
author | Joris | 2015-09-06 23:25:44 +0200 |
---|---|---|
committer | Joris | 2015-09-06 23:25:44 +0200 |
commit | 53afb9c96904ab226ccee754419569da16c59871 (patch) | |
tree | 18c2497275d857f99399595d40a4ccc5a65e396a /src/server/MonthlyPaymentJob.hs | |
parent | 2e75a5ac41afd4d6458ad230bd26fd9e73c7bdb9 (diff) | |
download | budget-53afb9c96904ab226ccee754419569da16c59871.tar.gz budget-53afb9c96904ab226ccee754419569da16c59871.tar.bz2 budget-53afb9c96904ab226ccee754419569da16c59871.zip |
Setting up the monthly job
Diffstat (limited to 'src/server/MonthlyPaymentJob.hs')
-rw-r--r-- | src/server/MonthlyPaymentJob.hs | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/src/server/MonthlyPaymentJob.hs b/src/server/MonthlyPaymentJob.hs new file mode 100644 index 0000000..a3be375 --- /dev/null +++ b/src/server/MonthlyPaymentJob.hs @@ -0,0 +1,49 @@ +module MonthlyPaymentJob + ( monthlyPaymentJobListener + ) where + +import Data.Time.Clock +import Data.Time.LocalTime +import Data.Time.Calendar + +import Control.Concurrent (threadDelay) + +import Model.Database +import Model.Payment (createPayment, getMonthlyPayments) +import Model.JobKind +import Model.Job +import Model.Json.Payment as P +import Model.Frequency + +monthlyPaymentJobListener :: IO () +monthlyPaymentJobListener = do + mbLastExecution <- runDb $ getLastExecution MonthlyPaymentJob + runThisMonth <- case mbLastExecution of + Just lastExecution -> belongToCurrentMonth lastExecution + Nothing -> return False + if not runThisMonth + then runDb (monthlyJob >> actualizeLastExecution MonthlyPaymentJob) + else return () + sleepOneDay + monthlyPaymentJobListener + +monthlyJob :: Persist () +monthlyJob = do + monthlyPayments <- getMonthlyPayments + _ <- sequence $ map (\p -> createPayment (P.userId p) (P.name p) (P.cost p) Punctual) monthlyPayments + return () + +belongToCurrentMonth :: UTCTime -> IO Bool +belongToCurrentMonth time = do + month <- getLocalMonth time + actualMonth <- getCurrentTime >>= getLocalMonth + return (month == actualMonth) + +getLocalMonth :: UTCTime -> IO Int +getLocalMonth time = do + timeZone <- getCurrentTimeZone + let (_, month, _) = toGregorian . localDay $ utcToLocalTime timeZone time + return month + +sleepOneDay :: IO () +sleepOneDay = threadDelay (1000000 * 60 * 60 * 24) |