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.

Annex/Branch.hs

@@ -6,6 +6,7 @@
  -}
 
 module Annex.Branch (
+	fullname,
 	name,
 	hasOrigin,
 	hasSibling,

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"

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

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

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
 

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

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