From 3dda636033123f6e1d9fa45a1971b9daf6ebcf54 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 1 Apr 2015 17:53:16 -0400
Subject: fsck: Added --distributed and --expire options, for distributed fsck.

---
 Logs/Location.hs | 22 ++++++++++++++++------
 Logs/Presence.hs | 18 +++++++++++++-----
 Logs/Web.hs      |  2 +-
 3 files changed, 30 insertions(+), 12 deletions(-)

(limited to 'Logs')

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
-- 
cgit v1.2.3