-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

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

module Utils.Occurrences
  ( normalizeOccurrences
  ) where

import ClassyPrelude

import Model.Types
import Utils
import Utils.Lens

import Control.Monad.Trans.Reader (runReader)

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

import qualified Data.Set as Set

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


normalizeOccurrences :: Occurrences -> Occurrences
-- ^
--
--   - Removes unnecessary exceptions
--   - Merges overlapping schedules
normalizeOccurrences initial
  | Left new <- runReader (runExceptT go) initial
  = normalizeOccurrences new
  | otherwise
  = initial
  where
    go :: ExceptT Occurrences (Reader Occurrences) ()
    -- Find some inconsistency and `throwE` a version without it
    go = do
      scheduled <- view _occurrencesScheduled
      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 _occurrencesScheduled $ mapMaybe (\b -> (b, ) <$> merge b) . Set.toList . Set.delete a
          case merges of
            [] -> return ()
            ((b, merged) : _) -> throwE =<< asks (over _occurrencesScheduled $ Set.insert merged . Set.delete b . Set.delete a)

      exceptions <- view _occurrencesExceptions
      forM_ exceptions $ \case
        needle@ExceptNoOccur{..} -> do
          let LocalTime{..} = exceptTime
              (_, _, toEnum . (`mod` 7) -> localWeekDay) = toWeekDate localDay
          needed <- views _occurrencesScheduled . any $ \case
            ScheduleWeekly{..} -> and
              [ scheduleDayOfWeek == localWeekDay
              , scheduleStart <= localTimeOfDay
              , localTimeOfDay <= scheduleEnd
              ]
          unless needed $
            throwE =<< asks (over _occurrencesExceptions $ 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 _occurrencesScheduled . none $ \case
            ScheduleWeekly{..} -> and
              [ scheduleDayOfWeek == localWeekDay
              , scheduleStart == exceptStart
              , scheduleEnd == exceptEnd
              ]
          unless needed $
            throwE =<< asks (over _occurrencesExceptions $ Set.filter (not . withinNeedle) . Set.delete needle)