Merge branch 'wip'

Annex/Branch.hs

@@ -6,6 +6,7 @@
  -}
 
 module Annex.Branch (
+	fullname,
 	name,
 	hasOrigin,
 	hasSibling,

Command.hs

@@ -30,7 +30,6 @@ import Types.Command as ReExported
 import Types.Option as ReExported
 import Seek as ReExported
 import Checks as ReExported
-import Options as ReExported
 import Usage as ReExported
 import Logs.Trust
 import Logs.Location

Command/Copy.hs

@@ -10,17 +10,19 @@ module Command.Copy where
 import Common.Annex
 import Command
 import qualified Command.Move
+import qualified Remote
 
 def :: [Command]
 def = [withOptions Command.Move.options $ command "copy" paramPaths seek
 	"copy content of files to/from another repository"]
 
 seek :: [CommandSeek]
-seek = [withField "to" id $ \to -> withField "from" id $ \from ->
+seek = [withField Command.Move.toOption Remote.byName $ \to ->
+		withField Command.Move.fromOption Remote.byName $ \from ->
 			withNumCopies $ \n -> whenAnnexed $ start to from n]
 
 -- A copy is just a move that does not delete the source file.
 -- However, --auto mode avoids unnecessary copies.
-start :: Maybe String -> Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
 start to from numcopies file (key, backend) = autoCopies key (<) numcopies $
 	Command.Move.start to from False file (key, backend)

Command/Drop.hs

@@ -16,24 +16,24 @@ import Logs.Location
 import Logs.Trust
 import Annex.Content
 import Config
+import qualified Option
 
 def :: [Command]
 def = [withOptions [fromOption] $ command "drop" paramPaths seek
 	"indicate content of files not currently wanted"]
 
 fromOption :: Option
-fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
+fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote"
 
 seek :: [CommandSeek]
-seek = [withField "from" id $ \from -> withNumCopies $ \n ->
+seek = [withField fromOption Remote.byName $ \from -> withNumCopies $ \n ->
 	whenAnnexed $ start from n]
 
-start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
 start from numcopies file (key, _) = autoCopies key (>) numcopies $ do
 	case from of
 		Nothing -> startLocal file numcopies key
-		Just name -> do
+		Just remote -> do
-			remote <- Remote.byName name
 			u <- getUUID
 			if Remote.uuid remote == u
 				then startLocal file numcopies key

Command/DropUnused.hs

@@ -15,6 +15,7 @@ import qualified Annex
 import qualified Command.Drop
 import qualified Remote
 import qualified Git
+import qualified Option
 import Types.Key
 
 type UnusedMap = M.Map String Key
@@ -51,14 +52,14 @@ start (unused, unusedbad, unusedtmp) s = search
 					next $ a key
 
 perform :: Key -> CommandPerform
-perform key = maybe droplocal dropremote =<< Annex.getField "from"
+perform key = maybe droplocal dropremote =<< Remote.byName =<< from
 	where
-		dropremote name = do
+		dropremote r = do
-			r <- Remote.byName name
 			showAction $ "from " ++ Remote.name r
 			ok <- Remote.removeKey r key
 			next $ Command.Drop.cleanupRemote key r ok
 		droplocal = Command.Drop.performLocal key (Just 0) -- force drop
+		from = Annex.getField $ Option.name Command.Drop.fromOption
 
 performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
 performOther filespec key = do

Command/Find.hs

@@ -17,23 +17,26 @@ import qualified Annex
 import qualified Utility.Format
 import Utility.DataUnits
 import Types.Key
+import qualified Option
 
 def :: [Command]
 def = [withOptions [formatOption, print0Option] $
 	command "find" paramPaths seek "lists available files"]
 
-print0Option :: Option
-print0Option = Option [] ["print0"] (NoArg $ Annex.setField "format" "${file}\0")
-	"terminate output with null"
-
 formatOption :: Option
-formatOption = fieldOption [] "format" paramFormat "control format of output"
+formatOption = Option.field [] "format" paramFormat "control format of output"
+
+print0Option :: Option
+print0Option = Option.Option [] ["print0"] (Option.NoArg set)
+	"terminate output with null"
+	where
+		set = Annex.setField (Option.name formatOption) "${file}\0"
 
 seek :: [CommandSeek]
-seek = [withField "format" formatconverter $ \f ->
+seek = [withField formatOption formatconverter $ \f ->
 		withFilesInGit $ whenAnnexed $ start f]
 	where
-		formatconverter = maybe Nothing (Just . Utility.Format.gen)
+		formatconverter = return . maybe Nothing (Just . Utility.Format.gen)
 
 start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
 start format file (key, _) = do

Command/Get.hs

@@ -18,17 +18,16 @@ def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
 	"make content of annexed files available"]
 
 seek :: [CommandSeek]
-seek = [withField "from" id $ \from -> withNumCopies $ \n ->
+seek = [withField Command.Move.fromOption Remote.byName $ \from ->
-	whenAnnexed $ start from n]
+	withNumCopies $ \n -> whenAnnexed $ start from n]
 
-start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
 start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
 	autoCopies key (<) numcopies $ do
 		case from of
 			Nothing -> go $ perform key
-			Just name -> do
+			Just src -> do
 				-- get --from = copy --from
-				src <- Remote.byName name
 				stopUnless (Command.Move.fromOk src key) $
 					go $ Command.Move.fromPerform src False key
 	where

Command/Log.hs

@@ -0,0 +1,117 @@
+{- 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
+import qualified Option
+
+def :: [Command]
+def = [withOptions [afterOption, maxcountOption] $
+	command "log" paramPaths seek "shows location log"]
+
+afterOption :: Option
+afterOption = Option.field [] "after" paramDate "show log after date"
+
+maxcountOption :: Option
+maxcountOption = Option.field ['n'] "max-count" paramNumber "limit number of logs displayed"
+
+seek :: [CommandSeek]
+seek = [withField afterOption return $ \afteropt ->
+	withField maxcountOption return $ \maxcount ->
+	withFilesInGit $ whenAnnexed $ start afteropt maxcount]
+
+start :: Maybe String -> Maybe String -> FilePath -> (Key, Backend) -> CommandStart
+start afteropt maxcount file (key, _) = do
+	showLog file =<< (readLog <$> getLog key ps)
+	stop
+	where
+		ps = concatMap (\(o, p) -> maybe [] p o)
+			[ (afteropt, \d -> [Param "--after", Param d])
+			, (maxcount, \c -> [Param "--max-count", Param c])
+			]
+
+showLog :: FilePath -> [(POSIXTime, (Git.Ref, Git.Ref))] -> Annex ()
+showLog file ps = do
+	zone <- liftIO getCurrentTimeZone
+	sets <- mapM (getset snd) ps
+	previous <- maybe (return genesis) (getset fst) (lastMaybe ps)
+	mapM_ (diff zone) $ zip sets (drop 1 sets ++ [previous])
+	where
+		genesis = (0, S.empty)
+		getset select (ts, refs) = do
+			s <- S.fromList <$> get (select refs)
+			return (ts, s)
+		get ref = map toUUID . Logs.Presence.getLog . L.unpack <$>
+			catObject ref
+		diff zone ((ts, new), (_, old)) = do
+			let time = show $ utcToLocalTime zone $
+				posixSecondsToUTCTime ts
+			output time True added
+			output time False removed
+			where
+				added = S.difference new old
+				removed = S.difference old new
+		output time present s = do
+			rs <- map (dropWhile isSpace) . lines <$>
+				Remote.prettyPrintUUIDs "log" (S.toList s)
+			liftIO $ mapM_ (putStrLn . format) rs
+				where
+					format r = unwords
+						[ if present then "+" else "-"
+						, time
+						, file
+						, "|"
+						, r
+						]
+
+getLog :: Key -> [CommandParam] -> Annex [String]
+getLog key ps = 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 "--boundary"
+		] ++ ps ++
+		[ Param $ show Annex.Branch.fullname
+		, Param "--"
+		, Param logfile
+		]
+
+readLog :: [String] -> [(POSIXTime, (Git.Ref, Git.Ref))]
+readLog = mapMaybe (parse . lines)
+	where
+		parse (ts:raw:[]) = Just (parseTimeStamp ts, parseRaw raw)
+		parse _ = Nothing
+
+-- Parses something like ":100644 100644 oldsha newsha M"
+parseRaw :: String -> (Git.Ref, Git.Ref)
+parseRaw l = (Git.Ref oldsha, Git.Ref newsha)
+	where
+		ws = words l
+		oldsha = ws !! 2
+		newsha = ws !! 3
+
+parseTimeStamp :: String -> POSIXTime
+parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (error "bad timestamp") .
+	parseTime defaultTimeLocale "%s"

Command/Move.hs

@@ -14,35 +14,33 @@ import qualified Annex
 import Annex.Content
 import qualified Remote
 import Annex.UUID
+import qualified Option
 
 def :: [Command]
 def = [withOptions options $ command "move" paramPaths seek
 	"move content of files to/from another repository"]
 
 fromOption :: Option
-fromOption = fieldOption ['f'] "from" paramRemote "source remote"
+fromOption = Option.field ['f'] "from" paramRemote "source remote"
 
 toOption :: Option
-toOption = fieldOption ['t'] "to" paramRemote "destination remote"
+toOption = Option.field ['t'] "to" paramRemote "destination remote"
 
 options :: [Option]
 options = [fromOption, toOption]
 
 seek :: [CommandSeek]
-seek = [withField "to" id $ \to -> withField "from" id $ \from ->
+seek = [withField toOption Remote.byName $ \to ->
+		withField fromOption Remote.byName $ \from ->
 			withFilesInGit $ whenAnnexed $ start to from True]
 
-start :: Maybe String -> Maybe String -> Bool -> FilePath -> (Key, Backend) -> CommandStart
+start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
 start to from move file (key, _) = do
 	noAuto
 	case (from, to) of
 		(Nothing, Nothing) -> error "specify either --from or --to"
-		(Nothing, Just name) -> do
+		(Nothing, Just dest) -> toStart dest move file key
-			dest <- Remote.byName name
+		(Just src, Nothing) -> fromStart src move file key
-			toStart dest move file key
-		(Just name, Nothing) -> do
-			src <- Remote.byName name
-			fromStart src move file key
 		(_ ,  _) -> error "only one of --from or --to can be specified"
 	where
 		noAuto = when move $ whenM (Annex.getState Annex.auto) $ error

Command/Sync.hs

@@ -61,7 +61,7 @@ syncRemotes rs = do
 		wanted
 			| null rs = good =<< available
 			| otherwise = listed
-		listed = mapM Remote.byName rs
+		listed = catMaybes <$> mapM (Remote.byName . Just) rs
 		available = filter nonspecial <$> Remote.enabledRemoteList
 		good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
 		nonspecial r = Types.Remote.remotetype r == Remote.Git.remote

Command/Unused.hs

@@ -27,6 +27,7 @@ import qualified Git.LsTree as LsTree
 import qualified Backend
 import qualified Remote
 import qualified Annex.Branch
+import qualified Option
 import Annex.CatFile
 
 def :: [Command]
@@ -34,7 +35,7 @@ def = [withOptions [fromOption] $ command "unused" paramNothing seek
 	"look for unused file content"]
 
 fromOption :: Option
-fromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content"
+fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content"
 
 seek :: [CommandSeek]
 seek = [withNothing $ start]
@@ -42,7 +43,7 @@ seek = [withNothing $ start]
 {- Finds unused content in the annex. -} 
 start :: CommandStart
 start = do
-	from <- Annex.getField "from"
+	from <- Annex.getField $ Option.name fromOption
 	let (name, action) = case from of
 		Nothing -> (".", checkUnused)
 		Just "." -> (".", checkUnused)
@@ -66,7 +67,7 @@ checkUnused = do
 
 checkRemoteUnused :: String -> CommandPerform
 checkRemoteUnused name = do
-	checkRemoteUnused' =<< Remote.byName name
+	checkRemoteUnused' =<< fromJust <$> Remote.byName (Just name)
 	next $ return True
 
 checkRemoteUnused' :: Remote -> Annex ()

Git/Sha.hs

@@ -34,3 +34,6 @@ extractSha s
 {- Size of a git sha. -}
 shaSize :: Int
 shaSize = 40
+
+nullSha :: Ref		
+nullSha = Ref $ replicate shaSize '0'

Git/UnionMerge.hs

@@ -103,14 +103,13 @@ calc_merge ch differ repo streamer = gendiff >>= go
  - a line suitable for update_index that union merges the two sides of the
  - diff. -}
 mergeFile :: String -> FilePath -> CatFileHandle -> Repo -> IO (Maybe String)
-mergeFile info file h repo = case filter (/= nullsha) [Ref asha, Ref bsha] of
+mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of
 	[] -> return Nothing
 	(sha:[]) -> use sha
 	shas -> use =<< either return (hashObject repo . L.unlines) =<<
 		calcMerge . zip shas <$> mapM getcontents shas
 	where
 		[_colonmode, _bmode, asha, bsha, _status] = words info
-		nullsha = Ref $ replicate shaSize '0'
 		getcontents s = L.lines <$> catObject h s
 		use sha = return $ Just $ update_index_line sha file
 

GitAnnex.hs

@@ -18,6 +18,7 @@ import Types.TrustLevel
 import qualified Annex
 import qualified Remote
 import qualified Limit
+import qualified Option
 
 import qualified Command.Add
 import qualified Command.Unannex
@@ -40,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
@@ -84,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
@@ -93,7 +96,7 @@ cmds = concat
 	]
 
 options :: [Option]
-options = commonOptions ++
+options = Option.common ++
 	[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
 		"override default number of copies"
 	, Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote)
@@ -114,7 +117,7 @@ options = commonOptions ++
 		"skip files with fewer copies"
 	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
 		"skip files not using a key-value backend"
-	] ++ matcherOptions
+	] ++ Option.matcher
 	where
 		setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
 		setgitconfig :: String -> Annex ()

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

