From df21cbfdd2b7342c206ebd4aea32d989328374dc Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 6 Jan 2012 04:02:35 -0400
Subject: [PATCH 1/7] look up --to and --from remote names only once

This will speed up commands like move and drop.
---
 Command/Copy.hs       |  8 +++++---
 Command/Drop.hs       |  7 +++----
 Command/DropUnused.hs |  5 ++---
 Command/Find.hs       |  2 +-
 Command/Get.hs        |  7 +++----
 Command/Move.hs       | 15 ++++++---------
 Command/Sync.hs       |  2 +-
 Command/Unused.hs     |  2 +-
 Remote.hs             | 11 ++++++-----
 Seek.hs               |  4 ++--
 10 files changed, 30 insertions(+), 33 deletions(-)

diff --git a/Command/Copy.hs b/Command/Copy.hs
index d789d41f6b..c83c724127 100644
--- a/Command/Copy.hs
+++ b/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 ->
-		withNumCopies $ \n -> whenAnnexed $ start to from n]
+seek = [withField "to" Remote.byName $ \to ->
+		withField "from" 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)
diff --git a/Command/Drop.hs b/Command/Drop.hs
index f76951f08c..07ea50df16 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -25,15 +25,14 @@ fromOption :: Option
 fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
 
 seek :: [CommandSeek]
