{-# LANGUAGE FlexibleContexts #-} module Villefort.Daily where --import Villefort.Time 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 putStrLn "same-day" 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 :: IO () 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