summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Scheduled.hs
blob: 4a756c4133370997bc58b1e6500b6576a8056b5a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
{-# 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 prop recurrance = flip describe desc $ adjustPropertySatisfy prop $ \satisfy -> do
	lasttime <- liftIO $ getLastChecked (getDesc prop)
	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
	t <- liftIO localNow
	if Just t >= nexttime
		then do
			r <- satisfy
			liftIO $ setLastChecked t (getDesc prop)
			return r
		else noChange
  where
	schedule = Schedule recurrance AnyTime
	desc = getDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"

-- | Like period, but parse a human-friendly string.
periodParse :: Property i -> String -> Property i
periodParse prop s = case toRecurrance s of
	Just recurrance -> period prop recurrance
	Nothing -> adjustPropertySatisfy prop $ \_ -> do
		liftIO $ warningMessage $ "failed periodParse: " ++ s
		noChange

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

getLastChecked :: Desc -> IO (Maybe LocalTime)
getLastChecked desc = M.lookup desc <$> readLastChecked

localNow :: IO LocalTime
localNow = do
	now <- getCurrentTime
	tz <- getTimeZone now
	return $ utcToLocalTime tz now

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

readLastChecked :: IO (M.Map Desc LocalTime)
readLastChecked = fromMaybe M.empty <$> catchDefaultIO Nothing go
  where
	go = readish <$> readFileStrict lastCheckedFile

writeLastChecked :: M.Map Desc LocalTime -> IO ()
writeLastChecked = writeFile lastCheckedFile . show