diff options
Diffstat (limited to 'Logs')
-rw-r--r-- | Logs/Location.hs | 22 | ||||
-rw-r--r-- | Logs/Presence.hs | 18 | ||||
-rw-r--r-- | Logs/Web.hs | 2 |
3 files changed, 30 insertions, 12 deletions
diff --git a/Logs/Location.hs b/Logs/Location.hs index 7c6888c0b..59375a512 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -17,8 +17,10 @@ module Logs.Location ( LogStatus(..), logStatus, logChange, + logChange', loggedLocations, loggedLocationsHistorical, + locationLog, loggedKeys, loggedKeysFor, ) where @@ -39,24 +41,32 @@ logStatus key s = do {- Log a change in the presence of a key's value in a repository. -} logChange :: Key -> UUID -> LogStatus -> Annex () -logChange key (UUID u) s = do +logChange = logChange' logNow + +logChange' :: (LogStatus -> String -> Annex LogLine) -> Key -> UUID -> LogStatus -> Annex () +logChange' mklog key (UUID u) s = do config <- Annex.getGitConfig - addLog (locationLogFile config key) =<< logNow s u -logChange _ NoUUID _ = noop + addLog (locationLogFile config key) =<< mklog s u +logChange' _ _ NoUUID _ = noop {- Returns a list of repository UUIDs that, according to the log, have - the value of a key. -} loggedLocations :: Key -> Annex [UUID] -loggedLocations = getLoggedLocations currentLog +loggedLocations = getLoggedLocations currentLogInfo {- Gets the location log on a particular date. -} loggedLocationsHistorical :: RefDate -> Key -> Annex [UUID] -loggedLocationsHistorical = getLoggedLocations . historicalLog +loggedLocationsHistorical = getLoggedLocations . historicalLogInfo getLoggedLocations :: (FilePath -> Annex [String]) -> Key -> Annex [UUID] getLoggedLocations getter key = do config <- Annex.getGitConfig - map toUUID <$> (getter . locationLogFile config) key + map toUUID <$> getter (locationLogFile config key) + +locationLog :: Key -> Annex [LogLine] +locationLog key = do + config <- Annex.getGitConfig + currentLog (locationLogFile config key) {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} diff --git a/Logs/Presence.hs b/Logs/Presence.hs index cb21adfb3..469ed8de9 100644 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -16,8 +16,10 @@ module Logs.Presence ( addLog, readLog, logNow, + logThen, currentLog, - historicalLog + currentLogInfo, + historicalLogInfo, ) where import Data.Time.Clock.POSIX @@ -42,15 +44,21 @@ logNow s i = do now <- liftIO getPOSIXTime return $ LogLine now s i +logThen :: POSIXTime -> LogStatus -> String -> Annex LogLine +logThen t s i = return $ LogLine t s i + {- Reads a log and returns only the info that is still in effect. -} -currentLog :: FilePath -> Annex [String] -currentLog file = map info . filterPresent <$> readLog file +currentLogInfo :: FilePath -> Annex [String] +currentLogInfo file = map info <$> currentLog file + +currentLog :: FilePath -> Annex [LogLine] +currentLog file = filterPresent <$> readLog file {- Reads a historical version of a log and returns the info that was in - effect at that time. - - The date is formatted as shown in gitrevisions man page. -} -historicalLog :: RefDate -> FilePath -> Annex [String] -historicalLog refdate file = map info . filterPresent . parseLog +historicalLogInfo :: RefDate -> FilePath -> Annex [String] +historicalLogInfo refdate file = map info . filterPresent . parseLog <$> Annex.Branch.getHistorical refdate file diff --git a/Logs/Web.hs b/Logs/Web.hs index 02d60170f..6c1e6d135 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -43,7 +43,7 @@ getUrls key = do where go [] = return [] go (l:ls) = do - us <- currentLog l + us <- currentLogInfo l if null us then go ls else return us |