{-# LANGUAGE FlexibleContexts #-}
module Villefort.Daily where
import Villefort.Definitions (VConfig(..)
, Weekly(..))
import Villefort.Database (execQuery, makeQuery, addDaily)
import Control.Monad.Reader (MonadIO,MonadReader,runReaderT,forever,liftIO)
import Data.List.Split as S (splitOn)
import Control.Concurrent (threadDelay)
import Villefort.Util
writeDate :: (MonadReader VConfig m, MonadIO m) => m ()
writeDate = do
date <- liftIO $ show <$> getDate
execQuery ("update dates set date = ? where type = 'date';") [date]
readDate :: (MonadReader VConfig m, MonadIO m) => m D
readDate = do
rawDate <- makeQuery "select date from dates where type = 'date';"
return $ unpackStringToDate $ head $ head $ rawDate
writeDay :: (MonadReader VConfig m, MonadIO m) => m ()
writeDay = do
newDay <- liftIO $ show <$> getDay
execQuery ("update dates set date = ? where type = 'day';") [newDay]
readDay :: (MonadReader VConfig m, MonadIO m) => m Int
readDay = do
rawDay <- makeQuery "select date from dates where type = 'day';"
let int = read (head $ head $ rawDay) :: Int
return int
checkDay :: D -> D ->Bool
checkDay oldDate currentDate= ((day oldDate) == (day currentDate))
checkMonth :: D -> D -> Bool
checkMonth oldDate currentDate = (month oldDate) == (month currentDate)
checkYear :: D -> D -> Bool
checkYear oldDate currentDate = (year oldDate) == (year currentDate)
runDaily :: VConfig -> D -> D -> IO ()
runDaily vconf oldDate currentDate=
if (checkDay oldDate currentDate) then
return ()
else
putStrLn "adding-daily" >> do
dailies <- sequence (daily vconf)
mapM_ add dailies
where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) vconf)
runMonthly :: D -> D -> IO ()
runMonthly oldDate currentDate = if(checkMonth oldDate currentDate) then
putStrLn "same-month"
else
putStrLn "adding monthly"
runYearly :: D -> D -> IO ()
runYearly oldDate currentDate = if(checkYear oldDate currentDate) then
putStrLn "same-year"
else
putStrLn "adding yearly"
runWeekly :: VConfig -> Int -> Int -> IO ()
runWeekly conf old current = do
if old /= current
then do
let stmt = selector conf (current-1)
stmts <- sequence stmt
mapM_ add stmts
else return ()
where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) conf)
selector :: (Num a, Eq a) => VConfig -> a -> [IO [String]]
selector conf x
| x == 0 = monday lookconf
| x == 1 = tuesday lookconf
| x == 2 = wednesday lookconf
| x == 3 = thursday lookconf
| x == 4 = friday lookconf
| x == 5 = saturday lookconf
| otherwise = sunday lookconf
where lookconf = weekly conf
man :: VConfig -> IO ()
man conf = do
oldDate <- runReaderT readDate conf
currentDate <- getDateD
oldDay <- runReaderT readDay conf
currentDay <- getDay
runWeekly conf oldDay currentDay
runDaily conf oldDate currentDate
runReaderT writeDate conf
runReaderT writeDay conf
threadDelay 18000000
dailyCheck :: VConfig -> IO b
dailyCheck conf = forever$ man conf