{-# LANGUAGE FlexibleContexts #-}
module Villefort.Daily where
import Villefort.Time
import Villefort.Definitions
import Villefort.Database
import Villefort.Stats
import Villefort.Todo
import Villefort.Summary
import Villefort.Config
import Control.Monad.Reader
import Control.Monad.IO.Class
import Data.Time
import Data.Time.Calendar.WeekDate
import Data.List
import Data.Function

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> ") ++ )
  z <-  (header ++ ) <$> addWeek <$> mconcat <$> mapM getSummaryDay  dates
  d <- genTabs
  return $ z ++ d
  
getSummaryDay :: (MonadReader VConfig m, MonadIO m) => Day -> m String
getSummaryDay day = do
  dat <- getDoneDay $ show  day
  return ( (lookup !! week) ++  (makeTable ["Subject","Time"] $ dat ++ [["Total", show$  total dat]]))
  where (_,_,week) =  toWeekDate day
        lookup =["","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]
        
st :: (MonadReader VConfig m, MonadIO m) => m [[String]]
st = do
  z <- liftIO $  getDatesOfPrevWeek
  t z
  where t  = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))

p :: (MonadReader VConfig m, MonadIO m) => m [[String]]
p = do
  z <- liftIO $ getDatesOfThisWeek
  t z
  where t  = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))

genTabs :: (MonadReader VConfig m, MonadIO m) => m String
genTabs = do
  z <- p
  t <- st
  f <- liftIO $ getDatesOfPrevWeek
  n <- liftIO $ getDatesOfThisWeek
  let q =  sortBy ( compare  `on` head) $ z ++ t
  return $ makeTable ["Subject","Last week"++ show f,"This week" ++ show n] $ spec q


spec :: [[String]] -> [[String]]
spec (x:y:z) = if head x ==  head y
                  then [[head x] ++ tail x ++ tail y] ++ spec (y:z)
                       else spec (y:z)
                            
spec (x:y:[]) = if head x ==  (head y)
                  then [[head x], tail x ++ (tail y)] ++ spec [y]
                       else spec [y]

spec (x:[]) = [x]
spec [] = []