{-# 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 = ( ("