Option.hs

@@ -5,13 +5,13 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Options (
+module Option (
-	commonOptions,
+	common,
-	matcherOptions,
+	matcher,
-	flagOption,
+	flag,
-	fieldOption,
+	field,
+	name,
 	ArgDescr(..),
-	Option,
 	OptDescr(..),
 ) where
 
@@ -21,11 +21,10 @@ import System.Log.Logger
 import Common.Annex
 import qualified Annex
 import Limit
-import Types.Option
 import Usage
 
-commonOptions :: [Option]
+common :: [Option]
-commonOptions =
+common =
 	[ Option [] ["force"] (NoArg (setforce True))
 		"allow actions that may lose annexed data"
 	, Option ['F'] ["fast"] (NoArg (setfast True))
@@ -52,8 +51,8 @@ commonOptions =
 		setdebug = liftIO $ updateGlobalLogger rootLoggerName $
 			setLevel DEBUG
 
-matcherOptions :: [Option]
+matcher :: [Option]
-matcherOptions =
+matcher =
 	[ longopt "not" "negate next option"
 	, longopt "and" "both previous and next option must match"
 	, longopt "or" "either previous or next option must match"
@@ -65,11 +64,16 @@ matcherOptions =
 		shortopt o = Option o [] $ NoArg $ addToken o
 
 {- An option that sets a flag. -}
-flagOption :: String -> String -> String -> Option
+flag :: String -> String -> String -> Option
-flagOption short flag description = 
+flag short opt description = 
-	Option short [flag] (NoArg (Annex.setFlag flag)) description
+	Option short [opt] (NoArg (Annex.setFlag opt)) description
 
 {- An option that sets a field. -}
-fieldOption :: String -> String -> String -> String -> Option
+field :: String -> String -> String -> String -> Option
-fieldOption short field paramdesc description = 
+field short opt paramdesc description = 
-	Option short [field] (ReqArg (Annex.setField field) paramdesc) description
+	Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description
+
+{- The flag or field name used for an option. -}
+name :: Option -> String
+name (Option _ o _ _) = Prelude.head o
+

Remote.hs

@@ -94,14 +94,15 @@ enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
 remoteMap :: Annex (M.Map UUID String)
 remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> remoteList
 
-{- Looks up a remote by name. (Or by UUID.) Only finds currently configured
+{- When a name is specified, looks up the remote matching that name.
- - git remotes. -}
+ - (Or it can be a UUID.) Only finds currently configured git remotes. -}
-byName :: String -> Annex (Remote)
+byName :: Maybe String -> Annex (Maybe Remote)
-byName n = do
+byName Nothing = return Nothing
+byName (Just n) = do
 	res <- byName' n
 	case res of
 		Left e -> error e
-		Right r -> return r
+		Right r -> return $ Just r
 byName' :: String -> Annex (Either String Remote)
 byName' "" = return $ Left "no remote specified"
 byName' n = do

Seek.hs

@@ -20,6 +20,7 @@ import qualified Git
 import qualified Git.LsFiles as LsFiles
 import qualified Git.CheckAttr
 import qualified Limit
+import qualified Option
 
 seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
 seekHelper a params = do
@@ -87,13 +88,13 @@ withKeys a params = return $ map (a . parse) params
 	where
 		parse p = fromMaybe (error "bad key") $ readKey p
 
-{- Modifies a seek action using the value of a field, which is fed into
+{- Modifies a seek action using the value of a field option, which is fed into
  - a conversion function, and then is passed into the seek action.
  - This ensures that the conversion function only runs once.
  -}
-withField :: String -> (Maybe String -> a) -> (a -> CommandSeek) -> CommandSeek
+withField :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
-withField field converter a ps = do
+withField option converter a ps = do
-        f <- converter <$> Annex.getField field
+        f <- converter =<< Annex.getField (Option.name option)
         a f ps
 
 withNothing :: CommandStart -> CommandSeek

Types.hs

@@ -11,7 +11,8 @@ module Types (
 	Key,
 	UUID(..),
 	Remote,
-	RemoteType
+	RemoteType,
+	Option
 ) where
 
 import Annex
@@ -19,6 +20,7 @@ import Types.Backend
 import Types.Key
 import Types.UUID
 import Types.Remote
+import Types.Option
 
 type Backend = BackendA Annex
 type Remote = RemoteA Annex

Types/Command.hs

@@ -8,7 +8,6 @@
 module Types.Command where
 
 import Types
-import Types.Option
 
 {- A command runs in these stages.
  -

Usage.hs

@@ -72,6 +72,8 @@ paramUUID :: String
 paramUUID = "UUID"
 paramType :: String
 paramType = "TYPE"
+paramDate :: String
+paramDate = "Date"
 paramFormat :: String
 paramFormat = "FORMAT"
 paramKeyValue :: String

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
 

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

doc/git-annex.mdwn

@@ -273,6 +273,14 @@ 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 ("-").
+
+  To only show location changes after a date, specify --after=date.
+  (The "date" can be any format accepted by git log, ie "last wednesday")
+
 * status
 
   Displays some statistics and other information, including how much data

git-annex-shell.hs

@@ -13,6 +13,7 @@ import qualified Git.Construct
 import CmdLine
 import Command
 import Annex.UUID
+import qualified Option
 
 import qualified Command.ConfigList
 import qualified Command.InAnnex
@@ -41,7 +42,7 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
 			}
 
 options :: [OptDescr (Annex ())]
-options = commonOptions ++
+options = Option.common ++
 	[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid"
 	]
 	where