refactor git-annex branch log filename code into central location

Having one module that knows about all the filenames used on the branch
allows working back from an arbitrary filename to enough information about
it to implement dropping dead remotes and doing other log file compacting
as part of a forget transition.

Command/Log.hs

@@ -17,7 +17,7 @@ import Data.Char
 
 import Common.Annex
 import Command
-import qualified Logs.Location
+import Logs
 import qualified Logs.Presence
 import Annex.CatFile
 import qualified Annex.Branch
@@ -135,7 +135,7 @@ getLog :: Key -> [CommandParam] -> Annex [String]
 getLog key os = do
 	top <- fromRepo Git.repoPath
 	p <- liftIO $ relPathCwdToFile top
-	let logfile = p </> Logs.Location.logFile key
+	let logfile = p </> locationLogFile key
 	inRepo $ pipeNullSplitZombie $
 		[ Params "log -z --pretty=format:%ct --raw --abbrev=40"
 		, Param "--remove-empty"

Logs.hs

@@ -0,0 +1,110 @@
+{- git-annex log file names
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs where
+
+import Common.Annex
+import Types.Key
+
+data LogVariety = UUIDBasedLog | PresenceLog Key
+	deriving (Show)
+
+{- Converts a path from the git-annex branch into one of the varieties
+ - of logs used by git-annex, if it's a known path. -}
+getLogVariety :: FilePath -> Maybe LogVariety
+getLogVariety f
+	| f `elem` uuidBasedLogs = Just UUIDBasedLog
+	| otherwise = PresenceLog <$> firstJust (presenceLogs f)
+
+{- All the uuid-based logs stored in the git-annex branch. -}
+uuidBasedLogs :: [FilePath]
+uuidBasedLogs =
+	[ uuidLog
+	, remoteLog
+	, trustLog
+	, groupLog 
+	, preferredContentLog
+	]
+
+{- All the ways to get a key from a presence log file -}
+presenceLogs :: FilePath -> [Maybe Key]
+presenceLogs f =
+	[ urlLogFileKey f
+	, locationLogFileKey f
+	]
+
+uuidLog :: FilePath
+uuidLog = "uuid.log"
+
+remoteLog :: FilePath
+remoteLog = "remote.log"
+
+trustLog :: FilePath
+trustLog = "trust.log"
+
+groupLog :: FilePath
+groupLog = "group.log"
+
+preferredContentLog :: FilePath
+preferredContentLog = "preferred-content.log"
+
+{- The pathname of the location log file for a given key. -}
+locationLogFile :: Key -> String
+locationLogFile key = hashDirLower key ++ keyFile key ++ ".log"
+
+{- Converts a pathname into a key if it's a location log. -}
+locationLogFileKey :: FilePath -> Maybe Key
+locationLogFileKey path
+	| ["remote", "web"] `isPrefixOf` splitDirectories dir = Nothing
+        | ext == ".log" = fileKey base
+        | otherwise = Nothing
+  where
+	(dir, file) = splitFileName path
+        (base, ext) = splitAt (length file - 4) file
+
+{- The filename of the url log for a given key. -}
+urlLogFile :: Key -> FilePath
+urlLogFile key = hashDirLower key </> keyFile key ++ urlLogExt
+
+{- Old versions stored the urls elsewhere. -}
+oldurlLogs :: Key -> [FilePath]
+oldurlLogs key =
+	[ "remote/web" </> hashDirLower key </> key2file key ++ ".log"
+	, "remote/web" </> hashDirLower key </> keyFile key ++ ".log"
+	]
+
+urlLogExt :: String
+urlLogExt = ".log.web"
+
+{- Converts a url log file into a key.
+ - (Does not work on oldurlLogs.) -}
+urlLogFileKey :: FilePath -> Maybe Key
+urlLogFileKey path
+	| ext == urlLogExt = fileKey base
+	| otherwise = Nothing
+  where
+  	file = takeFileName path
+	(base, ext) = splitAt (length file - extlen) file
+	extlen = length urlLogExt
+
+{- Does not work on oldurllogs. -}
+isUrlLog :: FilePath -> Bool
+isUrlLog file = urlLogExt `isSuffixOf` file
+
+prop_logs_sane :: Key -> Bool
+prop_logs_sane dummykey = all id
+	[ isNothing (getLogVariety "unknown")
+	, expect isUUIDBasedLog (getLogVariety uuidLog)
+	, expect isPresenceLog (getLogVariety $ locationLogFile dummykey)
+	, expect isPresenceLog (getLogVariety $ urlLogFile dummykey)
+	]
+  where
+  	expect = maybe False
+  	isUUIDBasedLog UUIDBasedLog = True
+	isUUIDBasedLog _ = False
+	isPresenceLog (PresenceLog k) = k == dummykey
+	isPresenceLog _ = False

Logs/Group.hs

@@ -21,16 +21,13 @@ import qualified Data.Set as S
 import Data.Time.Clock.POSIX
 
 import Common.Annex
+import Logs
 import qualified Annex.Branch
 import qualified Annex
 import Logs.UUIDBased
 import Types.Group
 import Types.StandardGroups
 
-{- Filename of group.log. -}
-groupLog :: FilePath
-groupLog = "group.log"
-
 {- Returns the groups of a given repo UUID. -}
 lookupGroups :: UUID -> Annex (S.Set Group)
 lookupGroups u = (fromMaybe S.empty . M.lookup u) . groupsByUUID <$> groupMap

Logs/Location.hs

@@ -20,12 +20,11 @@ module Logs.Location (
 	loggedLocations,
 	loggedKeys,
 	loggedKeysFor,
-	logFile,
-	logFileKey
 ) where
 
 import Common.Annex
 import qualified Annex.Branch
+import Logs
 import Logs.Presence
 import Annex.UUID
 
@@ -37,19 +36,19 @@ logStatus key status = 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 = addLog (logFile key) =<< logNow s u
+logChange key (UUID u) s = addLog (locationLogFile key) =<< logNow 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 key = map toUUID <$> (currentLog . logFile) key
+loggedLocations key = map toUUID <$> (currentLog . locationLogFile) key
 
 {- Finds all keys that have location log information.
  - (There may be duplicate keys in the list.) -}
 loggedKeys :: Annex [Key]
-loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Annex.Branch.files
+loggedKeys = mapMaybe locationLogFileKey <$> Annex.Branch.files
 
 {- Finds all keys that have location log information indicating
  - they are present for the specified repository. -}
@@ -62,15 +61,3 @@ loggedKeysFor u = filterM isthere =<< loggedKeys
 		us <- loggedLocations k
 		let !there = u `elem` us
 		return there
-
-{- The filename of the log file for a given key. -}
-logFile :: Key -> String
-logFile key = hashDirLower key ++ keyFile key ++ ".log"
-
-{- Converts a log filename into a key. -}
-logFileKey :: FilePath -> Maybe Key
-logFileKey file
-	| ext == ".log" = fileKey base
-	| otherwise = Nothing
-  where
-	(base, ext) = splitAt (length file - 4) file

Logs/PreferredContent.hs

@@ -24,6 +24,7 @@ import Data.Time.Clock.POSIX
 import Common.Annex
 import qualified Annex.Branch
 import qualified Annex
+import Logs
 import Logs.UUIDBased
 import Limit
 import qualified Utility.Matcher
@@ -35,10 +36,6 @@ import Logs.Group
 import Logs.Remote
 import Types.StandardGroups
 
-{- Filename of preferred-content.log. -}
-preferredContentLog :: FilePath
-preferredContentLog = "preferred-content.log"
-
 {- Changes the preferred content configuration of a remote. -}
 preferredContentSet :: UUID -> String -> Annex ()
 preferredContentSet uuid@(UUID _) val = do

Logs/Remote.hs

@@ -25,12 +25,9 @@ import Data.Char
 import Common.Annex
 import qualified Annex.Branch
 import Types.Remote
+import Logs
 import Logs.UUIDBased
 
-{- Filename of remote.log. -}
-remoteLog :: FilePath
-remoteLog = "remote.log"
-
 {- Adds or updates a remote's config in the log. -}
 configSet :: UUID -> RemoteConfig -> Annex ()
 configSet u c = do

Logs/Trust.hs

@@ -27,14 +27,11 @@ import Common.Annex
 import Types.TrustLevel
 import qualified Annex.Branch
 import qualified Annex
+import Logs
 import Logs.UUIDBased
 import Remote.List
 import qualified Types.Remote
 
-{- Filename of trust.log. -}
-trustLog :: FilePath
-trustLog = "trust.log"
-
 {- Returns a list of UUIDs that the trustLog indicates have the
  - specified trust level.
  - Note that the list can be incomplete for SemiTrusted, since that's

Logs/UUID.hs

@@ -28,13 +28,10 @@ import Types.UUID
 import Common.Annex
 import qualified Annex
 import qualified Annex.Branch
+import Logs
 import Logs.UUIDBased
 import qualified Annex.UUID
 
-{- Filename of uuid.log. -}
-uuidLog :: FilePath
-uuidLog = "uuid.log"
-
 {- Records a description for a uuid in the log. -}
 describeUUID :: UUID -> String -> Annex ()
 describeUUID uuid desc = do

Logs/Web.hs

@@ -11,8 +11,6 @@ module Logs.Web (
 	getUrls,
 	setUrlPresent,
 	setUrlMissing,
-	urlLog,
-	urlLogKey,
 	knownUrls,
 	Downloader(..),
 	getDownloader,
@@ -22,9 +20,9 @@ module Logs.Web (
 import qualified Data.ByteString.Lazy.Char8 as L
 
 import Common.Annex
+import Logs
 import Logs.Presence
 import Logs.Location
-import Types.Key
 import qualified Annex.Branch
 import Annex.CatFile
 import qualified Git
@@ -36,35 +34,9 @@ type URLString = String
 webUUID :: UUID
 webUUID = UUID "00000000-0000-0000-0000-000000000001"
 
-urlLogExt :: String
-urlLogExt = ".log.web"
-
-urlLog :: Key -> FilePath
-urlLog key = hashDirLower key </> keyFile key ++ urlLogExt
-
-{- Converts a url log file into a key.
- - (Does not work on oldurlLogs.) -}
-urlLogKey :: FilePath -> Maybe Key
-urlLogKey file
-	| ext == urlLogExt = fileKey base
-	| otherwise = Nothing
-  where
-  	(base, ext) = splitAt (length file - extlen) file
-	extlen = length urlLogExt
-
-isUrlLog :: FilePath -> Bool
-isUrlLog file = urlLogExt `isSuffixOf` file
-
-{- Used to store the urls elsewhere. -}
-oldurlLogs :: Key -> [FilePath]
-oldurlLogs key = 
-	[ "remote/web" </> hashDirLower key </> key2file key ++ ".log"
-	, "remote/web" </> hashDirLower key </> keyFile key ++ ".log"
-	]
-
 {- Gets all urls that a key might be available from. -}
 getUrls :: Key -> Annex [URLString]
-getUrls key = go $ urlLog key : oldurlLogs key
+getUrls key = go $ urlLogFile key : oldurlLogs key
   where
 	go [] = return []
 	go (l:ls) = do
@@ -77,13 +49,13 @@ setUrlPresent :: Key -> URLString -> Annex ()
 setUrlPresent key url = do
 	us <- getUrls key
 	unless (url `elem` us) $ do
-		addLog (urlLog key) =<< logNow InfoPresent url
+		addLog (urlLogFile key) =<< logNow InfoPresent url
 		-- update location log to indicate that the web has the key
 		logChange key webUUID InfoPresent
 
 setUrlMissing :: Key -> URLString -> Annex ()
 setUrlMissing key url = do
-	addLog (urlLog key) =<< logNow InfoMissing url
+	addLog (urlLogFile key) =<< logNow InfoMissing url
 	whenM (null <$> getUrls key) $
 		logChange key webUUID InfoMissing
 

Test.hs

@@ -33,6 +33,7 @@ import qualified Types.KeySource
 import qualified Types.Backend
 import qualified Types.TrustLevel
 import qualified Types
+import qualified Logs
 import qualified Logs.UUIDBased
 import qualified Logs.Trust
 import qualified Logs.Remote
@@ -115,6 +116,7 @@ quickcheck =
 	, check "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode
 	, check "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape
 	, check "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword
+	, check "prop_logs_sane" Logs.prop_logs_sane
 	, check "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape
 	, check "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config
 	, check "prop_parentDir_basics" Utility.Path.prop_parentDir_basics

Upgrade/V2.hs

@@ -12,9 +12,9 @@ import qualified Git
 import qualified Git.Command
 import qualified Git.Ref
 import qualified Annex.Branch
-import Logs.Location
 import Annex.Content
 import Utility.Tmp
+import Logs
 
 olddir :: Git.Repo -> FilePath
 olddir g
@@ -47,7 +47,7 @@ upgrade = do
 
 	e <- liftIO $ doesDirectoryExist old
 	when e $ do
-		mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs
+		mapM_ (\(k, f) -> inject f $ locationLogFile k) =<< locationLogs
 		mapM_ (\f -> inject f f) =<< logFiles old
 
 	saveState False
@@ -73,7 +73,7 @@ locationLogs = do
   where
 	tryDirContents d = catchDefaultIO [] $ dirContents d
 	islogfile f = maybe Nothing (\k -> Just (k, f)) $
-			logFileKey $ takeFileName f
+			locationLogFileKey f
 
 inject :: FilePath -> FilePath -> Annex ()
 inject source dest = do

Utility/Misc.hs

@@ -91,6 +91,12 @@ massReplace vs = go [] vs
 			go (replacement:acc) vs (drop (length val) s)
 		| otherwise = go acc rest s
 
+{- First item in the list that is not Nothing. -}
+firstJust :: Eq a => [Maybe a] -> Maybe a
+firstJust ms = case dropWhile (== Nothing) ms of
+	[] -> Nothing
+	(md:_) -> md
+
 {- Given two orderings, returns the second if the first is EQ and returns
  - the first otherwise.
  -