{-# 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 :: Property i -> Recurrance -> Property i
period Property i
prop Recurrance
recurrance = (Property i -> Desc -> Property i)
-> Desc -> Property i -> Property i
forall a b c. (a -> b -> c) -> b -> a -> c
flip Property i -> Desc -> Property i
forall p. IsProp p => p -> Desc -> p
describe Desc
desc (Property i -> Property i) -> Property i -> Property i
forall a b. (a -> b) -> a -> b
$ Property i -> (Propellor Result -> Propellor Result) -> Property i
forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy Property i
prop ((Propellor Result -> Propellor Result) -> Property i)
-> (Propellor Result -> Propellor Result) -> Property i
forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy -> do
	Maybe LocalTime
lasttime <- IO (Maybe LocalTime) -> Propellor (Maybe LocalTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe LocalTime) -> Propellor (Maybe LocalTime))
-> IO (Maybe LocalTime) -> Propellor (Maybe LocalTime)
forall a b. (a -> b) -> a -> b
$ Desc -> IO (Maybe LocalTime)
getLastChecked (Property i -> Desc
forall p. IsProp p => p -> Desc
getDesc Property i
prop)
	Maybe LocalTime
nexttime <- IO (Maybe LocalTime) -> Propellor (Maybe LocalTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe LocalTime) -> Propellor (Maybe LocalTime))
-> IO (Maybe LocalTime) -> Propellor (Maybe LocalTime)
forall a b. (a -> b) -> a -> b
$ (NextTime -> LocalTime) -> Maybe NextTime -> Maybe LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NextTime -> LocalTime
startTime (Maybe NextTime -> Maybe LocalTime)
-> IO (Maybe NextTime) -> IO (Maybe LocalTime)
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 <- IO LocalTime -> Propellor LocalTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO LocalTime
localNow
	if LocalTime -> Maybe LocalTime
forall a. a -> Maybe a
Just LocalTime
t Maybe LocalTime -> Maybe LocalTime -> Bool
forall a. Ord a => a -> a -> Bool
>= Maybe LocalTime
nexttime
		then do
			Result
r <- Propellor Result
satisfy
			IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ LocalTime -> Desc -> IO ()
setLastChecked LocalTime
t (Property i -> Desc
forall p. IsProp p => p -> Desc
getDesc Property i
prop)
			Result -> Propellor Result
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 = Property i -> Desc
forall p. IsProp p => p -> Desc
getDesc Property i
prop Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
" (period " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Recurrance -> Desc
fromRecurrance Recurrance
recurrance Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
")"

-- | Like period, but parse a human-friendly string.
periodParse :: Property i -> String -> Property i
periodParse :: Property i -> Desc -> Property i
periodParse Property i
prop Desc
s = case Desc -> Maybe Recurrance
toRecurrance Desc
s of
	Just Recurrance
recurrance -> Property i -> Recurrance -> Property i
forall i. Property i -> Recurrance -> Property i
period Property i
prop Recurrance
recurrance
	Maybe Recurrance
Nothing -> Property i -> (Propellor Result -> Propellor Result) -> Property i
forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy Property i
prop ((Propellor Result -> Propellor Result) -> Property i)
-> (Propellor Result -> Propellor Result) -> Property i
forall a b. (a -> b) -> a -> b
$ \Propellor Result
_ -> do
		IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ Desc -> IO ()
forall (m :: * -> *). MonadIO m => Desc -> m ()
warningMessage (Desc -> IO ()) -> Desc -> IO ()
forall a b. (a -> b) -> a -> b
$ Desc
"failed periodParse: " Desc -> Desc -> Desc
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 = Desc -> Map Desc LocalTime -> Maybe LocalTime
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Desc
desc (Map Desc LocalTime -> Maybe LocalTime)
-> IO (Map Desc LocalTime) -> IO (Maybe LocalTime)
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
	LocalTime -> IO LocalTime
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> IO LocalTime) -> LocalTime -> IO LocalTime
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 (Desc -> LocalTime -> Map Desc LocalTime -> Map Desc LocalTime
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 = Map Desc LocalTime
-> Maybe (Map Desc LocalTime) -> Map Desc LocalTime
forall a. a -> Maybe a -> a
fromMaybe Map Desc LocalTime
forall k a. Map k a
M.empty (Maybe (Map Desc LocalTime) -> Map Desc LocalTime)
-> IO (Maybe (Map Desc LocalTime)) -> IO (Map Desc LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Map Desc LocalTime)
-> IO (Maybe (Map Desc LocalTime))
-> IO (Maybe (Map Desc LocalTime))
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Maybe (Map Desc LocalTime)
forall a. Maybe a
Nothing IO (Maybe (Map Desc LocalTime))
go
  where
	go :: IO (Maybe (Map Desc LocalTime))
go = Desc -> Maybe (Map Desc LocalTime)
forall a. Read a => Desc -> Maybe a
readish (Desc -> Maybe (Map Desc LocalTime))
-> IO Desc -> IO (Maybe (Map Desc LocalTime))
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 (Desc -> IO ())
-> (Map Desc LocalTime -> Desc) -> Map Desc LocalTime -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Desc LocalTime -> Desc
forall a. Show a => a -> Desc
show