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 <- n
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))
n :: (MonadReader VConfig m, MonadIO m) => m String
n = do
z <- p
t <- st
let q = sortBy ( compare `on` head) $ z ++ t
return $ makeTable ["Subject","Last week","This week"] $ 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 [] = []