log: Add --gource mode, which generates output usable by gource.

As part of this, I fixed up how log was getting the descriptions of
remotes.

Command/Log.hs

@@ -8,6 +8,7 @@
 module Command.Log where
 
 import qualified Data.Set as S
+import qualified Data.Map as M
 import qualified Data.ByteString.Lazy.Char8 as L
 import Data.Time.Clock.POSIX
 import Data.Time
@@ -32,12 +33,17 @@ data RefChange = RefChange
 	, newref :: Git.Ref
 	}
 
+type Outputter = Bool -> POSIXTime -> [UUID] -> Annex ()
+
 def :: [Command]
 def = [withOptions options $
 	command "log" paramPaths seek "shows location log"]
 
 options :: [Option]
-options = map odate ["since", "after", "until", "before"] ++
+options = passthruOptions ++ [gourceOption]
+
+passthruOptions :: [Option]
+passthruOptions = map odate ["since", "after", "until", "before"] ++
 	[ Option.field ['n'] "max-count" paramNumber
 		"limit number of logs displayed"
 	]
@@ -45,26 +51,37 @@ options = map odate ["since", "after", "until", "before"] ++
 		odate n = Option.field [] n paramDate $
 			"show log " ++ n ++ " date"
 
+gourceOption :: Option
+gourceOption = Option.flag [] "gource" "format output for gource"
+
 seek :: [CommandSeek]
-seek = [withValue (concat <$> mapM getoption options) $ \os ->
+seek = [withValue (Remote.uuidDescriptions) $ \m ->
-	withFilesInGit $ whenAnnexed $ start os]
+	withValue (liftIO getCurrentTimeZone) $ \zone ->
+	withValue (concat <$> mapM getoption passthruOptions) $ \os ->
+	withFlag gourceOption $ \gource ->
+	withFilesInGit $ whenAnnexed $ start m zone os gource]
 	where
 		getoption o = maybe [] (use o) <$>
 			Annex.getField (Option.name o)
 		use o v = [Param ("--" ++ Option.name o), Param v]
 
-start :: [CommandParam] -> FilePath -> (Key, Backend) -> CommandStart
+start :: (M.Map UUID String) -> TimeZone -> [CommandParam] -> Bool ->
-start os file (key, _) = do
+	FilePath -> (Key, Backend) -> CommandStart
-	showLog file =<< readLog <$> getLog key os
+start m zone os gource file (key, _) = do
+	showLog output =<< readLog <$> getLog key os
 	liftIO Git.Command.reap
 	stop
+	where
+		output
+			| gource = gourceOutput lookupdescription file
+			| otherwise = normalOutput lookupdescription file zone
+		lookupdescription u = fromMaybe (fromUUID u) $ M.lookup u m
 
-showLog :: FilePath -> [RefChange] -> Annex ()
+showLog :: Outputter -> [RefChange] -> Annex ()
-showLog file ps = do
+showLog outputter ps = do
-	zone <- liftIO getCurrentTimeZone
 	sets <- mapM (getset newref) ps
 	previous <- maybe (return genesis) (getset oldref) (lastMaybe ps)
-	sequence_ $ compareChanges (output zone) $ sets ++ [previous]
+	sequence_ $ compareChanges outputter $ sets ++ [previous]
 	where
 		genesis = (0, S.empty)
 		getset select change = do
@@ -72,28 +89,36 @@ showLog file ps = do
 			return (changetime change, s)
 		get ref = map toUUID . Logs.Presence.getLog . L.unpack <$>
 			catObject ref
-		output zone present ts s = do
+
-			rs <- map (dropWhile isSpace) . lines <$>
+normalOutput :: (UUID -> String) -> FilePath -> TimeZone -> Outputter
-				Remote.prettyPrintUUIDs "log" (S.toList s)
+normalOutput lookupdescription file zone present ts us = do
-			liftIO $ mapM_ (putStrLn . format) rs
+	liftIO $ mapM_ (putStrLn . format) us
 	where
 		time = showTimeStamp zone ts
 		addel = if present then "+" else "-"
-					format r = unwords
+		format u = unwords [ addel, time, file, "|", 
-						[ addel, time, file, "|", r ]
+			fromUUID u ++ " -- " ++ lookupdescription u ]
+
+gourceOutput :: (UUID -> String) -> FilePath -> Outputter
+gourceOutput lookupdescription file present ts us = do
+	liftIO $ mapM_ (putStrLn . intercalate "|" . format) us
+	where
+		time = takeWhile isDigit $ show ts
+		addel = if present then "A" else "M"
+		format u = [ time, lookupdescription u, addel, file ]
 
 {- Generates a display of the changes (which are ordered with newest first),
  - by comparing each change with the previous change.
  - Uses a formatter to generate a display of items that are added and
  - removed. -}
-compareChanges :: Ord a => (Bool -> POSIXTime -> S.Set a -> b) -> [(POSIXTime, S.Set a)] -> [b]
+compareChanges :: Ord a => (Bool -> POSIXTime -> [a] -> b) -> [(POSIXTime, S.Set a)] -> [b]
 compareChanges format changes = concatMap diff $ zip changes (drop 1 changes)
 	where
 		diff ((ts, new), (_, old)) =
 			[format True ts added, format False ts removed]
 			where
