fuzzy-timings-0.0.1: FuzzyTimings/WeeklySlicedTime.hs

module FuzzyTimings.WeeklySlicedTime (WeeklySlicedTime, 
                           fromTimeOfDaySlices, 
                           toTimeOfDaySlices,
                           flattenWeeklySlicedTime,
                           implementWeeklySlicedTime) where
import FuzzyTimings.TimeSlice
import FuzzyTimings.TimeOfDaySlice
import FuzzyTimings.SlicedTime
import Data.Time.Calendar.WeekDate (toWeekDate)
import Data.Time.Calendar
import Data.Maybe
import Data.Time.LocalTime
import Data.List
import qualified Data.Map as Map

type WeekDay = Int
type WSTMap a = Map.Map WeekDay [TimeOfDaySlice a]

data WeeklySlicedTime a = WeeklySlicedTime {
        wstSlices :: WSTMap a
    } deriving (Show, Eq)


fromTimeOfDaySlices :: [(WeekDay, [TimeOfDaySlice a])] -> WeeklySlicedTime a 
fromTimeOfDaySlices tss = WeeklySlicedTime {
        wstSlices = Map.fromList tss
    }

toTimeOfDaySlices :: WeeklySlicedTime a -> [(WeekDay, [TimeOfDaySlice a])]
toTimeOfDaySlices = Map.toList . wstSlices

flattenWeeklySlicedTime :: WeeklySlicedTime a -> WeeklySlicedTime a
flattenWeeklySlicedTime wst = WeeklySlicedTime { 
        wstSlices = Map.map (flatten . sort) (wstSlices wst)
    }
    where
        flatten (t1:t2:tss) 
            | todsOverlaps t1 t2 = t1 { todsEnd = todsStart t2 } : flatten (t2:tss)
            | otherwise = t1 : flatten (t2:tss)
        flatten tss = tss

implementWeeklySlicedTime :: WeeklySlicedTime a -> Day -> Day -> SlicedTime a
implementWeeklySlicedTime wst d1 d2 = fromTimeSlices slices
    where   
        slices = [ TimeSlice (LocalTime d (todsStart tods))
                             (LocalTime d (todsEnd tods))
                             (todsValue tods)
                   | d <- days, tods <- Map.findWithDefault [] (weekDay d) 
                                                            (wstSlices wst) ]
        weekDay d = let (_,_,wd) = toWeekDate d in wd
        days = [ addDays i d1 | i <- [0..diffDays d2 d1] ]