{-# LANGUAGE FlexibleContexts, UnicodeSyntax #-}
module Villefort.Daily (dailyCheck ) where

import Villefort.Definitions (VConfig(..)
                             , Weekly(..))
import Villefort.Database (execQuery, makeQuery, addDaily)
import Control.Monad.Reader (MonadIO,MonadReader,runReaderT,forever,liftIO)
import Control.Concurrent (threadDelay)
import Villefort.Util (D
                      ,unpackStringToDate
                      ,getDay
                      ,day
                      ,month
                      ,year
                      ,getDate
                      ,getDateD)

-- | writes date to local database
writeDate :: (MonadReader VConfig m, MonadIO m) => m ()
writeDate = do
  date <- liftIO $ show <$> getDate
  execQuery ("update dates set  date = ? where type = 'date';") [date]

-- | reads date from local database
readDate :: (MonadReader VConfig m, MonadIO m) => m D
readDate = do
  rawDate <- makeQuery "select date from dates where type = 'date';"
  return $ unpackStringToDate $ head $ head $ rawDate

-- | writes day of week from local database
writeDay :: (MonadReader VConfig m, MonadIO m) => m ()
writeDay = do
  newDay <- liftIO $ show <$> getDay
  execQuery ("update dates set  date = ? where type = 'day';") [newDay]

-- | read day of week from local database
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


runCheck ∷ Eq x ⇒ VConfig → D → D → (VConfig → [IO [String]]) → (D → x) → String  → IO ()  
runCheck vconf oldDate currentDate extract extractInt addText  =
  if notrun  then
    return ()
  else do
    putStrLn addText
    todo ← sequence (extract vconf)
    mapM_ add todo
    where add = (\x → if null x then return () else runReaderT (addDaily x) vconf)
          notrun = (extractInt oldDate == extractInt currentDate)

-- | Runs days of the week specific tasks
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 putStrLn "didn't run weekly"
    where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) conf)

-- | selects correct tasks based on day of the week
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

-- | Run daily check for updates
dailyCheck :: VConfig -> IO ()
dailyCheck conf = forever $ do
  currentDate <- getDateD
  currentDay  <- getDay
  oldDate <- runReaderT readDate conf 
  oldDay <- runReaderT readDay conf
  let checkFunc = runCheck conf oldDate currentDate
  checkFunc daily day "added daily tasks"
  checkFunc monthly month "added monthly tasks"
  checkFunc yearly year "added yearly tasks"
  runWeekly conf oldDay currentDay
  runReaderT writeDate conf
  runReaderT writeDay conf
  -- check interval 
  threadDelay 18000000