{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}
{-# OPTIONS -fno-warn-orphans #-}

-- | A schedule of commands that should be run at a certain time.
module BuildBox.Cron.Schedule
	( 
	-- * Time Periods
	  second, minute, hour, day

	-- * When
	, When		(..)
	, WhenModifier	(..)

	-- * Events
	, EventName
	, Event		(..)
	, earliestEventToStartAt
	, eventCouldStartAt

	-- * Schedules
	, Schedule	(..)
	, makeSchedule
	, lookupEventOfSchedule
	, lookupCommandOfSchedule
	, adjustEventOfSchedule
	, eventsOfSchedule)
where
import Data.Time
import Data.List
import Data.Function
import Data.Maybe
import Control.Monad
import Data.Map			(Map)
import qualified Data.Map	as Map

instance Read NominalDiffTime where
 readsPrec n str
  = let	[(secs :: Double, rest)] = readsPrec n str
    in	case rest of
		's' : rest'	-> [(fromRational $ toRational secs, rest')]
		_		-> []

second, minute, hour, day :: NominalDiffTime
second	= 1
minute  = 60
hour	= 60 * minute
day	= 24 * hour


-- When -------------------------------------------------------------------------------------------
-- | When to invoke some event.
data When
	-- | Just keep doing it.
	= Always

	-- | Don't do it, ever.
	| Never

	-- | Do it some time after we last started it.
	| Every NominalDiffTime
	
	-- | Do it some time after it last finished.
	| After NominalDiffTime
	
	-- | Do it each day at this time. The ''days'' are UTC days, not local ones.
	| Daily TimeOfDay
	deriving (Read, Show, Eq)


-- | Modifier to when.
data WhenModifier
	-- | If the event hasn't been invoked before then do it immediately
	--   when we start the cron process.
	= Immediate

	-- | Wait until after this time before doing it first.
	| WaitUntil UTCTime
	deriving (Read, Show, Eq)


-- Event ------------------------------------------------------------------------------------------
type EventName	= String

-- | Records when an event should start, and when it last ran.
data Event
	= Event
	{ -- | A unique name for this event.
	  --   Used when writing the schedule to a file.
	  eventName		:: EventName

	  -- | When to run the command.
	, eventWhen		:: When

	  -- | Modifier to the previous.
	, eventWhenModifier	:: Maybe WhenModifier

	  -- | When the event was last started, if any.
	, eventLastStarted	:: Maybe UTCTime
		
	  -- | When the event last finished, if any.
	, eventLastEnded	:: Maybe UTCTime }
	deriving (Read, Show, Eq)
	

-- | Given the current time and a list of events, determine which one should be started now.
--   If several events are avaliable then take the one with the earliest start time.
earliestEventToStartAt :: UTCTime -> [Event] -> Maybe Event
earliestEventToStartAt curTime events
 = let	eventsStartable	= filter (eventCouldStartAt curTime)   events
	eventsSorted	= sortBy (compare `on` eventLastStarted) eventsStartable
   in	listToMaybe eventsSorted


-- | Given the current time, decide whether an event could be started.
--   If the `WhenModifier` is `Immediate` this always returns true.
--   The `SkipFirst` modifier is ignored, as this is handled separately.
eventCouldStartAt :: UTCTime -> Event -> Bool
eventCouldStartAt curTime event
	-- If the event has never started or ended, and is marked as immediate,
	-- then start it right away.
	| Nothing		<- eventLastStarted  event
	, Nothing		<- eventLastEnded    event
	, Just Immediate	<- eventWhenModifier event
	= True

	-- If the current end time is before the start time, then the most
	-- recent iteration is still running, so don't start it again.
	| Just lastStarted	<- eventLastStarted event
 	, Just lastEnded	<- eventLastEnded   event
 	, lastEnded < lastStarted
	= False

	-- Keep waiting if there's a seconday wait modifier.
	| Just (WaitUntil waitTime)	<- eventWhenModifier event
	, curTime < waitTime
	= False

	-- Otherwise we have to look at the real schedule.
	| otherwise
	= case eventWhen event of
		Always		-> True
		Never		-> False

		Every diffTime	
	 	 -> maybe True
			(\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)
			(eventLastStarted event)

		After diffTime	
	 	 -> maybe True
			(\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime)
			(eventLastEnded event)
	
		Daily timeOfDay
		 -- If it's been less than a day since we last started it, then don't do it yet.
		 | Just lastStarted	<- eventLastStarted event
		 , (curTime `diffUTCTime` lastStarted) < day
		 -> False
		
		 | otherwise
		 -> let	-- If we were going to run it today, this is when it would be.
			startTimeToday
				= curTime
				{ utctDayTime	= timeOfDayToTime timeOfDay }
				
			-- If it's after that time then quit fooling around..
		    in	curTime > startTimeToday


-- Schedule ---------------------------------------------------------------------------------------
-- | Map of event names to their details and build commands.	
data Schedule cmd
	= Schedule (Map EventName (Event, cmd))


-- | Get the list of events in a schedule, ignoring the build commands.
eventsOfSchedule :: Schedule cmd -> [Event]
eventsOfSchedule (Schedule sched)
	= map fst $ Map.elems sched


-- | A nice way to produce a schedule.
makeSchedule :: [(EventName, When, Maybe WhenModifier, cmd)] -> Schedule cmd
makeSchedule tuples
 = let	makeSched (name, whn, mMod, cmd)
	  =	(name, (Event name whn mMod Nothing Nothing, cmd))
   in	Schedule $ Map.fromList $ map makeSched tuples


-- | Given an event name, lookup the associated event from a schedule.
lookupEventOfSchedule :: EventName -> Schedule cmd -> Maybe Event
lookupEventOfSchedule name (Schedule sched)
	= liftM fst $ Map.lookup name sched
	
	
-- | Given an event name, lookup the associated build command from a schedule.
lookupCommandOfSchedule :: EventName -> Schedule cmd -> Maybe cmd
lookupCommandOfSchedule name (Schedule sched)
	= liftM snd $ Map.lookup name sched


-- | Given a new version of an event, update any matching event in the schedule.
--   If the event not already there then return the original schedule.
adjustEventOfSchedule :: Event -> Schedule cmd -> Schedule cmd
adjustEventOfSchedule event (Schedule sched)
	= Schedule 
	$ Map.adjust 
		(\(_, build) -> (event, build))
		(eventName event) 
		sched