add a log file for scheduled activities

3 files changed, 77 insertions, 0 deletions

diff --git a/Logs.hs b/Logs.hs
index 6339efa13..4386b7fd7 100644
--- a/Logs.hs
+++ b/Logs.hs
@@ -28,6 +28,7 @@ uuidBasedLogs =
 	, trustLog
 	, groupLog 
 	, preferredContentLog
+	, scheduleLog
 	]
 
 {- All the ways to get a key from a presence log file -}
@@ -52,6 +53,9 @@ groupLog = "group.log"
 preferredContentLog :: FilePath
 preferredContentLog = "preferred-content.log"
 
+scheduleLog :: FilePath
+scheduleLog = "schedule.log"
+
 {- The pathname of the location log file for a given key. -}
 locationLogFile :: Key -> String
 locationLogFile key = hashDirLower key ++ keyFile key ++ ".log"
diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs
new file mode 100644
index 000000000..213aceeed
--- /dev/null
+++ b/Logs/Schedule.hs
@@ -0,0 +1,42 @@
+{- git-annex scheduled activities log
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.Schedule (
+	scheduleLog,
+	scheduleSet,
+	scheduleGet,
+) where
+
+import qualified Data.Map as M
+import Data.Time.Clock.POSIX
+
+import Common.Annex
+import Types.ScheduledActivity
+import qualified Annex.Branch
+import Logs
+import Logs.UUIDBased
+
+scheduleSet :: UUID -> [ScheduledActivity] -> Annex ()
+scheduleSet uuid@(UUID _) activities = do
+	ts <- liftIO getPOSIXTime
+	Annex.Branch.change scheduleLog $
+		showLog id . changeLog ts uuid val . parseLog Just
+  where
+  	val = intercalate "; " $ map fromScheduledActivity activities
+scheduleSet NoUUID _ = error "unknown UUID; cannot modify"
+
+scheduleMap :: Annex (M.Map UUID [ScheduledActivity])
+scheduleMap = simpleMap
+	. parseLogWithUUID parser
+	<$> Annex.Branch.get scheduleLog
+  where
+	parser _uuid = Just . mapMaybe toScheduledActivity . split "; "
+
+scheduleGet :: UUID -> Annex [ScheduledActivity]
+scheduleGet u = do
+	m <- scheduleMap
+	return $ fromMaybe [] $ M.lookup u m
diff --git a/Types/ScheduledActivity.hs b/Types/ScheduledActivity.hs
new file mode 100644
index 000000000..e2b8d088a
--- /dev/null
+++ b/Types/ScheduledActivity.hs
@@ -0,0 +1,31 @@
+{- git-annex scheduled activities
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.ScheduledActivity where
+
+import Common
+import Utility.Scheduled
+import Types.UUID
+
+data ScheduledActivity 
+	= ScheduledSelfFsck Schedule 
+	| ScheduledRemoteFsck UUID Schedule
+
+fromScheduledActivity :: ScheduledActivity -> String
+fromScheduledActivity (ScheduledSelfFsck s) = 
+	"fsck self at " ++ fromSchedule s
+fromScheduledActivity (ScheduledRemoteFsck u s) = 
+	"fsck " ++ fromUUID u ++ " at " ++ fromSchedule s
+
+toScheduledActivity :: String -> Maybe ScheduledActivity
+toScheduledActivity s = case words s of
+	("fsck":"self":rest) -> ScheduledSelfFsck
+		<$> toSchedule (unwords rest)
+	("fsck":u:rest) -> ScheduledRemoteFsck
+		<$> pure (toUUID u)
+		<*> toSchedule (unwords rest)
+	_ -> Nothing