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:
parent
2f0c3befbd
commit
a35278430a
6 changed files with 97 additions and 31 deletions
|
@ -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.
|
||||
-
|
||||
|
|
27
Remote.hs
27
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)
|
||||
]
|
||||
|
||||
|
|
3
Seek.hs
3
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."
|
||||
|
|
6
debian/changelog
vendored
6
debian/changelog
vendored
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
20
doc/tips/visualizing_repositories_with_gource.mdwn
Normal file
20
doc/tips/visualizing_repositories_with_gource.mdwn
Normal 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.
|
Loading…
Reference in a new issue