aboutsummaryrefslogtreecommitdiff
path: root/src/server/Job
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Job')
-rw-r--r--src/server/Job/Daemon.hs36
-rw-r--r--src/server/Job/Frequency.hs13
-rw-r--r--src/server/Job/Kind.hs22
-rw-r--r--src/server/Job/Model.hs47
-rw-r--r--src/server/Job/MonthlyPayment.hs19
-rw-r--r--src/server/Job/WeeklyReport.hs28
6 files changed, 0 insertions, 165 deletions
diff --git a/src/server/Job/Daemon.hs b/src/server/Job/Daemon.hs
deleted file mode 100644
index 0bc6f6e..0000000
--- a/src/server/Job/Daemon.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-module Job.Daemon
- ( runDaemons
- ) where
-
-import Control.Concurrent (threadDelay, forkIO, ThreadId)
-import Control.Monad (forever)
-import Data.Time.Clock (UTCTime)
-
-import Conf (Conf)
-import Job.Frequency (Frequency(..), microSeconds)
-import Job.Kind (Kind(..))
-import Job.Model (getLastExecution, actualizeLastCheck, actualizeLastExecution)
-import Job.MonthlyPayment (monthlyPayment)
-import Job.WeeklyReport (weeklyReport)
-import qualified Model.Query as Query
-import Utils.Time (belongToCurrentMonth, belongToCurrentWeek)
-
-runDaemons :: Conf -> IO ()
-runDaemons conf = do
- _ <- runDaemon MonthlyPayment EveryHour (fmap not . belongToCurrentMonth) monthlyPayment
- _ <- runDaemon WeeklyReport EveryHour (fmap not . belongToCurrentWeek) (weeklyReport conf)
- return ()
-
-runDaemon :: Kind -> Frequency -> (UTCTime -> IO Bool) -> (Maybe UTCTime -> IO UTCTime) -> IO ThreadId
-runDaemon kind frequency isLastExecutionTooOld runJob =
- forkIO . forever $ do
- mbLastExecution <- Query.run $ do
- actualizeLastCheck kind
- getLastExecution kind
- hasToRun <- case mbLastExecution of
- Just lastExecution -> isLastExecutionTooOld lastExecution
- Nothing -> return True
- if hasToRun
- then runJob mbLastExecution >>= (Query.run . actualizeLastExecution kind)
- else return ()
- threadDelay . microSeconds $ frequency
diff --git a/src/server/Job/Frequency.hs b/src/server/Job/Frequency.hs
deleted file mode 100644
index 263f6e6..0000000
--- a/src/server/Job/Frequency.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Job.Frequency
- ( Frequency(..)
- , microSeconds
- ) where
-
-data Frequency =
- EveryHour
- | EveryDay
- deriving (Eq, Read, Show)
-
-microSeconds :: Frequency -> Int
-microSeconds EveryHour = 1000000 * 60 * 60
-microSeconds EveryDay = (microSeconds EveryHour) * 24
diff --git a/src/server/Job/Kind.hs b/src/server/Job/Kind.hs
deleted file mode 100644
index af5d4f8..0000000
--- a/src/server/Job/Kind.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Job.Kind
- ( Kind(..)
- ) where
-
-import Database.SQLite.Simple (SQLData(SQLText))
-import Database.SQLite.Simple.FromField (fieldData, FromField(fromField))
-import Database.SQLite.Simple.Ok (Ok(Ok, Errors))
-import Database.SQLite.Simple.ToField (ToField(toField))
-import qualified Data.Text as T
-
-data Kind =
- MonthlyPayment
- | WeeklyReport
- deriving (Eq, Show, Read)
-
-instance FromField Kind where
- fromField field = case fieldData field of
- SQLText text -> Ok (read (T.unpack text) :: Kind)
- _ -> Errors [error "SQLText field required for job kind"]
-
-instance ToField Kind where
- toField kind = SQLText . T.pack . show $ kind
diff --git a/src/server/Job/Model.hs b/src/server/Job/Model.hs
deleted file mode 100644
index e1a3c77..0000000
--- a/src/server/Job/Model.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Job.Model
- ( Job(..)
- , getLastExecution
- , actualizeLastExecution
- , actualizeLastCheck
- ) where
-
-import Data.Maybe (isJust)
-import Data.Time.Clock (UTCTime, getCurrentTime)
-import Database.SQLite.Simple (Only(Only))
-import qualified Database.SQLite.Simple as SQLite
-import Prelude hiding (id)
-
-import Job.Kind
-import Model.Query (Query(Query))
-
-data Job = Job
- { id :: String
- , kind :: Kind
- , lastExecution :: Maybe UTCTime
- , lastCheck :: Maybe UTCTime
- } deriving (Show)
-
-getLastExecution :: Kind -> Query (Maybe UTCTime)
-getLastExecution jobKind =
- Query (\conn -> do
- [Only time] <- SQLite.query conn "SELECT last_execution FROM job WHERE kind = ?" (Only jobKind) :: IO [Only (Maybe UTCTime)]
- return time
- )
-
-actualizeLastExecution :: Kind -> UTCTime -> Query ()
-actualizeLastExecution jobKind time =
- Query (\conn -> do
- [Only result] <- SQLite.query conn "SELECT 1 FROM job WHERE kind = ?" (Only jobKind) :: IO [Only (Maybe Int)]
- if isJust result
- then SQLite.execute conn "UPDATE job SET last_execution = ? WHERE kind = ?" (time, jobKind)
- else SQLite.execute conn "INSERT INTO job (kind, last_execution, last_check) VALUES (?, ?, ?)" (jobKind, time, time)
- )
-
-actualizeLastCheck :: Kind -> Query ()
-actualizeLastCheck jobKind =
- Query (\conn -> do
- now <- getCurrentTime
- SQLite.execute conn "UPDATE job SET kind = ? WHERE last_check = ?" (jobKind, now)
- )
diff --git a/src/server/Job/MonthlyPayment.hs b/src/server/Job/MonthlyPayment.hs
deleted file mode 100644
index 8c11ccf..0000000
--- a/src/server/Job/MonthlyPayment.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Job.MonthlyPayment
- ( monthlyPayment
- ) where
-
-import Data.Time.Clock (UTCTime, getCurrentTime)
-
-import Model.Frequency
-import qualified Model.Payment as Payment
-import Utils.Time (timeToDay)
-import qualified Model.Query as Query
-
-monthlyPayment :: Maybe UTCTime -> IO UTCTime
-monthlyPayment _ = do
- monthlyPayments <- Query.run Payment.listMonthly
- now <- getCurrentTime
- actualDay <- timeToDay now
- let punctualPayments = map (\p -> p { Payment.frequency = Punctual, Payment.date = actualDay, Payment.createdAt = now }) monthlyPayments
- _ <- Query.run (Payment.createMany punctualPayments)
- return now
diff --git a/src/server/Job/WeeklyReport.hs b/src/server/Job/WeeklyReport.hs
deleted file mode 100644
index 5737c75..0000000
--- a/src/server/Job/WeeklyReport.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module Job.WeeklyReport
- ( weeklyReport
- ) where
-
-import Data.Time.Clock (UTCTime, getCurrentTime)
-
-import Conf (Conf)
-import qualified Model.Income as Income
-import qualified Model.Payment as Payment
-import qualified Model.Query as Query
-import qualified Model.User as User
-import qualified SendMail
-import qualified View.Mail.WeeklyReport as WeeklyReport
-
-weeklyReport :: Conf -> Maybe UTCTime -> IO UTCTime
-weeklyReport conf mbLastExecution = do
- now <- getCurrentTime
- case mbLastExecution of
- Nothing -> return ()
- Just lastExecution -> do
- (payments, incomes, users) <- Query.run $
- (,,) <$>
- Payment.modifiedDuring lastExecution now <*>
- Income.modifiedDuring lastExecution now <*>
- User.list
- _ <- SendMail.sendMail (WeeklyReport.mail conf users payments incomes lastExecution now)
- return ()
- return now