log: New command that displays the location log for file, showing each repository they were added to and removed from.

This needs to run git log on the location log files to get at all past
versions of the file, which tends to be a bit slow.

It would be possible to make a version optimised for showing the location
logs for every key. That would only need to run git log once, so would be
faster, but it would need to process an enormous amount of data, so
would not speed up the individual file case.

In the future it would be nice to support log --format. log --json also
doesn't work right yet.

7 files changed, 111 insertions, 2 deletions

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index d3a81d8e5..8f07b7aa2 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -6,6 +6,7 @@
  -}
 
 module Annex.Branch (
+	fullname,
 	name,
 	hasOrigin,
 	hasSibling,
diff --git a/Command/Log.hs b/Command/Log.hs
new file mode 100644
index 000000000..486efdf11
--- /dev/null
+++ b/Command/Log.hs
@@ -0,0 +1,94 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Log where
+
+import qualified Data.Set as S
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Time.Clock.POSIX
+import Data.Time
+import System.Locale
+import Data.Char
+
+import Common.Annex
+import Command
+import qualified Logs.Location
+import qualified Logs.Presence
+import Annex.CatFile
+import qualified Annex.Branch
+import qualified Git
+import Git.Command
+import qualified Remote
+
+def :: [Command]
+def = [command "log" paramPaths seek "shows location log"]
+
+seek :: [CommandSeek]
+seek = [withFilesInGit $ whenAnnexed $ start]
+
+start :: FilePath -> (Key, Backend) -> CommandStart
+start file (key, _) = do
+	showStart file ""
+	liftIO $ putStrLn ""
+	showLog =<< readLog key
+	stop
+
+showLog :: [(POSIXTime, Git.Ref)] -> Annex ()
+showLog v = go Nothing v =<< (liftIO getCurrentTimeZone)
+	where
+		go new [] zone = diff S.empty new zone
+		go new ((ts, ref):ls) zone = do
+			cur <- S.fromList <$> get ref
+			diff cur new zone
+			go (Just (ts, cur)) ls zone
+		get ref = map toUUID . Logs.Presence.getLog . L.unpack <$>
+			catObject ref
+		diff _ Nothing _ = return ()
+		diff cur (Just (ts, new)) zone = do
+			let time = show $ utcToLocalTime zone $
+				posixSecondsToUTCTime ts
+			output time True added
+			output time False removed
+			where
+				added = S.difference new cur
+				removed = S.difference cur new
+		output time present s = do
+			rs <- map (dropWhile isSpace) . lines <$>
+				Remote.prettyPrintUUIDs "log" (S.toList s)
+			liftIO $ mapM_ (putStrLn . indent . format) rs
+				where
+					format r = unwords
+						[ time
+						, if present then "+" else "-"
+						, r
+						]
+
+getLog :: Key -> Annex [String]
+getLog key = do
+	top <- fromRepo Git.workTree
+	p <- liftIO $ relPathCwdToFile top
+	let logfile = p </> Logs.Location.logFile key
+	inRepo $ pipeNullSplit
+		[ Params "log -z --pretty=format:%ct --raw --abbrev=40"
+		, Param $ show Annex.Branch.fullname
+		, Param "--"
+		, Param logfile
+		]
+
+readLog :: Key -> Annex [(POSIXTime, Git.Ref)]
+readLog key = mapMaybe (parse . lines) <$> getLog key
+	where
+		parse (ts:raw:[]) = Just (parseTimeStamp ts, parseRaw raw)
+		parse _ = Nothing
+
+-- Parses something like ":100644 100644 oldsha newsha M"
+parseRaw :: String -> Git.Ref
+parseRaw l = Git.Ref $ words l !! 3
+
+parseTimeStamp :: String -> POSIXTime
+parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (error "bad timestamp") .
+	parseTime defaultTimeLocale "%s"
diff --git a/GitAnnex.hs b/GitAnnex.hs
index 64020754f..78f20e9d1 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -41,6 +41,7 @@ import qualified Command.Lock
 import qualified Command.PreCommit
 import qualified Command.Find
 import qualified Command.Whereis
+import qualified Command.Log
 import qualified Command.Merge
 import qualified Command.Status
 import qualified Command.Migrate
@@ -85,6 +86,7 @@ cmds = concat
 	, Command.DropUnused.def
 	, Command.Find.def
 	, Command.Whereis.def
+	, Command.Log.def
 	, Command.Merge.def
 	, Command.Status.def
 	, Command.Migrate.def
diff --git a/Logs/Presence.hs b/Logs/Presence.hs
index f5e4f1ea9..372af37d5 100644
--- a/Logs/Presence.hs
+++ b/Logs/Presence.hs
@@ -13,14 +13,15 @@
 
 module Logs.Presence (
 	LogStatus(..),
+	LogLine,
 	addLog,
 	readLog,
+	getLog,
 	parseLog,
 	showLog,
 	logNow,
 	compactLog,
 	currentLog,
-	LogLine
 ) where
 
 import Data.Time.Clock.POSIX
@@ -80,6 +81,10 @@ logNow s i = do
 currentLog :: FilePath -> Annex [String]
 currentLog file = map info . filterPresent <$> readLog file
 
+{- Given a log, returns only the info that is are still in effect. -}
+getLog :: String -> [String]
+getLog = map info . filterPresent . parseLog
+
 {- Returns the info from LogLines that are in effect. -}
 filterPresent :: [LogLine] -> [LogLine]
 filterPresent = filter (\l -> InfoPresent == status l) . compactLog
diff --git a/debian/changelog b/debian/changelog
index e5687aac1..707e804af 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,8 @@
 git-annex (3.20120106) UNRELEASED; urgency=low
 
   * Support unescaped repository urls, like git does.
+  * log: New command that displays the location log for file,
+    showing each repository they were added to and removed from.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 05 Jan 2012 14:29:30 -0400
 
diff --git a/debian/copyright b/debian/copyright
index a8a38913e..dd880f142 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -2,7 +2,7 @@ Format: http://dep.debian.net/deps/dep5/
 Source: native package
 
 Files: *
-Copyright: © 2010-2011 Joey Hess <joey@kitenet.net>
+Copyright: © 2010-2012 Joey Hess <joey@kitenet.net>
 License: GPL-3+
  The full text of version 3 of the GPL is distributed as doc/GPL in
  this package's source, or in /usr/share/common-licenses/GPL-3 on
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 9751560a9..87775ead9 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -273,6 +273,11 @@ subdirectories).
   Displays a list of repositories known to contain the content of the
   specified file or files.
 
+* log [path ...]
+
+  Displays the location log for the specified file or files,
+  showing each repository they were added to ("+") and removed from ("-").
+
 * status
 
   Displays some statistics and other information, including how much data