{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}

module Propellor.Property.Scheduled
	( period
	, periodParse
	, Recurrance(..)
	, WeekDay
	, MonthDay
	, YearDay
	) where

import Propellor.Base
import Propellor.Types.Core
import Utility.Scheduled

import Data.Time.Clock
import Data.Time.LocalTime
import qualified Data.Map as M

-- | Makes a Property only be checked every so often.
--
-- This uses the description of the Property to keep track of when it was
-- last run.
period :: Property i -> Recurrance -> Property i
period :: forall i. Property i -> Recurrance -> Property i
period Property i
prop Recurrance
recurrance = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall p. IsProp p => p -> Desc -> p
describe Desc
desc forall a b. (a -> b) -> a -> b
$ forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy Property i
prop forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy -> do
	Maybe LocalTime
lasttime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Desc -> IO (Maybe LocalTime)
getLastChecked (forall p. IsProp p => p -> Desc
getDesc Property i
prop)
	Maybe LocalTime
nexttime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NextTime -> LocalTime
startTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schedule -> Maybe LocalTime -> IO (Maybe NextTime)
nextTime Schedule
schedule Maybe LocalTime
lasttime
	LocalTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO LocalTime
localNow
	if forall a. a -> Maybe a
Just LocalTime
t forall a. Ord a => a -> a -> Bool
>= Maybe LocalTime
nexttime
		then do
			Result
r <- Propellor Result
satisfy
			forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ LocalTime -> Desc -> IO ()
setLastChecked LocalTime
t (forall p. IsProp p => p -> Desc
getDesc Property i
prop)
			forall (m :: * -> *) a. Monad m => a -> m a
return Result
r
		else Propellor Result
noChange
  where
	schedule :: Schedule
schedule = Recurrance -> ScheduledTime -> Schedule
Schedule Recurrance
recurrance ScheduledTime
AnyTime
	desc :: Desc
desc = forall p. IsProp p => p -> Desc
getDesc Property i
prop forall a. [a] -> [a] -> [a]
++ Desc
" (period " forall a. [a] -> [a] -> [a]
++ Recurrance -> Desc
fromRecurrance Recurrance
recurrance forall a. [a] -> [a] -> [a]
++ Desc
")"

-- | Like period, but parse a human-friendly string.
periodParse :: Property i -> String -> Property i
periodParse :: forall i. Property i -> Desc -> Property i
periodParse Property i
prop Desc
s = case Desc -> Maybe Recurrance
toRecurrance Desc
s of
	Just Recurrance
recurrance -> forall i. Property i -> Recurrance -> Property i
period Property i
prop Recurrance
recurrance
	Maybe Recurrance
Nothing -> forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy Property i
prop forall a b. (a -> b) -> a -> b
$ \Propellor Result
_ -> do
		forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Desc -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ Desc
"failed periodParse: " forall a. [a] -> [a] -> [a]
++ Desc
s
		Propellor Result
noChange

lastCheckedFile :: FilePath
lastCheckedFile :: Desc
lastCheckedFile = Desc
localdir Desc -> Desc -> Desc
</> Desc
".lastchecked"

getLastChecked :: Desc -> IO (Maybe LocalTime)
getLastChecked :: Desc -> IO (Maybe LocalTime)
getLastChecked Desc
desc = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Desc
desc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map Desc LocalTime)
readLastChecked

localNow :: IO LocalTime
localNow :: IO LocalTime
localNow = do
	UTCTime
now <- IO UTCTime
getCurrentTime
	TimeZone
tz <- UTCTime -> IO TimeZone
getTimeZone UTCTime
now
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz UTCTime
now

setLastChecked :: LocalTime -> Desc -> IO ()
setLastChecked :: LocalTime -> Desc -> IO ()
setLastChecked LocalTime
time Desc
desc = do
	Map Desc LocalTime
m <- IO (Map Desc LocalTime)
readLastChecked
	Map Desc LocalTime -> IO ()
writeLastChecked (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Desc
desc LocalTime
time Map Desc LocalTime
m)

readLastChecked :: IO (M.Map Desc LocalTime)
readLastChecked :: IO (Map Desc LocalTime)
readLastChecked = forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO forall a. Maybe a
Nothing IO (Maybe (Map Desc LocalTime))
go
  where
	go :: IO (Maybe (Map Desc LocalTime))
go = forall a. Read a => Desc -> Maybe a
readish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Desc -> IO Desc
readFileStrict Desc
lastCheckedFile

writeLastChecked :: M.Map Desc LocalTime -> IO ()
writeLastChecked :: Map Desc LocalTime -> IO ()
writeLastChecked = Desc -> Desc -> IO ()
writeFile Desc
lastCheckedFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Desc
show