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

import Control.Monad.Reader
import Villefort.Definitions
--import Villefort.Time (getDatesOfPrevWeek,getDatesOfThisWeek)
import Villefort.Util
import Villefort.Database
import Data.Time 
import Data.Time.Calendar.WeekDate
import Data.Time.Calendar.OrdinalDate
import Data.List
import Data.List.Split as S
{-
unpackStringToDate :: [Char] -> D
unpackStringToDate x = D (read (nums !! 0) :: Integer) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int)
  where nums = S.splitOn "-" $  take 10 x
  -}


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

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
  
getStartOfWeek :: IO Day
getStartOfWeek = do
  currentDay <- toInteger <$> getDay
  today <- getDate
  return $ addDays (-currentDay) today

fromZonedTimeToDay :: String -> Day
fromZonedTimeToDay x = fromGregorian (read (split !! 0) :: Integer) (read (split !! 1) :: Int) (read (take 2 (split !! 2)) :: Int)
  where split = S.splitOn "-" x
getDate :: IO Day
getDate = do
  a <- getZonedTime
  let z = show a
  return $ fromZonedTimeToDay z 

getDay :: IO Int
getDay = do
  z <- getDate
  return $ snd $mondayStartWeek z
  
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




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


-- "2017-10-30"
-- ""2017-11-03"
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))

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

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"

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)

selectNum :: Bool -> (String,[String]) -> [String]      
selectNum 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


firstSecond :: [[String]] -> [[String]]
firstSecond (x:y:xs) = [(x ++ [(y !! 1)])] ++ firstSecond xs
firstSecond [_] = []
firstSecond [] = []

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 "