{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}

module Utils.Occurences
  ( normalizeOccurences
  ) where

import ClassyPrelude

import Model.Types
import Utils
import Utils.Lens

import Control.Monad.Trans.Reader (runReader, Reader)

import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)

import qualified Data.Set as Set

import Data.Time
import Data.Time.Calendar.WeekDate


normalizeOccurences :: Occurences -> Occurences
-- ^ 
--
--   - Removes unnecessary exceptions
--   - Merges overlapping schedules
normalizeOccurences initial
  | Left new <- runReader (runExceptT go) initial
  = normalizeOccurences new
  | otherwise
  = initial
  where
    go :: ExceptT Occurences (Reader Occurences) ()
    -- Find some inconsistency and `throwE` a version without it
    go = do
      scheduled <- view _occurencesScheduled
      forM_ scheduled $ \case
        a@ScheduleWeekly{} -> do
          let
            merge b@ScheduleWeekly{}
              | scheduleDayOfWeek a == scheduleDayOfWeek b -- b starts during a
              , scheduleStart a <= scheduleStart b
              , scheduleEnd a >= scheduleStart b
              = Just $ ScheduleWeekly (scheduleDayOfWeek a) (scheduleStart a) ((max `on` scheduleEnd) a b)
              | scheduleDayOfWeek a == scheduleDayOfWeek b -- b ends during a
              , scheduleStart a <= scheduleEnd b
              , scheduleEnd a >= scheduleEnd b
              = Just $ ScheduleWeekly (scheduleDayOfWeek a) ((min `on` scheduleStart) a b) (scheduleEnd a)
              | otherwise
              = Nothing
            merge _ = Nothing
          merges <- views _occurencesScheduled $ mapMaybe (\b -> (,) <$> pure b <*> merge b) . Set.toList . Set.delete a
          case merges of
            [] -> return ()
            ((b, merged) : _) -> throwE =<< asks (over _occurencesScheduled $ Set.insert merged . Set.delete b . Set.delete a)

      exceptions <- view _occurencesExceptions
      forM_ exceptions $ \case
        needle@ExceptNoOccur{..} -> do
          let LocalTime{..} = exceptTime
              (_, _, toEnum . (`mod` 7) -> localWeekDay) = toWeekDate localDay
          needed <- views _occurencesScheduled . any $ \case
            ScheduleWeekly{..} -> and
              [ scheduleDayOfWeek == localWeekDay
              , scheduleStart <= localTimeOfDay
              , localTimeOfDay <= scheduleEnd
              ]
          unless needed $
            throwE =<< asks (over _occurencesExceptions $ Set.delete needle)
        needle@ExceptOccur{..} -> do
          let (_, _, toEnum . (`mod` 7) -> localWeekDay) = toWeekDate exceptDay
              -- | Does this ExceptNoOccur target within needle?
              withinNeedle ExceptNoOccur{..} = LocalTime exceptDay exceptStart <= exceptTime
                                            && exceptTime <= LocalTime exceptDay exceptEnd
              withinNeedle _ = False
          needed <- views _occurencesScheduled . none $ \case
            ScheduleWeekly{..} -> and
              [ scheduleDayOfWeek == localWeekDay
              , scheduleStart == exceptStart
              , scheduleEnd == exceptEnd
              ]
          unless needed $
            throwE =<< asks (over _occurencesExceptions $ Set.filter (not . withinNeedle) . Set.delete needle)