    {-# 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 = (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 a. IO a -> Propellor a
    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 a. IO a -> Propellor a
    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 a b. (a -> b) -> Maybe a -> Maybe b
    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 a. IO a -> Propellor a
    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 a. IO a -> Propellor a
    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 a. a -> Propellor a
    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 :: forall i. 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 a. IO a -> Propellor a
    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 a. a -> IO a
    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