-seek = [withField "from" id $ \from -> withNumCopies $ \n ->
+seek = [withField "from" 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
-			remote <- Remote.byName name
+		Just remote -> do
 			u <- getUUID
 			if Remote.uuid remote == u
 				then startLocal file numcopies key
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index fd3e84fe5c..1c5bf8b8c0 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -51,10 +51,9 @@ 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 =<< Annex.getField "from"
 	where
-		dropremote name = do
-			r <- Remote.byName name
+		dropremote r = do
 			showAction $ "from " ++ Remote.name r
 			ok <- Remote.removeKey r key
 			next $ Command.Drop.cleanupRemote key r ok
diff --git a/Command/Find.hs b/Command/Find.hs
index eb0267c142..8760cc9475 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -33,7 +33,7 @@ seek :: [CommandSeek]
 seek = [withField "format" 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
diff --git a/Command/Get.hs b/Command/Get.hs
index 4a50fe3fea..1a0435c36c 100644
--- a/Command/Get.hs
+++ b/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 "from" 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, _) = 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
diff --git a/Command/Move.hs b/Command/Move.hs
index 66a0c16602..4978283bf1 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -29,20 +29,17 @@ options :: [Option]
 options = [fromOption, toOption]
 
 seek :: [CommandSeek]
-seek = [withField "to" id $ \to -> withField "from" id $ \from ->
-		withFilesInGit $ whenAnnexed $ start to from True]
+seek = [withField "to" Remote.byName $ \to ->
+		withField "from" 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
-			dest <- Remote.byName name
-			toStart dest move file key
-		(Just name, Nothing) -> do
-			src <- Remote.byName name
-			fromStart src move file key
+		(Nothing, Just dest) -> toStart dest move file key
+		(Just src, Nothing) -> 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
diff --git a/Command/Sync.hs b/Command/Sync.hs
index e5884cc4a7..3d541c4dea 100644
--- a/Command/Sync.hs
+++ b/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
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 59efe64c80..a6883dce1a 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -66,7 +66,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 ()
diff --git a/Remote.hs b/Remote.hs
index 8046175d27..3f60ca3acf 100644
--- a/Remote.hs
+++ b/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
- - git remotes. -}
-byName :: String -> Annex (Remote)
-byName n = do
+{- 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)
+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
diff --git a/Seek.hs b/Seek.hs
index af074c7c5b..53101b23e4 100644
--- a/Seek.hs
+++ b/Seek.hs
@@ -91,9 +91,9 @@ withKeys a params = return $ map (a . parse) params
  - 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 :: String -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
 withField field converter a ps = do
-        f <- converter <$> Annex.getField field
+        f <- converter =<< Annex.getField field
         a f ps
 
 withNothing :: CommandStart -> CommandSeek

From 1f8a1058c96bd4ee11fcb353f0ede1842d79ab6a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 6 Jan 2012 10:14:37 -0400
Subject: [PATCH 2/7] tweak

---
 Command.hs              |  1 -
 Command/Copy.hs         |  4 ++--
 Command/Drop.hs         |  5 +++--
 Command/DropUnused.hs   |  4 +++-
 Command/Find.hs         | 15 +++++++++------
 Command/Get.hs          |  4 ++--
 Command/Move.hs         |  9 +++++----
 Command/Unused.hs       |  5 +++--
 GitAnnex.hs             |  5 +++--
 Options.hs => Option.hs | 40 ++++++++++++++++++++++------------------
 Seek.hs                 |  9 +++++----
 Types.hs                |  4 +++-
 Types/Command.hs        |  1 -
 git-annex-shell.hs      |  3 ++-
 14 files changed, 62 insertions(+), 47 deletions(-)
 rename Options.hs => Option.hs (77%)

diff --git a/Command.hs b/Command.hs
index b287629ae4..82d6429bfa 100644
--- a/Command.hs
+++ b/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
diff --git a/Command/Copy.hs b/Command/Copy.hs
index c83c724127..32b83a5262 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -17,8 +17,8 @@ def = [withOptions Command.Move.options $ command "copy" paramPaths seek
 	"copy content of files to/from another repository"]
 
 seek :: [CommandSeek]
-seek = [withField "to" Remote.byName $ \to ->
-		withField "from" Remote.byName $ \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.
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 07ea50df16..578ab62b97 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -16,16 +16,17 @@ 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" Remote.byName $ \from -> withNumCopies $ \n ->
+seek = [withField fromOption Remote.byName $ \from -> withNumCopies $ \n ->
 	whenAnnexed $ start from n]
 
 start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 1c5bf8b8c0..0b2a602161 100644
--- a/Command/DropUnused.hs
+++ b/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,13 +52,14 @@ start (unused, unusedbad, unusedtmp) s = search
 					next $ a key
 
 perform :: Key -> CommandPerform
-perform key = maybe droplocal dropremote =<< Remote.byName =<< Annex.getField "from"
+perform key = maybe droplocal dropremote =<< Remote.byName =<< from
 	where
 		dropremote r = do
 			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
diff --git a/Command/Find.hs b/Command/Find.hs
index 8760cc9475..902f50d2e3 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -17,20 +17,23 @@ 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 = return . maybe Nothing (Just . Utility.Format.gen)
diff --git a/Command/Get.hs b/Command/Get.hs
index 1a0435c36c..5d032e13c4 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -18,8 +18,8 @@ def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
 	"make content of annexed files available"]
 
 seek :: [CommandSeek]
-seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \n ->
-	whenAnnexed $ start from n]
+seek = [withField Command.Move.fromOption Remote.byName $ \from ->
+	withNumCopies $ \n -> whenAnnexed $ start from n]
 
 start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
 start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
diff --git a/Command/Move.hs b/Command/Move.hs
index 4978283bf1..2efaebbcb1 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -14,23 +14,24 @@ 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" Remote.byName $ \to ->
-		withField "from" Remote.byName $ \from ->
+seek = [withField toOption Remote.byName $ \to ->
+		withField fromOption Remote.byName $ \from ->
 			withFilesInGit $ whenAnnexed $ start to from True]
 
 start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
diff --git a/Command/Unused.hs b/Command/Unused.hs
index a6883dce1a..ffd4bef455 100644
--- a/Command/Unused.hs
+++ b/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)
diff --git a/GitAnnex.hs b/GitAnnex.hs
index 8af1d5d59e..64020754fc 100644
--- a/GitAnnex.hs
+++ b/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
@@ -93,7 +94,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 +115,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 ()
diff --git a/Options.hs b/Option.hs
similarity index 77%
rename from Options.hs
rename to Option.hs
index 56f0bc0ee3..d6d8b44a32 100644
--- a/Options.hs
+++ b/Option.hs
@@ -5,13 +5,13 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Options (
-	commonOptions,
-	matcherOptions,
-	flagOption,
-	fieldOption,
+module Option (
+	common,
+	matcher,
+	flag,
+	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]
-commonOptions =
+common :: [Option]
+common =
 	[ Option [] ["force"] (NoArg (setforce True))
 		"allow actions that may lose annexed data"
 	, Option ['F'] ["fast"] (NoArg (setfast True))
@@ -51,9 +50,9 @@ commonOptions =
 		setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
 		setdebug = liftIO $ updateGlobalLogger rootLoggerName $
 			setLevel DEBUG
-	
-matcherOptions :: [Option]
-matcherOptions =
+
+matcher :: [Option]
+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
-flagOption short flag description = 
-	Option short [flag] (NoArg (Annex.setFlag flag)) description
+flag :: String -> String -> String -> Option
+flag short opt description = 
+	Option short [opt] (NoArg (Annex.setFlag opt)) description
 
 {- An option that sets a field. -}
-fieldOption :: String -> String -> String -> String -> Option
-fieldOption short field paramdesc description = 
-	Option short [field] (ReqArg (Annex.setField field) paramdesc) description
+field :: String -> String -> String -> String -> Option
+field short opt 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
+
diff --git a/Seek.hs b/Seek.hs
index 53101b23e4..fdb117de03 100644
--- a/Seek.hs
+++ b/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 -> Annex a) -> (a -> CommandSeek) -> CommandSeek
-withField field converter a ps = do
-        f <- converter =<< Annex.getField field
+withField :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
+withField option converter a ps = do
+        f <- converter =<< Annex.getField (Option.name option)
         a f ps
 
 withNothing :: CommandStart -> CommandSeek
diff --git a/Types.hs b/Types.hs
index c8839b7ebb..4c16fb8f4b 100644
--- a/Types.hs
+++ b/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
diff --git a/Types/Command.hs b/Types/Command.hs
index b173b61c9d..1233df2cd9 100644
--- a/Types/Command.hs
+++ b/Types/Command.hs
@@ -8,7 +8,6 @@
 module Types.Command where
 
 import Types
-import Types.Option
 
 {- A command runs in these stages.
  -
diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index 1ff0bba447..4fdeae1a87 100644
--- a/git-annex-shell.hs
+++ b/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

From a3a9f87047d27306c27f4108ee58af3365f284af Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 6 Jan 2012 15:40:04 -0400
Subject: [PATCH 3/7] 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.
---
 Annex/Branch.hs    |  1 +
 Command/Log.hs     | 94 ++++++++++++++++++++++++++++++++++++++++++++++
 GitAnnex.hs        |  2 +
 Logs/Presence.hs   |  7 +++-
 debian/changelog   |  2 +
 debian/copyright   |  2 +-
 doc/git-annex.mdwn |  5 +++
 7 files changed, 111 insertions(+), 2 deletions(-)
 create mode 100644 Command/Log.hs

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index d3a81d8e50..8f07b7aa23 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 0000000000..486efdf113
--- /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 64020754fc..78f20e9d14 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 f5e4f1ea94..372af37d5d 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 e5687aac14..707e804af0 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 a8a38913e4..dd880f1428 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 9751560a96..87775ead9b 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

From 47646d44b7a391d9439998ba34498f2fb74b4259 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 6 Jan 2012 16:24:40 -0400
Subject: [PATCH 4/7] use a zipper

---
 Command/Log.hs | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/Command/Log.hs b/Command/Log.hs
index 486efdf113..3489c5ab0c 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -33,29 +33,30 @@ 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)
+showLog ps = do
+	zone <- liftIO getCurrentTimeZone
+	sets <- mapM getset ps
+	liftIO $ putStrLn ""
+	mapM_ (diff zone) $ zip sets (drop 1 sets ++ genesis)
 	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
+		genesis = [(0, S.empty)]
+		getset (ts, ref) = do
+			s <- S.fromList <$> get ref
+			return (ts, s)
 		get ref = map toUUID . Logs.Presence.getLog . L.unpack <$>
 			catObject ref
-		diff _ Nothing _ = return ()
-		diff cur (Just (ts, new)) zone = do
+		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 cur
-				removed = S.difference cur new
+				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)

