module FuzzyTimings.SlicedTime (SlicedTime, 
                           fromTimeSlices, 
                           toTimeSlices,
                           fromBoundaries,
                           flattenSlicedTime,
                           intersectSlicedTime,
                           deleteSlicedTime,
                           slicedTimeBoundaries,
                           cutSlicedTime,
                           mapSlicedTime) where
import FuzzyTimings.TimeSlice
import Data.Maybe
import Control.Monad
import Data.Time.LocalTime
import Data.List

data SlicedTime a = SlicedTime {
        stSlices :: [TimeSlice a]
    } deriving (Show, Eq)


fromTimeSlices :: [TimeSlice a] -> SlicedTime a 
fromTimeSlices tss = SlicedTime {
        stSlices = tss
    }

toTimeSlices :: SlicedTime a -> [TimeSlice a]
toTimeSlices st = stSlices st

sortNub :: Ord a => [a] -> [a]
sortNub = map head . group . sort

fromBoundaries :: [LocalTime] -> a -> SlicedTime a
fromBoundaries bs d = SlicedTime {
        stSlices = slices bs
    }
    where slices (b1:b2:bs') = TimeSlice {
            tsStart = b1,
            tsEnd = b2,
            tsValue = d,
            tsPriority = 0
                }:slices (b2:bs')
          slices _ = []



intersectSlicedTime :: SlicedTime a -> SlicedTime b -> SlicedTime a
intersectSlicedTime st1 st2 = st1 {
        stSlices = concatMap intersect (stSlices st1)
    }
    where intersect ts = mapMaybe (intersectTimeSlice ts) $ stSlices st2


deleteSlicedTime :: SlicedTime a -> SlicedTime b -> SlicedTime a
deleteSlicedTime st1 st2 = foldl delete st1 (stSlices st2)
    where delete st ts = st {
            stSlices = concatMap (\t -> deleteTimeSlice t ts) $ stSlices st
        }

flattenSlicedTime :: SlicedTime a -> SlicedTime a
flattenSlicedTime st = SlicedTime { 
        stSlices = flatten (sort . stSlices $ st)
    }
    where
        flatten (t1:t2:tss) 
            --          |----|
            --            |----|
            | tsStart t1 < tsStart t2 && tsStart t2 < tsEnd t1 
                                      && tsEnd t2 > tsEnd t1 =
                    if tsPriority t1 > tsPriority t2
                        then t1 : flatten (t2 { tsStart = tsEnd t1 } : tss)
                        else (t1 { tsEnd = tsStart t2 }) : flatten (t2:tss)
            --          |----|
            --            |--|                
            | tsStart t1 < tsStart t2 && tsEnd t1 == tsEnd t2 =
                    if tsPriority t1 > tsPriority t2
                        then flatten (t1:tss)
                        else flatten ((t1 { tsEnd = tsStart t2 }) : t2:tss)
            --          |----|
            --           |--|
            | tsStart t1 < tsStart t2 && tsEnd t2 < tsEnd t1 =
                    if tsPriority t1 > tsPriority t2
                        then flatten (t1:tss)
                        else flatten $ (t1 { tsEnd = tsStart t2}) 
                                      : (t2:(t1 { tsStart=tsEnd t2 }):tss)
            --          |----|
            --          |-------|                    
            | tsStart t1 == tsStart t2 && tsEnd t2 > tsEnd t1 =
                    if tsPriority t1 > tsPriority t2
                        then flatten (t1:t2 { tsStart = tsEnd t1 } : tss)
                        else flatten (t2:tss)
            --          |----|
            --          |----|
            | tsStart t1 == tsStart t2 && tsEnd t1 == tsEnd t2 = 
                    if tsPriority t1 > tsPriority t2 
                        then flatten (t1:tss)
                        else flatten (t2:tss)
            --          |----|
            --          |---|
            | tsStart t1 == tsStart t2 && tsEnd t1 > tsEnd t2 =
                    if tsPriority t1 > tsPriority t2
                        then flatten (t1:tss)
                        else flatten (t2:(t1 { tsStart = tsEnd t2 }):tss)
            | otherwise = t1 : flatten (t2:tss)
        flatten tss = tss

slicedTimeBoundaries :: SlicedTime a -> [LocalTime]
slicedTimeBoundaries st = concatMap (\ts -> [tsStart ts, tsEnd ts]) 
                                    (stSlices st)
    
cutSlicedTime :: SlicedTime a -> [LocalTime] -> SlicedTime a
cutSlicedTime st boundaries = st {
        stSlices = concatMap (cutTimeSlice boundaries) (stSlices st)
    }

mapSlicedTime :: SlicedTime a -> (TimeSlice a -> Maybe (TimeSlice a)) -> SlicedTime a
mapSlicedTime st op = st {
        stSlices = mapMaybe op (stSlices st)
    }
