add a log file for scheduled activities
This commit is contained in:
parent
b22ed77fc4
commit
29ca49dad4
3 changed files with 77 additions and 0 deletions
4
Logs.hs
4
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"
|
||||
|
|
42
Logs/Schedule.hs
Normal file
42
Logs/Schedule.hs
Normal file
|
@ -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
|
31
Types/ScheduledActivity.hs
Normal file
31
Types/ScheduledActivity.hs
Normal file
|
@ -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
|
Loading…
Reference in a new issue