-				added = S.difference new old
+				added = S.toList $ S.difference new old
-				removed = S.difference old new
+				removed = S.toList $ S.difference old new
 
 {- Gets the git log for a given location log file.
  -

Remote.hs

@@ -19,6 +19,7 @@ module Remote (
 	remoteList,
 	enabledRemoteList,
 	remoteMap,
+	uuidDescriptions,
 	byName,
 	prettyPrintUUIDs,
 	remotesWithUUID,
@@ -94,6 +95,18 @@ enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
 remoteMap :: Annex (M.Map UUID String)
 remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> remoteList
 
+{- Map of UUIDs and their descriptions.
+ - The names of Remotes are added to suppliment any description that has
+ - been set for a repository. -}
+uuidDescriptions :: Annex (M.Map UUID String)
+uuidDescriptions = M.unionWith addName <$> uuidMap <*> remoteMap
+
+addName :: String -> String -> String
+addName desc n
+	| desc == n = desc
+	| null desc = n
+	| otherwise = n ++ " (" ++ desc ++ ")"
+
 {- When a name is specified, looks up the remote matching that name.
  - (Or it can be a UUID.) Only finds currently configured git remotes. -}
 byName :: Maybe String -> Annex (Maybe Remote)
@@ -143,28 +156,24 @@ nameToUUID n = byName' n >>= go
 prettyPrintUUIDs :: String -> [UUID] -> Annex String
 prettyPrintUUIDs desc uuids = do
 	hereu <- getUUID
-	m <- M.unionWith addname <$> uuidMap <*> remoteMap
+	m <- uuidDescriptions
 	maybeShowJSON [(desc, map (jsonify m hereu) uuids)]
 	return $ unwords $ map (\u -> "\t" ++ prettify m hereu u ++ "\n") uuids
 	where
-		addname d n
+		finddescription m u = M.findWithDefault "" u m
-			| d == n = d
-			| null d = n
-			| otherwise = n ++ " (" ++ d ++ ")"
-		findlog m u = M.findWithDefault "" u m
 		prettify m hereu u
 			| not (null d) = fromUUID u ++ " -- " ++ d
 			| otherwise = fromUUID u
 			where
 				ishere = hereu == u
-				n = findlog m u
+				n = finddescription m u
 				d
 					| null n && ishere = "here"
-					| ishere = addname n "here"
+					| ishere = addName n "here"
 					| otherwise = n
 		jsonify m hereu u = toJSObject
 			[ ("uuid", toJSON $ fromUUID u)
-			, ("description", toJSON $ findlog m u)
+			, ("description", toJSON $ finddescription m u)
 			, ("here", toJSON $ hereu == u)
 			]
 

Seek.hs

@@ -101,6 +101,9 @@ withField :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> Comman
 withField option converter = withValue $
 	converter =<< Annex.getField (Option.name option)
 
+withFlag :: Option -> (Bool -> CommandSeek) -> CommandSeek
+withFlag option = withValue $ Annex.getFlag (Option.name option)
+
 withNothing :: CommandStart -> CommandSeek
 withNothing a [] = return [a]
 withNothing _ _ = error "This command takes no parameters."

debian/changelog

@@ -1,3 +1,9 @@
+git-annex (3.20120107) UNRELEASED; urgency=low
+
+  * log: Add --gource mode, which generates output usable by gource.
+
+ -- Joey Hess <joeyh@debian.org>  Sat, 07 Jan 2012 18:12:09 -0400
+
 git-annex (3.20120106) unstable; urgency=low
 
   * Support unescaped repository urls, like git does.

doc/git-annex.mdwn

@@ -282,6 +282,9 @@ subdirectories).
   --since, --after, --until, --before, and --max-count can be specified.
   They are passed through to git log. For example, --since "1 month ago"
 
+  To generate output suitable for the gource visualisation program,
+  specify --gource.
+
 * status
 
   Displays some statistics and other information, including how much data

doc/tips/visualizing_repositories_with_gource.mdwn

@@ -0,0 +1,20 @@
+[Gource](http://code.google.com/p/gource/) is an amazing animated
+visualisation of a git repository.
+
+Normally, gource shows files being added, removed, and changed in
+the repository, and the user(s) making the changes. Of course it can be
+used in this way in a repository using git-annex too; just run `gource`.
+
+The other way to use gource with git-annex is to visualise the movement of
+annexed file contents between repositories. In this view, the "users" are
+repositories, and they move around the file contents that are being added
+or removed from them with git-annex.
+
+To use gource this way, first go into the directory you want to visualize,
+and use `git annex log` to make an input file for `gource`:
+
+	git annex log --gource | tee gorce.log
+	sort gource.log | gource --log-format custom -
+
+The `git annex log` can take a while, to speed it up you can use something
+like `--after "4 monts ago" to limit how far back it goes.