diff options
author | Joey Hess <joey@kitenet.net> | 2012-01-06 15:40:04 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-01-06 15:40:07 -0400 |
commit | a3a9f87047d27306c27f4108ee58af3365f284af (patch) | |
tree | 26fbd58b758a0a3773f7df05d30a8c101d866e1b | |
parent | 1f8a1058c96bd4ee11fcb353f0ede1842d79ab6a (diff) |
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.
-rw-r--r-- | Annex/Branch.hs | 1 | ||||
-rw-r--r-- | Command/Log.hs | 94 | ||||
-rw-r--r-- | GitAnnex.hs | 2 | ||||
-rw-r--r-- | Logs/Presence.hs | 7 | ||||
-rw-r--r-- | debian/changelog | 2 | ||||
-rw-r--r-- | debian/copyright | 2 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 5 |
7 files changed, 111 insertions, 2 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index d3a81d8e5..8f07b7aa2 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -6,6 +6,7 @@ -} module Annex.Branch ( + fullname, name, hasOrigin, hasSibling, diff --git a/Command/Log.hs b/Command/Log.hs new file mode 100644 index 000000000..486efdf11 --- /dev/null +++ b/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" diff --git a/GitAnnex.hs b/GitAnnex.hs index 64020754f..78f20e9d1 100644 --- a/GitAnnex.hs +++ b/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 diff --git a/Logs/Presence.hs b/Logs/Presence.hs index f5e4f1ea9..372af37d5 100644 --- a/Logs/Presence.hs +++ b/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 diff --git a/debian/changelog b/debian/changelog index e5687aac1..707e804af 100644 --- a/debian/changelog +++ b/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 diff --git a/debian/copyright b/debian/copyright index a8a38913e..dd880f142 100644 --- a/debian/copyright +++ b/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 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 9751560a9..87775ead9 100644 --- a/doc/git-annex.mdwn +++ b/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 |