{-# LANGUAGE FlexibleContexts #-} module Villefort.Weekly where import Control.Monad.Reader (MonadIO,MonadReader,liftIO) import Villefort.Definitions (VConfig(..)) import Villefort.Util import Villefort.Database (makeQuery) import Data.Time (Day,addDays,fromGregorian) import Data.Time.Calendar.WeekDate (toWeekDate) import Data.List (nub) -- | Return the list of days in the previous week 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 -- | Return the list of days that have happened this week 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 -- | returns the start of the date getStartOfWeek :: IO Day getStartOfWeek = do currentDay <- toInteger <$> getDay today <- getDate return $ addDays (-currentDay) today -- | Convert from string to Day datatype fromZonedTimeToDay :: String -> Day fromZonedTimeToDay x = fromGregorian (year up) (month up ) (day up) where up = unpackStringToDate x -- | returns the days that have happened this week 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 -- | generates weekly page weeklyStats :: (MonadReader VConfig m, MonadIO m) => m String weeklyStats = do dates<- liftIO getDatesOfWeek header <- getHeader (_,numWeek,_) <- liftIO $ toWeekDate <$> getDate let addWeek = ( ("