{-# LANGUAGE FlexibleContexts #-}
module Villefort.Weekly (weeklyStats) where

import Control.Monad.Reader (MonadIO,MonadReader,liftIO)
import Villefort.Definitions (VConfig(..))
import Villefort.Util (getDate,makeTable,getHeader,getDay,total)
import Villefort.Database (makeQuery)
import Data.Time (Day,addDays)
import Data.Time.Calendar.WeekDate (toWeekDate)
import Data.List (nub)

-- | Return the list of days in the previous week
getDatesOfPrevWeek :: IO [Day]
getDatesOfPrevWeek = do
  start <- addDays (-6) <$> getStartOfWeek
  return $ [start ,last $ take 7 $ scanl next start [1,1 .. ]]
  where next s x = addDays (x) s

-- | Return the list of days that have happened this week
getDatesOfThisWeek :: IO [Day]
getDatesOfThisWeek = do
  start <- addDays (1) <$> getStartOfWeek
  currentDay <- getDay
  return $ [start ,last $ take (currentDay+1) $ scanl next start [1,1 .. ]]
  where next s x = addDays (x) s

-- | returns the start of the date
getStartOfWeek :: IO Day
getStartOfWeek = do
  currentDay <- toInteger <$> getDay
  today <- getDate
  return $ addDays (-currentDay) today

-- | returns the days that have happened this week
getDatesOfWeek :: IO [Day]
getDatesOfWeek = do
  start <- getStartOfWeek
  currentDay <- getDay
  return $ tail $ take (currentDay+1) $ scanl next start [1,1 .. ]
  where next s x = addDays (x) s

-- | generates weekly page
weeklyStats :: (MonadReader VConfig m, MonadIO m) => m String
weeklyStats = do
  dates<- liftIO getDatesOfWeek
  header <-  getHeader
  (_,numWeek,_) <- liftIO $ toWeekDate <$> getDate
  let addWeek = ( ("<h1> Week " ++ show numWeek ++ "</h1> ") ++ )
  headerdays<-  (header ++ ) <$> addWeek <$> mconcat <$> mapM getSummaryDay  dates
  d <- genTabs
  return $ headerdays++ d

-- | returns a summary table for each day
getSummaryDay :: (MonadReader VConfig m, MonadIO m) => Day -> m String
getSummaryDay dayOfweek = do
  dat <- getDoneDay $ show  dayOfweek
  return ( (weeklyDays !! week) ++  (makeTable ["Subject","Time"] $ dat ++ [["Total", show$  total dat]]))
  where (_,_,week) =  toWeekDate dayOfweek
        weeklyDays =["","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]

-- | returns the subject and total times completed last week
getPrevWeek :: (MonadReader VConfig m, MonadIO m) => m [[String]]
getPrevWeek = do
  dayOfWeek <- liftIO $  getDatesOfPrevWeek
  t dayOfWeek
  where t  = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))

-- | returns the subject and total times completed this week
getThisWeek :: (MonadReader VConfig m, MonadIO m) => m [[String]]
getThisWeek = do
  firstOfWeek<- liftIO $ getDatesOfThisWeek
  t firstOfWeek
  where t  = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))

-- | creates the difference table for last week and this week
genTabs :: (MonadReader VConfig m, MonadIO m) => m String
genTabs = do
  datesOfThisWeek <- getThisWeek
  t <- getPrevWeek
  return $ makeTable ["Subject","Last week ","This week "] $ firstSecond $ spec1 t datesOfThisWeek

-- | ges the todos finished today
getDoneDay :: (MonadReader VConfig m, MonadIO m) =>String -> m [[String]]
getDoneDay queryDay = makeQuery $  "select Title, time  from todo where substr(Due,1,10) = '"++ queryDay ++ "' and time != 0"

-- | algorithm to sort different weeks subject and days nicely so that it displays well
spec1 :: [[String]] -> [[String]] -> [[String]]
spec1 lastWeek thisWeek = merge1 (fst main) (snd main)
  where set = nub $ map (\x -> x !! 0) $ lastWeek ++ thisWeek
        elem1 x y= any (\z -> z !! 0 == x) y
        diff1 = map (\q -> elem1 q lastWeek) set
        diff2 = map (\q -> elem1 q thisWeek) set
        set1  = zipWithPadding " " [" ","0"] set lastWeek
        set2  = zipWithPadding " " [" ","0"] set thisWeek
        main = (map (\q -> selectNum (fst q) (snd q) ) $ zip  diff1 set1,
             map (\q -> selectNum (fst q) (snd q) ) $ zip  diff2 set2)

-- | looks up number in table if it's not avaible default to zero
selectNum :: Bool -> (String,[String]) -> [String]      
selectNum x y  = if x then snd y else [fst y,"0"]

-- | zips with padding when one list runs out it fills in a default value
zipWithPadding :: a -> b -> [a] -> [b] -> [(a,b)]
zipWithPadding a b (x:xs) (y:ys) = (x,y) : zipWithPadding a b xs ys
zipWithPadding a _ []     ys     = zip (repeat a) ys
zipWithPadding _ b xs     []     = zip xs (repeat b)

-- | Merges two lists
merge1 :: [a] -> [a] -> [a]
merge1 xs     []     = xs
merge1 []     ys     = ys
merge1 (x:xs) (y:ys) = x : y : merge1 xs ys

-- | extracts the right table data for diff table s
firstSecond :: [[String]] -> [[String]]
firstSecond (x:y:xs) = [(x ++ [(y !! 1)])] ++ firstSecond xs
firstSecond [_] = []
firstSecond [] = []

-- | returns subject and times between start and end days
getSubWeek :: (MonadReader VConfig m, MonadIO m) => String -> String -> m [[String]]
getSubWeek start end= makeQuery $  "select subject,sum(time) \
                      \  from todo where \
                      \  substr(Due,1,10) >= '" ++  start ++"' \
                      \and substr(Due,1,10)  <=  '"++ end ++ "' \
                      \and time !=0 \
                      \group by subject "