From 9fb5f3edc7e0aec79e38cf588b66e66e4a2bdd3c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 6 Jan 2012 17:24:03 -0400
Subject: [PATCH 5/7] log --after=date

---
 Command/Log.hs     | 54 ++++++++++++++++++++++++++++++----------------
 Git/Sha.hs         |  3 +++
 Git/UnionMerge.hs  |  3 +--
 Usage.hs           |  2 ++
 doc/git-annex.mdwn |  3 +++
 5 files changed, 44 insertions(+), 21 deletions(-)

diff --git a/Command/Log.hs b/Command/Log.hs
index 3489c5ab0c..51bdbc74c1 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -23,29 +23,39 @@ import qualified Annex.Branch
 import qualified Git
 import Git.Command
 import qualified Remote
+import qualified Option
 
 def :: [Command]
-def = [command "log" paramPaths seek "shows location log"]
+def = [withOptions [afterOption] $
+	command "log" paramPaths seek "shows location log"]
+
+afterOption :: Option
+afterOption = Option.field [] "after" paramDate "show log after date"
 
 seek :: [CommandSeek]
-seek = [withFilesInGit $ whenAnnexed $ start]
+seek = [withField afterOption return $ \afteropt ->
+	withFilesInGit $ whenAnnexed $ start afteropt]
 
-start :: FilePath -> (Key, Backend) -> CommandStart
-start file (key, _) = do
+start :: Maybe String -> FilePath -> (Key, Backend) -> CommandStart
+start afteropt file (key, _) = do
 	showStart file ""
-	showLog =<< readLog key
+	let ps = case afteropt of
+		Nothing -> []
+		Just date -> [Param "--after", Param date]
+	showLog =<< (readLog <$> getLog key ps)
 	stop
 
-showLog :: [(POSIXTime, Git.Ref)] -> Annex ()
+showLog :: [(POSIXTime, (Git.Ref, Git.Ref))] -> Annex ()
 showLog ps = do
 	zone <- liftIO getCurrentTimeZone
