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 System.IO.Strict as S
import Paths_Villefort
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 :: IO ()
writeDate = do
date <- show <$> getDate
datePath <- getDataFileName "data/date"
writeFile datePath date
readDate :: IO D
readDate = do
datePath <- getDataFileName "data/date"
rawDate <- S.readFile datePath
let date = unpackStringToDate rawDate
return date
writeDay :: IO ()
writeDay = do
newDay <- show <$> getDay
datePath <- getDataFileName "data/day"
writeFile datePath newDay
readDay :: IO Int
readDay = do
datePath <- getDataFileName "data/day"
rawDay <- S.readFile datePath
let int = read 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 (current1)
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 <- readDate
currentDate <- getDateD
oldDay <- readDay
currentDay <- getDay
runWeekly conf oldDay currentDay
runDaily conf oldDate currentDate
writeDate
writeDay
threadDelay 18000000
dailyCheck :: VConfig -> IO b
dailyCheck conf = forever$ man conf