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.
This commit is contained in:
Joey Hess 2012-01-07 18:13:12 -04:00
parent 2f0c3befbd
commit a35278430a
6 changed files with 97 additions and 31 deletions

View file

@ -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
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 r = unwords
[ addel, time, file, "|", r ]
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.
-

View file

@ -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)
]

View file

@ -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."

6
debian/changelog vendored
View file

@ -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.

View file

@ -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

View file

@ -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.