From f005a84e5675cb3e551b2922ad42642df28264d6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 2 Apr 2011 15:50:51 -0400
Subject: [PATCH] add loggedKeys

---
 Content.hs     | 10 +++-------
 LocationLog.hs | 32 ++++++++++++++++++++++++++------
 Locations.hs   |  9 +++++++++
 Utility.hs     | 12 ++++++++++++
 4 files changed, 50 insertions(+), 13 deletions(-)

diff --git a/Content.hs b/Content.hs
index 88e8dbc007..ba265c9307 100644
--- a/Content.hs
+++ b/Content.hs
@@ -219,9 +219,9 @@ getKeysPresent' dir = do
 		then return []
 		else do
 			-- 2 levels of hashing
-			levela <- liftIO $ subdirContent dir
-			levelb <- liftIO $ mapM subdirContent levela
-			contents <- liftIO $ mapM subdirContent (concat levelb)
+			levela <- liftIO $ dirContents dir
+			levelb <- liftIO $ mapM dirContents levela
+			contents <- liftIO $ mapM dirContents (concat levelb)
 			files <- liftIO $ filterM present (concat contents)
 			return $ catMaybes $ map (fileKey . takeFileName) files
 	where
@@ -231,7 +231,3 @@ getKeysPresent' dir = do
 			case result of
 				Right s -> return $ isRegularFile s
 				Left _ -> return False
-		subdirContent d = do
-			c <- getDirectoryContents d
-			return $ map (d </>) $ filter notcruft c
-		notcruft f = f /= "." && f /= ".."
diff --git a/LocationLog.hs b/LocationLog.hs
index 8a47db2da3..c2d956a291 100644
--- a/LocationLog.hs
+++ b/LocationLog.hs
@@ -1,9 +1,7 @@
 {- git-annex location log
  -
- - git-annex keeps track of on which repository it last saw a value.
- - This can be useful when using it for archiving with offline storage.
- - When you indicate you --want a file, git-annex will tell you which
- - repositories have the value.
+ - git-annex keeps track of which repositories have the contents of annexed
+ - files.
  -
  - Location tracking information is stored in `.git-annex/key.log`.
  - Repositories record their UUID and the date when they --get or --drop
@@ -15,7 +13,7 @@
  - Git is configured to use a union merge for this file,
  - so the lines may be in arbitrary order, but it will never conflict.
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -25,14 +23,19 @@ module LocationLog (
 	logChange,
 	readLog,
 	writeLog,
-	keyLocations
+	keyLocations,
+	loggedKeys,
+	logFile
 ) where
 
 import Data.Time.Clock.POSIX
 import Data.Time
 import System.Locale
+import System.Directory
+import System.FilePath
 import qualified Data.Map as Map
 import Control.Monad (when)
+import Data.Maybe
 
 import qualified GitRepo as Git
 import Utility
@@ -153,3 +156,20 @@ mapLog m l =
 			Just l' -> (date l' <= date l)
 			Nothing -> True
 		u = uuid l
+
+{- Finds all keys that have location log information. -}
+loggedKeys :: Git.Repo -> IO [Key]
+loggedKeys repo = do
+	let dir = gitStateDir repo
+	exists <- doesDirectoryExist dir
+	if exists
+		then do
+			-- 2 levels of hashing
+			levela <- dirContents dir
+			levelb <- mapM tryDirContents levela
+			files <- mapM tryDirContents (concat levelb)
+			return $ catMaybes $
+				map (logFileKey . takeFileName) (concat files)
+		else return []
+	where
+		tryDirContents d = catch (dirContents d) (return . const [])
diff --git a/Locations.hs b/Locations.hs
index 6c413a2183..f263ea526b 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -21,6 +21,7 @@ module Locations (
 	isLinkToAnnex,
 	logFile,
 	logFileOld,
+	logFileKey,
 	hashDirMixed,
 
 	prop_idempotent_fileKey
@@ -127,6 +128,14 @@ logFile' :: (Key -> FilePath) -> Git.Repo -> Key -> String
 logFile' hasher repo key =
 	gitStateDir repo ++ hasher key ++ keyFile key ++ ".log"
 
+{- Converts a log filename into a key. -}
+logFileKey :: FilePath -> Maybe Key
+logFileKey file
+	| end == ".log" = readKey beginning
+	| otherwise = Nothing
+	where
+		(beginning, end) = splitAt (length file - 4) file
+
 {- Converts a key into a filename fragment.
  -
  - Escape "/" in the key name, to keep a flat tree of files and avoid
diff --git a/Utility.hs b/Utility.hs
index 8312335f86..72f5c50638 100644
--- a/Utility.hs
+++ b/Utility.hs
@@ -22,6 +22,7 @@ module Utility (
 	readMaybe,
 	safeWriteFile,
 	dirContains,
+	dirContents,
 	
 	prop_idempotent_shellEscape,
 	prop_idempotent_shellEscape_multiword,
@@ -235,3 +236,14 @@ safeWriteFile file content = do
 	createDirectoryIfMissing True (parentDir file)
 	writeFile tmpfile content
 	renameFile tmpfile file
+
+{- Lists the contents of a directory.
+ - Unlike getDirectoryContents, paths are not relative to the directory. -}
+dirContents :: FilePath -> IO [FilePath]
+dirContents d = do
+	c <- getDirectoryContents d
+	return $ map (d </>) $ filter notcruft c
+	where
+		notcruft "." = False
+		notcruft ".." = False
+		notcruft _ = True