{-# LANGUAGE FlexibleContexts #-}
module Villefort.Daily where
import Villefort.Definitions
import Villefort.Database
import Control.Monad.Reader
import Data.Time
import Data.Time.Calendar.OrdinalDate
import Data.List.Split as S
import Control.Concurrent (threadDelay)
data D = D { year :: Integer,
month :: Int,
day :: Int} deriving (Show)
fromZonedTimeToDay :: String -> Day
fromZonedTimeToDay x = fromGregorian (year up) (month up ) (day up)
where up = unpackStringToDate x
getDate :: IO Day
getDate = fromZonedTimeToDay <$> show <$> getZonedTime
getDateD :: IO D
getDateD = unpackStringToDate <$> show <$> getZonedTime
unpackStringToDate :: [Char] -> D
unpackStringToDate x = D (read (nums !! 0) :: Integer) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int)
where nums = S.splitOn "-" $ take 10 x
getDay :: IO Int
getDay = do
z <- getDate
return $ snd $mondayStartWeek z
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