{-# 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"]
        
getPrevWeek :: (MonadReader VConfig m, MonadIO m) => m [[String]]
getPrevWeek = do
  z <- liftIO $  getDatesOfPrevWeek
  t z
  where t  = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))

getThisWeek :: (MonadReader VConfig m, MonadIO m) => m [[String]]
getThisWeek = 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 <- getThisWeek
  t <- getPrevWeek
  return $ makeTable ["Subject","Last week","This week"] $ spec1 z t



spec1 x y = merge1 (fst main) (snd main)
  where set = nub $ map (\x -> x !! 0) $ x ++ y
        elem1 x y= any (\z -> z !! 0 == x) y
        diff1 = map (\q -> elem1 q x) set
        diff2 = map (\q -> elem1 q y) set
        set1  = zipWithPadding " " [" "] set x
        set2  = zipWithPadding " " [" "] set y
        main = (map (\q -> z (fst q) (snd q) ) $ zip  diff1 set1,
             map (\q -> z (fst q) (snd q) ) $ zip  diff2 set2)

z :: Bool -> (String,[String]) -> [String]      
z x y  = if x then snd y else [fst y,"0"]

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)
-- [True,False,False]
-- [("cat",["cat","3"]),("cock",[" "]),("dog",[" "])]

merge1 :: [a] -> [a] -> [a]
merge1 xs     []     = xs
merge1 []     ys     = ys
merge1 (x:xs) (y:ys) = x : y : merge xs ys