From a35278430ae2dd3ae2f0c5be291e49077bcac534 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 7 Jan 2012 18:13:12 -0400 Subject: [PATCH] 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 | 69 +++++++++++++------ Remote.hs | 27 +++++--- Seek.hs | 3 + debian/changelog | 6 ++ doc/git-annex.mdwn | 3 + .../visualizing_repositories_with_gource.mdwn | 20 ++++++ 6 files changed, 97 insertions(+), 31 deletions(-) create mode 100644 doc/tips/visualizing_repositories_with_gource.mdwn diff --git a/Command/Log.hs b/Command/Log.hs index 9b0e38626e..4013b535ef 100644 --- a/Command/Log.hs +++ b/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 -> - withFilesInGit $ whenAnnexed $ start os] +seek = [withValue (Remote.uuidDescriptions) $ \m -> + 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 os file (key, _) = do - showLog file =<< readLog <$> getLog key os +start :: (M.Map UUID String) -> TimeZone -> [CommandParam] -> Bool -> + FilePath -> (Key, Backend) -> CommandStart +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 file ps = do - zone <- liftIO getCurrentTimeZone +showLog :: Outputter -> [RefChange] -> Annex () +showLog outputter ps = do 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 <$> - Remote.prettyPrintUUIDs "log" (S.toList s) - liftIO $ mapM_ (putStrLn . format) rs - where - time = showTimeStamp zone ts - addel = if present then "+" else "-" - format r = unwords - [ addel, time, file, "|", r ] + +normalOutput :: (UUID -> String) -> FilePath -> TimeZone -> Outputter +normalOutput lookupdescription file zone present ts us = do + liftIO $ mapM_ (putStrLn . format) us + where + time = showTimeStamp zone ts + addel = if present then "+" else "-" + format u = unwords [ addel, time, file, "|", + 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 - removed = S.difference old new + added = S.toList $ S.difference new old + removed = S.toList $ S.difference old new {- Gets the git log for a given location log file. - diff --git a/Remote.hs b/Remote.hs index 3f60ca3acf..63d32f4295 100644 --- a/Remote.hs +++ b/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 - | d == n = d - | null d = n - | otherwise = n ++ " (" ++ d ++ ")" - findlog m u = M.findWithDefault "" u m + finddescription 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) ] diff --git a/Seek.hs b/Seek.hs index 59a85be886..bf0770f404 100644 --- a/Seek.hs +++ b/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." diff --git a/debian/changelog b/debian/changelog index 9b1e901d69..f61a4c799a 100644 --- a/debian/changelog +++ b/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 Sat, 07 Jan 2012 18:12:09 -0400 + git-annex (3.20120106) unstable; urgency=low * Support unescaped repository urls, like git does. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 1103ffaf69..629e191b5b 100644 --- a/doc/git-annex.mdwn +++ b/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 diff --git a/doc/tips/visualizing_repositories_with_gource.mdwn b/doc/tips/visualizing_repositories_with_gource.mdwn new file mode 100644 index 0000000000..5d9aa4fc24 --- /dev/null +++ b/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.