summaryrefslogtreecommitdiff
path: root/Propellor/Property/Scheduled.hs
diff options
context:
space:
mode:
authorJoey Hess2014-04-09 00:54:27 -0400
committerJoey Hess2014-04-09 00:54:27 -0400
commit064cdd8fc575e5a16fa20bf382387560e9e4c580 (patch)
treeaee8e55a2d5655941125041aba8558bd51ea3e35 /Propellor/Property/Scheduled.hs
parent969f01eb73cee1e49faf0195de5c784182349261 (diff)
propellor spin
Diffstat (limited to 'Propellor/Property/Scheduled.hs')
-rw-r--r--Propellor/Property/Scheduled.hs58
1 files changed, 58 insertions, 0 deletions
diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs
new file mode 100644
index 00000000..42ff0068
--- /dev/null
+++ b/Propellor/Property/Scheduled.hs
@@ -0,0 +1,58 @@
+module Propellor.Property.Scheduled
+ ( period
+ , Recurrance(..)
+ , WeekDay
+ , MonthDay
+ , YearDay
+ ) where
+
+import Propellor
+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 -> Recurrance -> Property
+period prop recurrance = Property desc $ do
+ lasttime <- getLastChecked (propertyDesc prop)
+ nexttime <- fmap startTime <$> nextTime schedule lasttime
+ t <- localNow
+ if Just t >= nexttime
+ then do
+ r <- ensureProperty prop
+ setLastChecked t (propertyDesc prop)
+ return r
+ else noChange
+ where
+ schedule = Schedule recurrance AnyTime
+ desc = propertyDesc prop ++ " (period " ++ show recurrance ++ ")"
+
+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 <$> readFile lastCheckedFile
+
+writeLastChecked :: M.Map Desc LocalTime -> IO ()
+writeLastChecked = writeFile lastCheckedFile . show