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

import Villefort.Definitions (VConfig(..)
                             , Weekly(..)
                             , Task(..))
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)
import Control.Exception(onException)

-- | 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 Task]) → (D → x) → String  → IO ()  
runCheck vconf oldDate currentDate extract extractInt addText  =
  if notrun  then
    return ()
  else do
    todo ← sequence' (extract vconf) :: IO [Task]
    mapM_ (add vconf)  todo
    where notrun = (extractInt oldDate == extractInt currentDate)

-- | Runs days of the week specific tasks
runWeekly :: VConfig -> Int -> Int -> IO ()
runWeekly vconf old current = do
  if old /= current
    then do
    let stmt = selector vconf (current-1)
    stmts <- sequence' stmt
    mapM_ (add vconf) stmts
    else pure ()

add :: VConfig -> Task -> IO ()
add conf x =  runReaderT ( addDaily x) conf

-- | Exception catching version of sequence used
-- | to throw errors if indivuals task fail, but
-- | still allowing non failing tasks to run
sequence' :: [IO Task] -> IO [Task]
sequence' []   = pure []
sequence' list = do
  let currentTask = head list
  res <- onException currentTask $ putStrLn  $ "task failed to run"
  rest <- sequence' $ tail list
  pure $ res : rest


-- | selects correct tasks based on day of the week
selector :: (Num a, Eq a) => VConfig -> a -> [IO Task]
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