-	sets <- mapM getset ps
+	sets <- mapM (getset snd) ps
+	previous <- maybe (return genesis) (getset fst) (lastMaybe ps)
 	liftIO $ putStrLn ""
-	mapM_ (diff zone) $ zip sets (drop 1 sets ++ genesis)
+	mapM_ (diff zone) $ zip sets (drop 1 sets ++ [previous])
 	where
-		genesis = [(0, S.empty)]
-		getset (ts, ref) = do
-			s <- S.fromList <$> get ref
+		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
@@ -68,27 +78,33 @@ showLog ps = do
 						, r
 						]
 
-getLog :: Key -> Annex [String]
-getLog key = do
+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
+	inRepo $ pipeNullSplit $
 		[ Params "log -z --pretty=format:%ct --raw --abbrev=40"
-		, Param $ show Annex.Branch.fullname
+		, Param "--boundary"
+		] ++ ps ++
+		[ Param $ show Annex.Branch.fullname
 		, Param "--"
 		, Param logfile
 		]
 
-readLog :: Key -> Annex [(POSIXTime, Git.Ref)]
-readLog key = mapMaybe (parse . lines) <$> getLog key
+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
-parseRaw l = Git.Ref $ words l !! 3
+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") .
diff --git a/Git/Sha.hs b/Git/Sha.hs
index 9b3a346505..2a01ede83e 100644
--- a/Git/Sha.hs
+++ b/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'
diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs
index d5323af1d1..4b335e47b1 100644
--- a/Git/UnionMerge.hs
+++ b/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
 
diff --git a/Usage.hs b/Usage.hs
index 308ade798f..36944053f0 100644
--- a/Usage.hs
+++ b/Usage.hs
@@ -72,6 +72,8 @@ paramUUID :: String
 paramUUID = "UUID"
 paramType :: String
 paramType = "TYPE"
+paramDate :: String
+paramDate = "Date"
 paramFormat :: String
 paramFormat = "FORMAT"
 paramKeyValue :: String
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 87775ead9b..b9704f3bd4 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -278,6 +278,9 @@ subdirectories).
   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

From 078788a9e755809ac050fd83eb19c4398d7366d7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 6 Jan 2012 17:30:48 -0400
Subject: [PATCH 6/7] change log display

Including the file in the lines behaves better when limiting with --after,
since only files that changed in the time period are shown.

Still not fully happy with the line layout, but putting the +/- first
followed by the date seems a good change.
---
 Command/Log.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/Command/Log.hs b/Command/Log.hs
index 51bdbc74c1..2651b14be9 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -38,19 +38,17 @@ seek = [withField afterOption return $ \afteropt ->
 
 start :: Maybe String -> FilePath -> (Key, Backend) -> CommandStart
 start afteropt file (key, _) = do
-	showStart file ""
 	let ps = case afteropt of
 		Nothing -> []
 		Just date -> [Param "--after", Param date]
-	showLog =<< (readLog <$> getLog key ps)
+	showLog file =<< (readLog <$> getLog key ps)
 	stop
 
-showLog :: [(POSIXTime, (Git.Ref, Git.Ref))] -> Annex ()
-showLog ps = do
+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)
-	liftIO $ putStrLn ""
 	mapM_ (diff zone) $ zip sets (drop 1 sets ++ [previous])
 	where
 		genesis = (0, S.empty)
@@ -70,11 +68,13 @@ showLog ps = do
 		output time present s = do
 			rs <- map (dropWhile isSpace) . lines <$>
 				Remote.prettyPrintUUIDs "log" (S.toList s)
-			liftIO $ mapM_ (putStrLn . indent . format) rs
+			liftIO $ mapM_ (putStrLn . format) rs
 				where
 					format r = unwords
-						[ time
-						, if present then "+" else "-"
+						[ if present then "+" else "-"
+						, time
+						, file
+						, "|"
 						, r
 						]
 

From 3c88d573990d79a5a964567c4a16068ef5ecfa0f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 6 Jan 2012 17:48:02 -0400
Subject: [PATCH 7/7] log --max-count=n

---
 Command/Log.hs | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/Command/Log.hs b/Command/Log.hs
index 2651b14be9..ff217e573b 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -26,23 +26,29 @@ import qualified Remote
 import qualified Option
 
 def :: [Command]
-def = [withOptions [afterOption] $
+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 ->
-	withFilesInGit $ whenAnnexed $ start afteropt]
+	withField maxcountOption return $ \maxcount ->
+	withFilesInGit $ whenAnnexed $ start afteropt maxcount]
 
-start :: Maybe String -> FilePath -> (Key, Backend) -> CommandStart
-start afteropt file (key, _) = do
-	let ps = case afteropt of
-		Nothing -> []
-		Just date -> [Param "--after", Param date]
+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