{-# LANGUAGE FlexibleContexts #-}
module Villefort.Weekly where

import Control.Monad.Reader
import Villefort.Definitions
import Villefort.Time
import Villefort.Stats
import Villefort.Util
import Villefort.Database
import Data.Time
import Data.Time.Calendar.WeekDate
import Data.List

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))


-- "2017-10-30"
-- ""2017-11-03"
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 "] $ n $ spec1 t z

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

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 " " [" ","0"] set x
        set2  = zipWithPadding " " [" ","0"] 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)

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


n (x:y:xs) = [(x ++ [(y !! 1)])] ++ n xs
n [] = []

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 "