{-# 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
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
")"
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