diff options
| -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 |