packages feed

git-annex 5.20150710 → 5.20150727

raw patch · 186 files changed

+3453/−1919 lines, 186 filesdep ~awsdep ~time

Dependency ranges changed: aws, time

Files

.gitignore view
@@ -4,7 +4,6 @@ *.o tmp test-build-stamp Build/SysConfig.hs Build/InstallDesktopFile Build/EvilSplicer
Annex.hs view
@@ -57,7 +57,6 @@ import Types.FileMatcher import Types.NumCopies import Types.LockCache-import Types.MetaData import Types.DesktopNotify import Types.CleanupActions #ifdef WITH_QUVI@@ -121,7 +120,6 @@ 	, lockcache :: LockCache 	, flags :: M.Map String Bool 	, fields :: M.Map String String-	, modmeta :: [ModMeta] 	, cleanup :: M.Map CleanupAction (Annex ()) 	, sentinalstatus :: Maybe SentinalStatus 	, useragent :: Maybe String@@ -166,7 +164,6 @@ 	, lockcache = M.empty 	, flags = M.empty 	, fields = M.empty-	, modmeta = [] 	, cleanup = M.empty 	, sentinalstatus = Nothing 	, useragent = Nothing
Assistant/Pairing/MakeRemote.hs view
@@ -34,7 +34,7 @@  - the host we paired with. -} finishedLocalPairing :: PairMsg -> SshKeyPair -> Assistant () finishedLocalPairing msg keypair = do-	sshdata <- liftIO $ setupSshKeyPair keypair =<< pairMsgToSshData msg+	sshdata <- liftIO $ installSshKeyPair keypair =<< pairMsgToSshData msg 	{- Ensure that we know the ssh host key for the host we paired with. 	 - If we don't, ssh over to get it. -} 	liftIO $ unlessM (knownHost $ sshHostName sshdata) $@@ -69,6 +69,7 @@ 		, sshPort = 22 		, needsPubKey = True 		, sshCapabilities = [GitAnnexShellCapable, GitCapable, RsyncCapable]+		, sshRepoUrl = Nothing 		}  {- Finds the best hostname to use for the host that sent the PairMsg.
Assistant/Ssh.hs view
@@ -28,28 +28,37 @@ 	, sshPort :: Int 	, needsPubKey :: Bool 	, sshCapabilities :: [SshServerCapability]+	, sshRepoUrl :: Maybe String 	} 	deriving (Read, Show, Eq) -data SshServerCapability = GitAnnexShellCapable | GitCapable | RsyncCapable+data SshServerCapability+	= GitAnnexShellCapable -- server has git-annex-shell installed+	| GitCapable -- server has git installed+	| RsyncCapable -- server supports raw rsync access (not only via git-annex-shell)+	| PushCapable -- repo on server is set up already, and ready to accept pushes 	deriving (Read, Show, Eq)  hasCapability :: SshData -> SshServerCapability -> Bool hasCapability d c = c `elem` sshCapabilities d +addCapability :: SshData -> SshServerCapability -> SshData+addCapability d c = d { sshCapabilities = c : sshCapabilities d }+ onlyCapability :: SshData -> SshServerCapability -> Bool onlyCapability d c = all (== c) (sshCapabilities d) +type SshPubKey = String+type SshPrivKey = String+ data SshKeyPair = SshKeyPair-	{ sshPubKey :: String-	, sshPrivKey :: String+	{ sshPubKey :: SshPubKey+	, sshPrivKey :: SshPrivKey 	}  instance Show SshKeyPair where 	show = sshPubKey -type SshPubKey = String- {- ssh -ofoo=bar command-line option -} sshOpt :: String -> String -> String sshOpt k v = concat ["-o", k, "=", v]@@ -60,10 +69,12 @@  {- Generates a ssh or rsync url from a SshData. -} genSshUrl :: SshData -> String-genSshUrl sshdata = addtrailingslash $ T.unpack $ T.concat $-	if (onlyCapability sshdata RsyncCapable)-		then [u, h, T.pack ":", sshDirectory sshdata]-		else [T.pack "ssh://", u, h, d]+genSshUrl sshdata = case sshRepoUrl sshdata of+	Just repourl -> repourl+	Nothing -> addtrailingslash $ T.unpack $ T.concat $+		if (onlyCapability sshdata RsyncCapable)+			then [u, h, T.pack ":", sshDirectory sshdata]+			else [T.pack "ssh://", u, h, d]   where 	u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata 	h = sshHostName sshdata@@ -90,6 +101,7 @@ 		, sshPort = 22 		, needsPubKey = True 		, sshCapabilities = []+		, sshRepoUrl = Nothing 		} 	  where 		(user, host) = if '@' `elem` userhost@@ -222,25 +234,45 @@  - when git-annex and git try to access the remote, if its  - host key has changed.  -}-setupSshKeyPair :: SshKeyPair -> SshData -> IO SshData-setupSshKeyPair sshkeypair sshdata = do+installSshKeyPair :: SshKeyPair -> SshData -> IO SshData+installSshKeyPair sshkeypair sshdata = do 	sshdir <- sshDir-	createDirectoryIfMissing True $ parentDir $ sshdir </> sshprivkeyfile+	createDirectoryIfMissing True $ parentDir $ sshdir </> sshPrivKeyFile sshdata -	unlessM (doesFileExist $ sshdir </> sshprivkeyfile) $-		writeFileProtected (sshdir </> sshprivkeyfile) (sshPrivKey sshkeypair)-	unlessM (doesFileExist $ sshdir </> sshpubkeyfile) $-		writeFile (sshdir </> sshpubkeyfile) (sshPubKey sshkeypair)+	unlessM (doesFileExist $ sshdir </> sshPrivKeyFile sshdata) $+		writeFileProtected (sshdir </> sshPrivKeyFile sshdata) (sshPrivKey sshkeypair)+	unlessM (doesFileExist $ sshdir </> sshPubKeyFile sshdata) $+		writeFile (sshdir </> sshPubKeyFile sshdata) (sshPubKey sshkeypair)  	setSshConfig sshdata-		[ ("IdentityFile", "~/.ssh/" ++ sshprivkeyfile)+		[ ("IdentityFile", "~/.ssh/" ++ sshPrivKeyFile sshdata) 		, ("IdentitiesOnly", "yes") 		, ("StrictHostKeyChecking", "yes") 		]-  where-	sshprivkeyfile = "git-annex" </> "key." ++ mangleSshHostName sshdata-	sshpubkeyfile = sshprivkeyfile ++ ".pub" +sshPrivKeyFile :: SshData -> FilePath+sshPrivKeyFile sshdata = "git-annex" </> "key." ++ mangleSshHostName sshdata++sshPubKeyFile :: SshData -> FilePath+sshPubKeyFile sshdata = sshPrivKeyFile sshdata ++ ".pub"++{- Generates an installs a new ssh key pair if one is not already+ - installed. Returns the modified SshData that will use the key pair,+ - and the key pair. -}+setupSshKeyPair :: SshData -> IO (SshData, SshKeyPair)+setupSshKeyPair sshdata = do+	sshdir <- sshDir+	mprivkey <- catchMaybeIO $ readFile (sshdir </> sshPrivKeyFile sshdata)+	mpubkey <- catchMaybeIO $ readFile (sshdir </> sshPubKeyFile sshdata)+	keypair <- case (mprivkey, mpubkey) of+		(Just privkey, Just pubkey) -> return $ SshKeyPair+			{ sshPubKey = pubkey+			, sshPrivKey = privkey+			}+		_ -> genSshKeyPair+	sshdata' <- installSshKeyPair keypair sshdata+	return (sshdata', keypair)+ {- Fixes git-annex ssh key pairs configured in .ssh/config   - by old versions to set IdentitiesOnly.  -@@ -293,11 +325,16 @@ 				(settings ++ config) 		setSshConfigMode configfile -	return $ sshdata { sshHostName = T.pack mangledhost }+	return $ sshdata+		{ sshHostName = T.pack mangledhost+		, sshRepoUrl = replace orighost mangledhost+			<$> sshRepoUrl sshdata+		}   where+	orighost = T.unpack $ sshHostName sshdata 	mangledhost = mangleSshHostName sshdata 	settings =-		[ ("Hostname", T.unpack $ sshHostName sshdata)+		[ ("Hostname", orighost) 		, ("Port", show $ sshPort sshdata) 		]
Assistant/WebApp/Configurators/Ssh.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant webapp configurator for ssh-based remotes  -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -21,8 +21,13 @@ import Utility.UserInfo import Utility.Gpg import Types.Remote (RemoteConfig)-import Git.Types (RemoteName)+import Git.Types (RemoteName, fromRef) import qualified Remote.GCrypt as GCrypt+import qualified Git.Construct+import qualified Git.Config+import qualified Git.Command+import qualified Remote.Helper.Ssh+import qualified Annex.Branch import Annex.UUID import Logs.UUID import Assistant.RemoteControl@@ -74,6 +79,7 @@ 	, sshPort = inputPort s 	, needsPubKey = False 	, sshCapabilities = [] -- untested+	, sshRepoUrl = Nothing 	}  mkSshInput :: SshData -> SshInput@@ -137,6 +143,7 @@ data ServerStatus 	= UntestedServer 	| UnusableServer Text -- reason why it's not usable+	| ServerNeedsPubKey SshPubKey 	| UsableServer [SshServerCapability] 	deriving (Eq) @@ -486,8 +493,7 @@ prepSsh :: Bool -> SshData -> (SshData -> Handler Html) -> Handler Html prepSsh needsinit sshdata a 	| needsPubKey sshdata = do-		keypair <- liftIO genSshKeyPair-		sshdata' <- liftIO $ setupSshKeyPair keypair sshdata+		(sshdata', keypair) <- liftIO $ setupSshKeyPair sshdata 		prepSsh' needsinit sshdata sshdata' (Just keypair) a 	| sshPort sshdata /= 22 = do 		sshdata' <- liftIO $ setSshConfig sshdata []@@ -495,11 +501,23 @@ 	| otherwise = prepSsh' needsinit sshdata sshdata Nothing a  prepSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> (SshData -> Handler Html) -> Handler Html-prepSsh' needsinit origsshdata sshdata keypair a = sshSetup (mkSshInput origsshdata)-	 [ "-p", show (sshPort origsshdata)-	 , genSshHost (sshHostName origsshdata) (sshUserName origsshdata)-	 , remoteCommand-	 ] Nothing (a sshdata)+prepSsh' needsinit origsshdata sshdata keypair a+	| hasCapability sshdata PushCapable = do+		{- To ensure the repository is initialized, try to push the+		 - git-annex branch to it. Then git-annex-shell will see+		 - the branch and auto-initialize. -}+		when needsinit $ do+			void $ liftAnnex $ inRepo $ Git.Command.runBool+				[ Param "push"+				, Param (genSshUrl sshdata)+				, Param (fromRef Annex.Branch.name)+				]+		a sshdata+	| otherwise = sshSetup (mkSshInput origsshdata)+		 [ "-p", show (sshPort origsshdata)+		 , genSshHost (sshHostName origsshdata) (sshUserName origsshdata)+		 , remoteCommand+		 ] Nothing (a sshdata)   where 	remotedir = T.unpack $ sshDirectory sshdata 	remoteCommand = shellWrap $ intercalate "&&" $ catMaybes@@ -628,8 +646,7 @@ prepRsyncNet :: SshInput -> String -> (SshData -> Handler Html) -> Handler Html prepRsyncNet sshinput reponame a = do 	knownhost <- liftIO $ maybe (return False) knownHost (inputHostname sshinput)-	keypair <- liftIO genSshKeyPair-	sshdata <- liftIO $ setupSshKeyPair keypair $+	(sshdata, keypair) <- liftIO $ setupSshKeyPair $ 		(mkSshData sshinput) 			{ sshRepoName = reponame  			, needsPubKey = True@@ -654,3 +671,89 @@ isRsyncNet :: Maybe Text -> Bool isRsyncNet Nothing = False isRsyncNet (Just host) = ".rsync.net" `T.isSuffixOf` T.toLower host++data GitLabUrl = GitLabUrl Text++badGitLabUrl :: Text+badGitLabUrl = "Bad SSH clone url. Expected something like: git@gitlab.com:yourlogin/annex.git"++parseGitLabUrl :: GitLabUrl -> Maybe SshData+parseGitLabUrl (GitLabUrl t) = +	let (u, r) = separate (== '@') (T.unpack t)+	    (h, p) = separate (== ':') r+	in if null u || null h || null p+		then Nothing+		else Just $ SshData+			{ sshHostName = T.pack h+			, sshUserName = Just (T.pack u)+			, sshDirectory = T.pack p+			, sshRepoName = genSshRepoName h p+			, sshPort = 22+			, needsPubKey = False+			, sshCapabilities = +				[ GitAnnexShellCapable+				, GitCapable+				, PushCapable+				]+			, sshRepoUrl = Just (T.unpack t)+			}++{- Try to ssh into the gitlab server, verify we can access the repository,+ - and get the uuid of the repository, if it already has one.+ -+ - A repository on gitlab won't be initialized as a git-annex repo + - unless a git-annex branch was already pushed to it. So, if+ - git-annex-shell fails to work that's probably why; verify if+ - the server is letting us ssh in by running git send-pack+ - (in dry run mode). -}+testGitLabUrl :: GitLabUrl -> Annex (ServerStatus, Maybe SshData, UUID)+testGitLabUrl glu = case parseGitLabUrl glu of+	Nothing -> return (UnusableServer badGitLabUrl, Nothing, NoUUID)+	Just sshdata -> +		checkor sshdata $ do+			(sshdata', keypair) <- liftIO $ setupSshKeyPair sshdata+			checkor sshdata' $ +				return (ServerNeedsPubKey (sshPubKey keypair), Just sshdata', NoUUID)+  where+	checkor sshdata ora = do+		u <- probeuuid sshdata+		if u /= NoUUID+			then return (UsableServer (sshCapabilities sshdata), Just sshdata, u)+			else ifM (verifysshworks sshdata)+				( return (UsableServer (sshCapabilities sshdata), Just sshdata, NoUUID)+				, ora+				)+	probeuuid sshdata = do+		r <- inRepo $ Git.Construct.fromRemoteLocation (fromJust $ sshRepoUrl sshdata)+		getUncachedUUID . either (const r) fst <$>+			Remote.Helper.Ssh.onRemote r (Git.Config.fromPipe r, return (Left $ error "configlist failed")) "configlist" [] []+	verifysshworks sshdata = inRepo $ Git.Command.runBool+		[ Param "send-pack"+		, Param (fromJust $ sshRepoUrl sshdata)+		, Param "--dry-run"+		, Param "--force"+		, Param (fromRef Annex.Branch.name)+		]++gitLabUrlAForm :: AForm Handler GitLabUrl+gitLabUrlAForm = GitLabUrl <$> areq check_input (bfs "SSH clone url") Nothing+  where+	check_input = checkBool (isJust . parseGitLabUrl . GitLabUrl)+		badGitLabUrl textField++getAddGitLabR :: Handler Html+getAddGitLabR = postAddGitLabR+postAddGitLabR :: Handler Html+postAddGitLabR = sshConfigurator $ do+	((result, form), enctype) <- liftH $+		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout gitLabUrlAForm+	case result of+		FormSuccess gitlaburl -> do+			(status, msshdata, u) <- liftAnnex $ testGitLabUrl gitlaburl+			case (status, msshdata) of+				(UsableServer _, Just sshdata) ->+					liftH $ redirect $ ConfirmSshR sshdata u+				_ -> showform form enctype status+		_ -> showform form enctype UntestedServer+  where+	showform form enctype status = $(widgetFile "configurators/gitlab.com/add")
Assistant/WebApp/routes view
@@ -61,6 +61,7 @@ /config/repository/add/cloud/IA AddIAR GET POST /config/repository/add/cloud/glacier AddGlacierR GET POST /config/repository/add/cloud/box.com AddBoxComR GET POST+/config/repository/add/cloud/gitlab.com AddGitLabR GET POST  /config/repository/pair/local/start StartLocalPairR GET POST /config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET
Build/mdwn2man view
@@ -45,7 +45,7 @@  	if ($inNAME) { 		# make lexgrog happy-		s/^git-annex /git-annex-/;+		s/^git-annex (\w)/git-annex-$1/; 	} 	if ($_ eq ".SH NAME\n") { 		$inNAME=1;
BuildFlags.hs view
@@ -83,8 +83,11 @@ #endif #ifdef WITH_TORRENTPARSER 	, "TorrentParser"+#endif+#ifdef WITH_DATABASE+	, "Database" #else-+#warning Building without Database support #endif #ifdef WITH_EKG 	, "EKG"
CHANGELOG view
@@ -1,3 +1,41 @@+git-annex (5.20150727) unstable; urgency=medium++  * Fix bug that prevented uploads to remotes using new-style chunking+    from resuming after the last successfully uploaded chunk.+  * Switched option parsing to use optparse-applicative. This was a very large+    and invasive change, and may have caused some minor behavior changes to+    edge cases of option parsing. (For example, the metadata command no+    longer accepts the combination of --get and --set, which never actually+    worked.)+  * Bash completion file is now included in the git-annex source tree, +    and installed into Debian package (and any other packages built using make+    install). This bash completion is generated by the option parser, so it+    covers all commands, all options, and will never go out of date!+  * As well as tab completing "git-annex" commands, "git annex" will also tab+    complete. However, git's bash completion script needs a patch,+    which I've submitted, for this to work prefectly.+  * version --raw now works when run outside a git repository.+  * assistant --startdelay now works when run outside a git repository.+  * dead now accepts multiple --key options.+  * addurl now accepts --prefix and --suffix options to adjust the+    filenames used.+  * sync --content: Fix bug that caused files to be uploaded to eg,+    more archive remotes than wanted copies, only to later be dropped+    to satisfy the preferred content settings.+  * importfeed: Improve detection of known items whose url has changed,+    and avoid adding redundant files. Where before this only looked at+    permalinks in rss feeds, it now also looks at guids.+  * importfeed: Look at not only permalinks, but now also guids+    to identify previously downloaded files.+  * Webapp: Now features easy setup of git-annex repositories on gitlab.com.+  * Adjust debian build deps: The webapp can now build on arm64, s390x+    and hurd-i386. WebDAV support is also available on those architectures.+  * Debian package now maintained by Richard Hartmann.+  * Support building without persistent database on for systems that+    lack TH. This removes support for incremental fsck.++ -- Joey Hess <id@joeyh.name>  Mon, 27 Jul 2015 12:24:49 -0400+ git-annex (5.20150710) unstable; urgency=medium    * add: Stage symlinks the same as git add would, even if they are not a@@ -282,7 +320,7 @@     downloader prefix from logged url info before checking for the     specified prefix.   * importfeed: Avoid downloading a redundant item from a feed whose-    guid has been downloaded before, even when the url has changed.+    permalink has been seen before, even when the url has changed.   * importfeed: Always store itemid in metadata; before this was only     done when annex.genmetadata was set.   * Relax debian package dependencies to git >= 1:1.8.1 rather
CmdLine.hs view
@@ -1,6 +1,6 @@ {- git-annex command line parsing and dispatch  -- - Copyright 2010-2012 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -13,10 +13,11 @@ 	shutdown ) where +import qualified Options.Applicative as O+import qualified Options.Applicative.Help as H import qualified Control.Exception as E import qualified Data.Map as M import Control.Exception (throw)-import System.Console.GetOpt #ifndef mingw32_HOST_OS import System.Posix.Signals #endif@@ -32,48 +33,81 @@ import Types.Messages  {- Runs the passed command line. -}-dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO ()-dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do+dispatch :: Bool -> CmdParams -> [Command] -> [GlobalOption] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()+dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progdesc = do 	setupConsole-	case getOptCmd args cmd commonoptions of-		Right (flags, params) -> go flags params-			=<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))-		Left parseerr -> error parseerr+	go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))   where-	go flags params (Right g) = do+	go (Right g) = do 		state <- Annex.new g 		Annex.eval state $ do 			checkEnvironment-			when fuzzy $-				inRepo $ autocorrect . Just 			forM_ fields $ uncurry Annex.setField+			(cmd, seek, globalconfig) <- parsewith cmdparser+				(\a -> inRepo $ a . Just) 			when (cmdnomessages cmd) $  				Annex.setOutput QuietOutput-			sequence_ flags+			getParsed globalconfig 			whenM (annexDebug <$> Annex.getGitConfig) $ 				liftIO enableDebugOutput 			startup-			performCommandAction cmd params $+			performCommandAction cmd seek $ 				shutdown $ cmdnocommit cmd-	go _flags params (Left e) = do-		when fuzzy $-			autocorrect =<< Git.Config.global-		maybe (throw e) (\a -> a params) (cmdnorepo cmd)-	err msg = msg ++ "\n\n" ++ usage header allcmds-	cmd = Prelude.head cmds-	(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err-	autocorrect = Git.AutoCorrect.prepare name cmdname cmds+	go (Left norepo) = do+		(_, a, _globalconfig) <- parsewith+			(fromMaybe (throw norepo) . cmdnorepo)+			(\a -> a =<< Git.Config.global)+		a +	parsewith getparser ingitrepo = +		case parseCmd progname progdesc globaloptions allargs allcmds getparser of+			O.Failure _ -> do+				-- parse failed, so fall back to+				-- fuzzy matching, or to showing usage+				when fuzzy $+					ingitrepo autocorrect+				liftIO (O.handleParseResult (parseCmd progname progdesc globaloptions correctedargs allcmds getparser))+			res -> liftIO (O.handleParseResult res)+	  where+		autocorrect = Git.AutoCorrect.prepare (fromJust inputcmdname) cmdname cmds+		(fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds+		name+			| fuzzy = case cmds of+				(c:_) -> Just (cmdname c)+				_ -> inputcmdname+			| otherwise = inputcmdname+		correctedargs = case name of+			Nothing -> allargs+			Just n -> n:args++{- Parses command line, selecting one of the commands from the list. -}+parseCmd :: String -> String -> [GlobalOption] -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v, GlobalSetter)+parseCmd progname progdesc globaloptions allargs allcmds getparser = +	O.execParserPure (O.prefs O.idm) pinfo allargs+  where+	pinfo = O.info (O.helper <*> subcmds) (O.progDescDoc (Just intro))+	subcmds = O.hsubparser $ mconcat $ map mkcommand allcmds+	mkcommand c = O.command (cmdname c) $ O.info (mkparser c) $ O.fullDesc +		<> O.header (synopsis (progname ++ " " ++ cmdname c) (cmddesc c))+		<> O.footer ("For details, run: " ++ progname ++ " help " ++ cmdname c)+	mkparser c = (,,) +		<$> pure c+		<*> getparser c+		<*> combineGlobalOptions globaloptions+	synopsis n d = n ++ " - " ++ d+	intro = mconcat $ concatMap (\l -> [H.text l, H.line])+		(synopsis progname progdesc : commandList allcmds)+ {- Parses command line params far enough to find the Command to run, and  - returns the remaining params.  - Does fuzzy matching if necessary, which may result in multiple Commands. -}-findCmd :: Bool -> CmdParams -> [Command] -> (String -> String) -> (Bool, [Command], String, CmdParams)-findCmd fuzzyok argv cmds err-	| isNothing name = error $ err "missing command"-	| not (null exactcmds) = (False, exactcmds, fromJust name, args)-	| fuzzyok && not (null inexactcmds) = (True, inexactcmds, fromJust name, args)-	| otherwise = error $ err $ "unknown command " ++ fromJust name+findCmd :: Bool -> CmdParams -> [Command] -> (Bool, [Command], Maybe String, CmdParams)+findCmd fuzzyok argv cmds+	| not (null exactcmds) = ret (False, exactcmds)+	| fuzzyok && not (null inexactcmds) = ret (True, inexactcmds)+	| otherwise = ret (False, [])   where+	ret (fuzzy, matches) = (fuzzy, matches, name, args) 	(name, args) = findname argv [] 	findname [] c = (Nothing, reverse c) 	findname (a:as) c@@ -83,18 +117,6 @@ 	inexactcmds = case name of 		Nothing -> [] 		Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds--{- Parses command line options, and returns actions to run to configure flags- - and the remaining parameters for the command. -}-getOptCmd :: CmdParams -> Command -> [Option] -> Either String ([Annex ()], CmdParams)-getOptCmd argv cmd commonoptions = check $-	getOpt Permute (commonoptions ++ cmdoptions cmd) argv-  where-	check (flags, rest, []) = Right (flags, rest)-	check (_, _, errs) = Left $ unlines-		[ concat errs-		, commandUsage cmd-		]  {- Actions to perform each time ran. -} startup :: Annex ()
CmdLine/Action.hs view
@@ -22,11 +22,11 @@ {- Runs a command, starting with the check stage, and then  - the seek stage. Finishes by running the continutation, and   - then showing a count of any failures. -}-performCommandAction :: Command -> CmdParams -> Annex () -> Annex ()-performCommandAction Command { cmdseek = seek, cmdcheck = c, cmdname = name } params cont = do+performCommandAction :: Command -> CommandSeek -> Annex () -> Annex ()+performCommandAction Command { cmdcheck = c, cmdname = name } seek cont = do 	mapM_ runCheck c 	Annex.changeState $ \s -> s { Annex.errcounter = 0 }-	seek params+	seek 	finishCommandActions 	cont 	showerrcount =<< Annex.getState Annex.errcounter
CmdLine/Batch.hs view
@@ -10,29 +10,42 @@ import Common.Annex import Command -batchOption :: Option-batchOption = flagOption [] "batch" "enable batch mode"- data BatchMode = Batch | NoBatch++batchOption :: Parser BatchMode+batchOption = flag NoBatch Batch+	( long "batch"+	<> help "enable batch mode"+	)+ type Batchable t = BatchMode -> t -> CommandStart  -- A Batchable command can run in batch mode, or not. -- In batch mode, one line at a time is read, parsed, and a reply output to -- stdout. In non batch mode, the command's parameters are parsed and -- a reply output for each.-batchable :: ((t -> CommandStart) -> CommandSeek) -> Batchable t -> CommandSeek-batchable seeker starter params = ifM (getOptionFlag batchOption)-	( batchloop-	, seeker (starter NoBatch) params-	)+batchable :: (opts -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser+batchable handler parser paramdesc = batchseeker <$> batchparser   where-	batchloop = do+	batchparser = (,,)+		<$> parser+		<*> batchOption+		<*> cmdParams paramdesc+	+	batchseeker (opts, NoBatch, params) = mapM_ (go NoBatch opts) params+	batchseeker (opts, Batch, _) = batchloop opts++	batchloop opts = do 		mp <- liftIO $ catchMaybeIO getLine 		case mp of 			Nothing -> return () 			Just p -> do-				seeker (starter Batch) [p]-				batchloop+				go Batch opts p+				batchloop opts++	go batchmode opts p =+		unlessM (handler opts p) $+			batchBadInput batchmode  -- bad input is indicated by an empty line in batch mode. In non batch -- mode, exit on bad input.
CmdLine/GitAnnex.hs view
@@ -1,6 +1,6 @@ {- git-annex main program  -- - Copyright 2010-2014 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -14,13 +14,16 @@ import Command import Utility.Env import Annex.Ssh+import Types.Test +import qualified Command.Help import qualified Command.Add import qualified Command.Unannex import qualified Command.Drop import qualified Command.Move import qualified Command.Copy import qualified Command.Get+import qualified Command.Fsck import qualified Command.LookupKey import qualified Command.ContentLocation import qualified Command.ExamineKey@@ -46,7 +49,6 @@ import qualified Command.Describe import qualified Command.InitRemote import qualified Command.EnableRemote-import qualified Command.Fsck import qualified Command.Expire import qualified Command.Repair import qualified Command.Unused@@ -96,7 +98,6 @@ import qualified Command.DiffDriver import qualified Command.Undo import qualified Command.Version-import qualified Command.Help #ifdef WITH_ASSISTANT import qualified Command.Watch import qualified Command.Assistant@@ -117,14 +118,17 @@ import System.Remote.Monitoring #endif -cmds :: [Command]-cmds = concat-	[ Command.Add.cmd+cmds :: Parser TestOptions -> Maybe TestRunner -> [Command]+cmds testoptparser testrunner = +	[ Command.Help.cmd+	, Command.Add.cmd 	, Command.Get.cmd 	, Command.Drop.cmd 	, Command.Move.cmd 	, Command.Copy.cmd+	, Command.Fsck.cmd 	, Command.Unlock.cmd+	, Command.Unlock.editcmd 	, Command.Lock.cmd 	, Command.Sync.cmd 	, Command.Mirror.cmd@@ -175,7 +179,6 @@ 	, Command.VPop.cmd 	, Command.VCycle.cmd 	, Command.Fix.cmd-	, Command.Fsck.cmd 	, Command.Expire.cmd 	, Command.Repair.cmd 	, Command.Unused.cmd@@ -200,7 +203,6 @@ 	, Command.DiffDriver.cmd 	, Command.Undo.cmd 	, Command.Version.cmd-	, Command.Help.cmd #ifdef WITH_ASSISTANT 	, Command.Watch.cmd 	, Command.Assistant.cmd@@ -212,24 +214,25 @@ #endif 	, Command.RemoteDaemon.cmd #endif-	, Command.Test.cmd+	, Command.Test.cmd testoptparser testrunner #ifdef WITH_TESTSUITE 	, Command.FuzzTest.cmd 	, Command.TestRemote.cmd #endif 	] -header :: String-header = "git-annex command [option ...]"--run :: [String] -> IO ()-run args = do+run :: Parser TestOptions -> Maybe TestRunner -> [String] -> IO ()+run testoptparser testrunner args = do #ifdef WITH_EKG 	_ <- forkServer "localhost" 4242 #endif 	go envmodes   where-	go [] = dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get+	go [] = dispatch True args +		(cmds testoptparser testrunner)+		gitAnnexGlobalOptions [] Git.CurrentRepo.get+		"git-annex"+		"manage files with git, without checking their contents in" 	go ((v, a):rest) = maybe (go rest) a =<< getEnv v 	envmodes = 		[ (sshOptionsEnv, runSshOptions args)
CmdLine/GitAnnex/Options.hs view
@@ -1,4 +1,4 @@-{- git-annex options+{- git-annex command-line option parsing  -  - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -@@ -7,7 +7,7 @@  module CmdLine.GitAnnex.Options where -import System.Console.GetOpt+import Options.Applicative  import Common.Annex import qualified Git.Config@@ -15,63 +15,153 @@ import Types.TrustLevel import Types.NumCopies import Types.Messages+import Types.Key+import Types.Command+import Types.DeferredParse+import Types.DesktopNotify import qualified Annex import qualified Remote import qualified Limit import qualified Limit.Wanted import CmdLine.Option import CmdLine.Usage+import CmdLine.GlobalSetter --- Options that are accepted by all git-annex sub-commands,+-- Global options that are accepted by all git-annex sub-commands, -- although not always used.-gitAnnexOptions :: [Option]-gitAnnexOptions = commonOptions ++-	[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)-		"override default number of copies"-	, Option [] ["trust"] (trustArg Trusted)-		"override trust setting"-	, Option [] ["semitrust"] (trustArg SemiTrusted)-		"override trust setting back to default"-	, Option [] ["untrust"] (trustArg UnTrusted)-		"override trust setting to untrusted"-	, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")-		"override git configuration setting"-	, Option [] ["user-agent"] (ReqArg setuseragent paramName)-		"override default User-Agent"-	, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier"))-		"Trust Amazon Glacier inventory"+gitAnnexGlobalOptions :: [GlobalOption]+gitAnnexGlobalOptions = commonGlobalOptions +++	[ globalSetter setnumcopies $ option auto+		( long "numcopies" <> short 'N' <> metavar paramNumber+		<> help "override default number of copies"+		<> hidden+		)+	, globalSetter (Remote.forceTrust Trusted) $ strOption+		( long "trust" <> metavar paramRemote+		<> help "override trust setting"+		<> hidden+		)+	, globalSetter (Remote.forceTrust SemiTrusted) $ strOption+		( long "semitrust" <> metavar paramRemote+		<> help "override trust setting back to default"+		<> hidden+		)+	, globalSetter (Remote.forceTrust UnTrusted) $ strOption+		( long "untrust" <> metavar paramRemote+		<> help "override trust setting to untrusted"+		<> hidden+		)+	, globalSetter setgitconfig $ strOption+		( long "config" <> short 'c' <> metavar "NAME=VALUE"+		<> help "override git configuration setting"+		<> hidden+		)+	, globalSetter setuseragent $ strOption+		( long "user-agent" <> metavar paramName+		<> help "override default User-Agent"+		<> hidden+		)+	, globalFlag (Annex.setFlag "trustglacier")+		( long "trust-glacier"+		<> help "Trust Amazon Glacier inventory"+		<> hidden+		)+	, globalFlag (setdesktopnotify mkNotifyFinish)+		( long "notify-finish"+		<> help "show desktop notification after transfer finishes"+		<> hidden+		)+	, globalFlag (setdesktopnotify mkNotifyStart)+		( long "notify-start"+		<> help "show desktop notification after transfer starts"+		<> hidden+		) 	]   where-	trustArg t = ReqArg (Remote.forceTrust t) paramRemote-	setnumcopies v = maybe noop-		(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n })-		(readish v)+	setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n } 	setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v } 	setgitconfig v = inRepo (Git.Config.store v) 		>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] }) 		>>= Annex.changeGitRepo+	setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v } --- Options for matching on annexed keys, rather than work tree files.-keyOptions :: [Option]-keyOptions = [ allOption, unusedOption, keyOption]+{- Parser that accepts all non-option params. -}+cmdParams :: CmdParamsDesc -> Parser CmdParams+cmdParams paramdesc = many $ argument str+	( metavar paramdesc+	) -allOption :: Option-allOption = Option ['A'] ["all"] (NoArg (Annex.setFlag "all"))-	"operate on all versions of all files"+parseAutoOption :: Parser Bool+parseAutoOption = switch+	( long "auto" <> short 'a'+	<> help "automatic mode"+	) -unusedOption :: Option-unusedOption = Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused"))-	"operate on files found by last run of git-annex unused"+parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote)+parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p -keyOption :: Option-keyOption = Option [] ["key"] (ReqArg (Annex.setField "key") paramKey)-		"operate on specified key"+data FromToOptions+	= FromRemote (DeferredParse Remote)+	| ToRemote (DeferredParse Remote) -incompleteOption :: Option-incompleteOption = flagOption [] "incomplete" "resume previous downloads"+instance DeferredParseClass FromToOptions where+	finishParse (FromRemote v) = FromRemote <$> finishParse v+	finishParse (ToRemote v) = ToRemote <$> finishParse v +parseFromToOptions :: Parser FromToOptions+parseFromToOptions = +	(FromRemote <$> parseFromOption) +	<|> (ToRemote <$> parseToOption)++parseFromOption :: Parser (DeferredParse Remote)+parseFromOption = parseRemoteOption $ strOption+	( long "from" <> short 'f' <> metavar paramRemote+	<> help "source remote"+	)++parseToOption :: Parser (DeferredParse Remote)+parseToOption = parseRemoteOption $ strOption+	( long "to" <> short 't' <> metavar paramRemote+	<> help "destination remote"+	)++-- Options for acting on keys, rather than work tree files.+data KeyOptions+	= WantAllKeys+	| WantUnusedKeys+	| WantSpecificKey Key+	| WantIncompleteKeys++parseKeyOptions :: Bool -> Parser KeyOptions+parseKeyOptions allowincomplete = if allowincomplete+	then base+		<|> flag' WantIncompleteKeys+			( long "incomplete"+			<> help "resume previous downloads"+			)+	else base+  where+	base = parseAllOption+		<|> flag' WantUnusedKeys+			( long "unused" <> short 'U'+			<> help "operate on files found by last run of git-annex unused"+			)+		<|> (WantSpecificKey <$> option (str >>= parseKey)+			( long "key" <> metavar paramKey+			<> help "operate on specified key"+			))++parseAllOption :: Parser KeyOptions+parseAllOption = flag' WantAllKeys+	( long "all" <> short 'A'+	<> help "operate on all versions of all files"+	)++parseKey :: Monad m => String -> m Key+parseKey = maybe (fail "invalid key") return . file2key+ -- Options to match properties of annexed files.-annexedMatchingOptions :: [Option]+annexedMatchingOptions :: [GlobalOption] annexedMatchingOptions = concat 	[ nonWorkTreeMatchingOptions' 	, fileMatchingOptions'@@ -80,84 +170,132 @@ 	]  -- Matching options that don't need to examine work tree files.-nonWorkTreeMatchingOptions :: [Option]+nonWorkTreeMatchingOptions :: [GlobalOption] nonWorkTreeMatchingOptions = nonWorkTreeMatchingOptions' ++ combiningOptions -nonWorkTreeMatchingOptions' :: [Option]+nonWorkTreeMatchingOptions' :: [GlobalOption] nonWorkTreeMatchingOptions' = -	[ Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote)-		"match files present in a remote"-	, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)-		"skip files with fewer copies"-	, Option [] ["lackingcopies"] (ReqArg (Limit.addLackingCopies False) paramNumber)-		"match files that need more copies"-	, Option [] ["approxlackingcopies"] (ReqArg (Limit.addLackingCopies True) paramNumber)-		"match files that need more copies (faster)"-	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)-		"match files using a key-value backend"-	, Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup)-		"match files present in all remotes in a group"-	, Option [] ["metadata"] (ReqArg Limit.addMetaData "FIELD=VALUE")-		"match files with attached metadata"-	, Option [] ["want-get"] (NoArg Limit.Wanted.addWantGet)-		"match files the repository wants to get"-	, Option [] ["want-drop"] (NoArg Limit.Wanted.addWantDrop)-		"match files the repository wants to drop"+	[ globalSetter Limit.addIn $ strOption+		( long "in" <> short 'i' <> metavar paramRemote+		<> help "match files present in a remote"+		<> hidden+		)+	, globalSetter Limit.addCopies $ strOption+		( long "copies" <> short 'C' <> metavar paramRemote+		<> help "skip files with fewer copies"+		<> hidden+		)+	, globalSetter (Limit.addLackingCopies False) $ strOption+		( long "lackingcopies" <> metavar paramNumber+		<> help "match files that need more copies"+		<> hidden+		)+	, globalSetter (Limit.addLackingCopies True) $ strOption+		( long "approxlackingcopies" <> metavar paramNumber+		<> help "match files that need more copies (faster)"+		<> hidden+		)+	, globalSetter Limit.addInBackend $ strOption+		( long "inbackend" <> short 'B' <> metavar paramName+		<> help "match files using a key-value backend"+		<> hidden+		)+	, globalSetter Limit.addInAllGroup $ strOption+		( long "inallgroup" <> metavar paramGroup+		<> help "match files present in all remotes in a group"+		<> hidden+		)+	, globalSetter Limit.addMetaData $ strOption+		( long "metadata" <> metavar "FIELD=VALUE"+		<> help "match files with attached metadata"+		<> hidden+		)+	, globalFlag Limit.Wanted.addWantGet+		( long "want-get"+		<> help "match files the repository wants to get"+		<> hidden+		)+	, globalFlag Limit.Wanted.addWantDrop+		( long "want-drop"+		<> help "match files the repository wants to drop"+		<> hidden+		) 	]  -- Options to match files which may not yet be annexed.-fileMatchingOptions :: [Option]+fileMatchingOptions :: [GlobalOption] fileMatchingOptions = fileMatchingOptions' ++ combiningOptions -fileMatchingOptions' :: [Option]+fileMatchingOptions' :: [GlobalOption] fileMatchingOptions' =-	[ Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)-		"skip files matching the glob pattern"-	, Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob)-		"limit to files matching the glob pattern"-	, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize)-		"match files larger than a size"-	, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize)-		"match files smaller than a size"+	[ globalSetter Limit.addExclude $ strOption+		( long "exclude" <> short 'x' <> metavar paramGlob+		<> help "skip files matching the glob pattern"+		<> hidden+		)+	, globalSetter Limit.addInclude $ strOption+		( long "include" <> short 'I' <> metavar paramGlob+		<> help "limit to files matching the glob pattern"+		<> hidden+		)+	, globalSetter Limit.addLargerThan $ strOption+		( long "largerthan" <> metavar paramSize+		<> help "match files larger than a size"+		<> hidden+		)+	, globalSetter Limit.addSmallerThan $ strOption+		( long "smallerthan" <> metavar paramSize+		<> help "match files smaller than a size"+		<> hidden+		) 	] -combiningOptions :: [Option]-combiningOptions =+combiningOptions :: [GlobalOption]+combiningOptions =  	[ longopt "not" "negate next option" 	, longopt "and" "both previous and next option must match" 	, longopt "or" "either previous or next option must match"-	, shortopt "(" "open group of options"-	, shortopt ")" "close group of options"+	, shortopt '(' "open group of options"+	, shortopt ')' "close group of options" 	]   where-	longopt o = Option [] [o] $ NoArg $ Limit.addToken o-	shortopt o = Option o [] $ NoArg $ Limit.addToken o--fromOption :: Option-fromOption = fieldOption ['f'] "from" paramRemote "source remote"--toOption :: Option-toOption = fieldOption ['t'] "to" paramRemote "destination remote"+	longopt o h = globalFlag (Limit.addToken o) ( long o <> help h <> hidden )+	shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h <> hidden ) -fromToOptions :: [Option]-fromToOptions = [fromOption, toOption]+jsonOption :: GlobalOption+jsonOption = globalFlag (Annex.setOutput JSONOutput)+	( long "json" <> short 'j'+	<> help "enable JSON output"+	<> hidden+	) -jsonOption :: Option-jsonOption = Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput))-	"enable JSON output"+jobsOption :: GlobalOption+jobsOption = globalSetter (Annex.setOutput . ParallelOutput) $ +	option auto+		( long "jobs" <> short 'J' <> metavar paramNumber+		<> help "enable concurrent jobs"+		<> hidden+		) -jobsOption :: Option-jobsOption = Option ['J'] ["jobs"] (ReqArg set paramNumber)-	"enable concurrent jobs"-  where-	set s = case readish s of-		Nothing -> error "Bad --jobs number"-		Just n -> Annex.setOutput (ParallelOutput n)+timeLimitOption :: GlobalOption+timeLimitOption = globalSetter Limit.addTimeLimit $ strOption+	( long "time-limit" <> short 'T' <> metavar paramTime+	<> help "stop after the specified amount of time"+	<> hidden+	) -timeLimitOption :: Option-timeLimitOption = Option ['T'] ["time-limit"]-	(ReqArg Limit.addTimeLimit paramTime)-	"stop after the specified amount of time"+data DaemonOptions = DaemonOptions+	{ foregroundDaemonOption :: Bool+	, stopDaemonOption :: Bool+	} -autoOption :: Option-autoOption = flagOption ['a'] "auto" "automatic mode"+parseDaemonOptions :: Parser DaemonOptions+parseDaemonOptions = DaemonOptions+	<$> switch+		( long "foreground"+		<> help "do not daemonize"+		)+	<*> switch+		( long "stop"+		<> help "stop daemon"+		)
CmdLine/GitAnnexShell.hs view
@@ -8,15 +8,14 @@ module CmdLine.GitAnnexShell where  import System.Environment-import System.Console.GetOpt  import Common.Annex import qualified Git.Construct import qualified Git.Config import CmdLine+import CmdLine.GlobalSetter import Command import Annex.UUID-import Annex (setField) import CmdLine.GitAnnexShell.Fields import Utility.UserInfo import Remote.GCrypt (getGCryptUUID)@@ -34,7 +33,7 @@ import qualified Command.GCryptSetup  cmds_readonly :: [Command]-cmds_readonly = concat+cmds_readonly = 	[ gitAnnexShellCheck Command.ConfigList.cmd 	, gitAnnexShellCheck Command.InAnnex.cmd 	, gitAnnexShellCheck Command.SendKey.cmd@@ -43,7 +42,7 @@ 	]  cmds_notreadonly :: [Command]-cmds_notreadonly = concat+cmds_notreadonly = 	[ gitAnnexShellCheck Command.RecvKey.cmd 	, gitAnnexShellCheck Command.DropKey.cmd 	, gitAnnexShellCheck Command.Commit.cmd@@ -55,10 +54,13 @@   where 	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c } -options :: [OptDescr (Annex ())]-options = commonOptions ++-	[ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid"-	]+globalOptions :: [GlobalOption]+globalOptions = +	globalSetter checkUUID (strOption+		( long "uuid" <> metavar paramUUID+		<> help "local repository uuid"+		))+	: commonGlobalOptions   where 	checkUUID expected = getUUID >>= check 	  where@@ -74,9 +76,6 @@ 	unexpected expected s = error $ 		"expected repository UUID " ++ expected ++ " but found " ++ s -header :: String-header = "git-annex-shell [-c] command [parameters ...] [option ...]"- run :: [String] -> IO () run [] = failure -- skip leading -c options, passed by eg, ssh@@ -100,12 +99,12 @@ 	checkNotReadOnly cmd 	checkDirectory $ Just dir 	let (params', fieldparams, opts) = partitionParams params-	    fields = filter checkField $ parseFields fieldparams-	    cmds' = map (newcmd $ unwords opts) cmds-	dispatch False (cmd : params') cmds' options fields header mkrepo+	    rsyncopts = ("RsyncOptions", unwords opts)+	    fields = rsyncopts : filter checkField (parseFields fieldparams)+	dispatch False (cmd : params') cmds globalOptions fields mkrepo+		"git-annex-shell"+		"Restricted login shell for git-annex only SSH access"   where-	addrsyncopts opts seek k = setField "RsyncOptions" opts >> seek k-	newcmd opts c = c { cmdseek = addrsyncopts opts (cmdseek c) } 	mkrepo = do 		r <- Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath 		Git.Config.read r@@ -143,14 +142,16 @@ {- Only allow known fields to be set, ignore others.  - Make sure that field values make sense. -} checkField :: (String, String) -> Bool-checkField (field, value)-	| field == fieldName remoteUUID = fieldCheck remoteUUID value-	| field == fieldName associatedFile = fieldCheck associatedFile value-	| field == fieldName direct = fieldCheck direct value+checkField (field, val)+	| field == fieldName remoteUUID = fieldCheck remoteUUID val+	| field == fieldName associatedFile = fieldCheck associatedFile val+	| field == fieldName direct = fieldCheck direct val 	| otherwise = False  failure :: IO ()-failure = error $ "bad parameters\n\n" ++ usage header cmds+failure = error $ "bad parameters\n\n" ++ usage h cmds+  where+	h = "git-annex-shell [-c] command [parameters ...] [option ...]"  checkNotLimited :: IO () checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"@@ -200,8 +201,8 @@  {- Modifies a Command to check that it is run in either a git-annex  - repository, or a repository with a gcrypt-id set. -}-gitAnnexShellCheck :: [Command] -> [Command]-gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists+gitAnnexShellCheck :: Command -> Command+gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists   where 	okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $ 		error "Not a git-annex or gcrypt repository."
+ CmdLine/GlobalSetter.hs view
@@ -0,0 +1,24 @@+{- git-annex global options+ -+ - Copyright 2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+  -}+  +module CmdLine.GlobalSetter where++import Types.DeferredParse+import Common+import Annex++import Options.Applicative++globalFlag :: Annex () -> Mod FlagFields GlobalSetter -> GlobalOption+globalFlag setter = flag' (DeferredParse setter) ++globalSetter :: (v -> Annex ()) -> Parser v -> GlobalOption+globalSetter setter parser = DeferredParse . setter <$> parser++combineGlobalOptions :: [GlobalOption] -> Parser GlobalSetter+combineGlobalOptions l = DeferredParse . sequence_ . map getParsed+	<$> many (foldl1 (<|>) l)
CmdLine/Option.hs view
@@ -5,45 +5,55 @@  - Licensed under the GNU GPL version 3 or higher.  -} -module CmdLine.Option (-	commonOptions,-	flagOption,-	fieldOption,-	optionName,-	optionParam,-	ArgDescr(..),-	OptDescr(..),-) where+module CmdLine.Option where -import System.Console.GetOpt+import Options.Applicative  import Common.Annex+import CmdLine.Usage+import CmdLine.GlobalSetter import qualified Annex import Types.Messages-import Types.DesktopNotify-import CmdLine.Usage+import Types.DeferredParse --- Options accepted by both git-annex and git-annex-shell sub-commands.-commonOptions :: [Option]-commonOptions =-	[ Option [] ["force"] (NoArg (setforce True))-		"allow actions that may lose annexed data"-	, Option ['F'] ["fast"] (NoArg (setfast True))-		"avoid slow operations"-	, Option ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))-		"avoid verbose output"-	, Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))-		"allow verbose output (default)"-	, Option ['d'] ["debug"] (NoArg setdebug)-		"show debug messages"-	, Option [] ["no-debug"] (NoArg unsetdebug)-		"don't show debug messages"-	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)-		"specify key-value backend to use"-	, Option [] ["notify-finish"] (NoArg (setdesktopnotify mkNotifyFinish))-		"show desktop notification after transfer finishes"-	, Option [] ["notify-start"] (NoArg (setdesktopnotify mkNotifyStart))-		"show desktop notification after transfer completes"+-- Global options accepted by both git-annex and git-annex-shell sub-commands.+commonGlobalOptions :: [GlobalOption]+commonGlobalOptions =+	[ globalFlag (setforce True)+		( long "force" +		<> help "allow actions that may lose annexed data"+		<> hidden+		)+	, globalFlag (setfast True)+		( long "fast" <> short 'F'+		<> help "avoid slow operations"+		<> hidden+		)+	, globalFlag (Annex.setOutput QuietOutput)+		( long "quiet" <> short 'q'+		<> help "avoid verbose output"+		<> hidden+		)+	, globalFlag (Annex.setOutput NormalOutput)+		( long "verbose" <> short 'v'+		<> help "allow verbose output (default)"+		<> hidden+		)+	, globalFlag setdebug+		( long "debug" <> short 'd'+		<> help "show debug messages"+		<> hidden+		)+	, globalFlag unsetdebug+		( long "no-debug"+		<> help "don't show debug messages"+		<> hidden+		)+	, globalSetter setforcebackend $ strOption+		( long "backend" <> short 'b' <> metavar paramName+		<> help "specify key-value backend to use"+		<> hidden+		) 	]   where 	setforce v = Annex.changeState $ \s -> s { Annex.force = v }@@ -51,21 +61,3 @@ 	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } 	setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True } 	unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }-	setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }--{- An option that sets a flag. -}-flagOption :: String -> String -> String -> Option-flagOption 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 opt paramdesc description = -	Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description--{- The flag or field name used for an option. -}-optionName :: Option -> String-optionName (Option _ o _ _) = Prelude.head o--optionParam :: Option -> String-optionParam o = "--" ++ optionName o
CmdLine/Seek.hs view
@@ -22,18 +22,18 @@ import qualified Git.LsTree as LsTree import Git.FilePath import qualified Limit-import CmdLine.Option+import CmdLine.GitAnnex.Options import CmdLine.Action import Logs.Location import Logs.Unused import Annex.CatFile import Annex.Content -withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek+withFilesInGit :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesInGit a params = seekActions $ prepFiltered a $ 	seekHelper LsFiles.inRepo params -withFilesInGitNonRecursive :: (FilePath -> CommandStart) -> CommandSeek+withFilesInGitNonRecursive :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesInGitNonRecursive a params = ifM (Annex.getState Annex.force) 	( withFilesInGit a params 	, if null params@@ -54,7 +54,7 @@ 			_ -> needforce 	needforce = error "Not recursively setting metadata. Use --force to do that." -withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CommandSeek+withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesNotInGit skipdotfiles a params 	| skipdotfiles = do 		{- dotfiles are not acted on unless explicitly listed -}@@ -73,7 +73,7 @@ 	go l = seekActions $ prepFiltered a $ 		return $ concat $ segmentPaths params l -withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CommandSeek+withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CmdParams -> CommandSeek withFilesInRefs a = mapM_ go   where 	go r = do	@@ -87,7 +87,7 @@ 				Just k -> whenM (matcher $ MatchingKey k) $ 					commandAction $ a f k -withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek+withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CmdParams -> CommandSeek withPathContents a params = do 	matcher <- Limit.getMatcher 	seekActions $ map a <$> (filterM (checkmatch matcher) =<< ps)@@ -103,27 +103,27 @@ 		, matchFile = relf 		} -withWords :: ([String] -> CommandStart) -> CommandSeek+withWords :: ([String] -> CommandStart) -> CmdParams -> CommandSeek withWords a params = seekActions $ return [a params] -withStrings :: (String -> CommandStart) -> CommandSeek+withStrings :: (String -> CommandStart) -> CmdParams -> CommandSeek withStrings a params = seekActions $ return $ map a params -withPairs :: ((String, String) -> CommandStart) -> CommandSeek+withPairs :: ((String, String) -> CommandStart) -> CmdParams -> CommandSeek withPairs a params = seekActions $ return $ map a $ pairs [] params   where 	pairs c [] = reverse c 	pairs c (x:y:xs) = pairs ((x,y):c) xs 	pairs _ _ = error "expected pairs" -withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek+withFilesToBeCommitted :: (String -> CommandStart) -> CmdParams -> CommandSeek withFilesToBeCommitted a params = seekActions $ prepFiltered a $ 	seekHelper LsFiles.stagedNotDeleted params -withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek+withFilesUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged -withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek+withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged  {- Unlocked files have changed type from a symlink to a regular file.@@ -131,7 +131,7 @@  - Furthermore, unlocked files used to be a git-annex symlink,  - not some other sort of symlink.  -}-withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek+withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesUnlocked' typechanged a params = seekActions $ 	prepFiltered a unlockedfiles   where@@ -142,25 +142,16 @@ 	(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)  {- Finds files that may be modified. -}-withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek+withFilesMaybeModified :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek withFilesMaybeModified a params = seekActions $ 	prepFiltered a $ seekHelper LsFiles.modified params -withKeys :: (Key -> CommandStart) -> CommandSeek+withKeys :: (Key -> CommandStart) -> CmdParams -> CommandSeek withKeys a params = seekActions $ return $ map (a . parse) params   where 	parse p = fromMaybe (error "bad key") $ file2key p -{- Gets the value of a field options, which is fed into- - a conversion function.- -}-getOptionField :: Option -> (Maybe String -> Annex a) -> Annex a-getOptionField option converter = converter <=< Annex.getField $ optionName option--getOptionFlag :: Option -> Annex Bool-getOptionFlag option = Annex.getFlag (optionName option)--withNothing :: CommandStart -> CommandSeek+withNothing :: CommandStart -> CmdParams -> CommandSeek withNothing a [] = seekActions $ return [a] withNothing _ _ = error "This command takes no parameters." @@ -171,40 +162,34 @@  -  - Otherwise falls back to a regular CommandSeek action on  - whatever params were passed. -}-withKeyOptions :: Bool -> (Key -> CommandStart) -> CommandSeek -> CommandSeek-withKeyOptions auto keyop = withKeyOptions' auto $ \getkeys -> do+withKeyOptions :: Maybe KeyOptions -> Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek+withKeyOptions ko auto keyaction = withKeyOptions' ko auto $ \getkeys -> do 	matcher <- Limit.getMatcher 	seekActions $ map (process matcher) <$> getkeys   where 	process matcher k = ifM (matcher $ MatchingKey k)-		( keyop k+		( keyaction k 		, return Nothing 		) -withKeyOptions' :: Bool -> (Annex [Key] -> Annex ()) -> CommandSeek -> CommandSeek-withKeyOptions' auto keyop fallbackop params = do+withKeyOptions' :: Maybe KeyOptions -> Bool -> (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek+withKeyOptions' ko auto keyaction fallbackaction params = do 	bare <- fromRepo Git.repoIsLocalBare-	allkeys <- Annex.getFlag "all"-	unused <- Annex.getFlag "unused"-	incomplete <- Annex.getFlag "incomplete"-	specifickey <- Annex.getField "key" 	when (auto && bare) $ 		error "Cannot use --auto in a bare repository"-	case	(allkeys, unused, incomplete, null params, specifickey) of-		(False  , False , False     , True       , Nothing)+	case (null params, ko) of+		(True, Nothing) 			| bare -> go auto loggedKeys-			| otherwise -> fallbackop params-		(False  , False , False     , _          , Nothing) -> fallbackop params-		(True   , False , False     , True       , Nothing) -> go auto loggedKeys-		(False  , True  , False     , True       , Nothing) -> go auto unusedKeys'-		(False  , False , True      , True       , Nothing) -> go auto incompletekeys-		(False  , False , False     , True       , Just ks) -> case file2key ks of-			Nothing -> error "Invalid key"-			Just k -> go auto $ return [k]-		_ -> error "Can only specify one of file names, --all, --unused, --key, or --incomplete"+			| otherwise -> fallbackaction params+		(False, Nothing) -> fallbackaction params+		(True, Just WantAllKeys) -> go auto loggedKeys+		(True, Just WantUnusedKeys) -> go auto unusedKeys'+		(True, Just (WantSpecificKey k)) -> go auto $ return [k]+		(True, Just WantIncompleteKeys) -> go auto incompletekeys+		(False, Just _) -> error "Can only specify one of file names, --all, --unused, --key, or --incomplete"   where 	go True _ = error "Cannot use --auto with --all or --unused or --key or --incomplete"-	go False getkeys = keyop getkeys+	go False getkeys = keyaction getkeys 	incompletekeys = staleKeysPrune gitAnnexTmpObjectDir True  prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
CmdLine/Usage.hs view
@@ -1,6 +1,6 @@ {- git-annex usage messages  -- - Copyright 2010-2011 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -8,17 +8,17 @@ module CmdLine.Usage where  import Common.Annex- import Types.Command -import System.Console.GetOpt- usageMessage :: String -> String usageMessage s = "Usage: " ++ s -{- Usage message with lists of commands by section. -} usage :: String -> [Command] -> String-usage header cmds = unlines $ usageMessage header : concatMap go [minBound..]+usage header cmds = unlines $ usageMessage header : commandList cmds++{- Commands listed by section, with breif usage and description. -}+commandList :: [Command] -> [String]+commandList cmds = concatMap go [minBound..]   where 	go section 		| null cs = []@@ -42,23 +42,10 @@ 	longest f = foldl max 0 $ map (length . f) cmds 	scmds = sort cmds -{- Usage message for a single command. -}-commandUsage :: Command -> String-commandUsage cmd = unlines-	[ usageInfo header (cmdoptions cmd)-	, "To see additional options common to all commands, run: git annex help options"-	]-  where-	header = usageMessage $ unwords-		[ "git-annex"-		, cmdname cmd-		, cmdparamdesc cmd-		, "[option ...]"-		]  {- Descriptions of params used in usage messages. -} paramPaths :: String-paramPaths = paramOptional $ paramRepeating paramPath -- most often used+paramPaths = paramRepeating paramPath -- most often used paramPath :: String paramPath = "PATH" paramKey :: String@@ -114,6 +101,6 @@ paramRepeating :: String -> String paramRepeating s = s ++ " ..." paramOptional :: String -> String-paramOptional s = "[" ++ s ++ "]"+paramOptional s = s paramPair :: String -> String -> String paramPair a b = a ++ " " ++ b
Command.hs view
@@ -1,16 +1,18 @@ {- git-annex command infrastructure  -- - Copyright 2010-2014 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}  module Command ( 	command,+	withParams,+	(<--<), 	noRepo, 	noCommit, 	noMessages,-	withOptions,+	withGlobalOptions, 	next, 	stop, 	stopUnless,@@ -25,17 +27,39 @@ import qualified Git import Types.Command as ReExported import Types.Option as ReExported+import Types.DeferredParse as ReExported import CmdLine.Seek as ReExported import Checks as ReExported import CmdLine.Usage as ReExported import CmdLine.Action as ReExported import CmdLine.Option as ReExported+import CmdLine.GlobalSetter as ReExported import CmdLine.GitAnnex.Options as ReExported+import Options.Applicative as ReExported hiding (command) -{- Generates a normal command -}-command :: String -> String -> CommandSeek -> CommandSection -> String -> Command-command = Command [] Nothing commonChecks False False+import qualified Options.Applicative as O +{- Generates a normal Command -}+command :: String -> CommandSection -> String -> CmdParamsDesc -> (CmdParamsDesc -> CommandParser) -> Command+command name section desc paramdesc mkparser =+	Command commonChecks False False name paramdesc +		section desc (mkparser paramdesc) Nothing++{- Simple option parser that takes all non-option params as-is. -}+withParams :: (CmdParams -> v) -> CmdParamsDesc -> O.Parser v+withParams mkseek paramdesc = mkseek <$> cmdParams paramdesc++{- Uses the supplied option parser, which yields a deferred parse,+ - and calls finishParse on the result before passing it to the+ - CommandSeek constructor. -}+(<--<) :: DeferredParseClass a+	=> (a -> CommandSeek) +	-> (CmdParamsDesc -> Parser a)+	-> CmdParamsDesc+	-> Parser CommandSeek+(<--<) mkseek optparser paramsdesc = +	(mkseek <=< finishParse) <$> optparser paramsdesc+ {- Indicates that a command doesn't need to commit any changes to  - the git-annex branch. -} noCommit :: Command -> Command@@ -48,12 +72,21 @@  {- Adds a fallback action to a command, that will be run if it's used  - outside a git repository. -}-noRepo :: (CmdParams -> IO ()) -> Command -> Command-noRepo a c = c { cmdnorepo = Just a }+noRepo :: (String -> O.Parser (IO ())) -> Command -> Command+noRepo a c = c { cmdnorepo = Just (a (cmdparamdesc c)) } -{- Adds options to a command. -}-withOptions :: [Option] -> Command -> Command-withOptions o c = c { cmdoptions = cmdoptions c ++ o }+{- Adds global options to a command's option parser, and modifies its seek+ - option to first run actions for them.+ -}+withGlobalOptions :: [GlobalOption] -> Command -> Command+withGlobalOptions os c = c { cmdparser = apply <$> mixin (cmdparser c) }+  where+	mixin p = (,) +		<$> p+		<*> combineGlobalOptions os+	apply (seek, globalsetters) = do+		void $ getParsed globalsetters+		seek  {- For start and perform stages to indicate what step to run next. -} next :: a -> Annex (Maybe a)
Command/Add.hs view
@@ -34,28 +34,35 @@  import Control.Exception (IOException) -cmd :: [Command]-cmd = [notBareRepo $ withOptions addOptions $-	command "add" paramPaths seek SectionCommon "add files to annex"]+cmd :: Command+cmd = notBareRepo $ withGlobalOptions fileMatchingOptions $+	command "add" SectionCommon "add files to annex"+		paramPaths (seek <$$> optParser) -addOptions :: [Option]-addOptions = includeDotFilesOption : fileMatchingOptions+data AddOptions = AddOptions+	{ addThese :: CmdParams+	, includeDotFiles :: Bool+	} -includeDotFilesOption :: Option-includeDotFilesOption = flagOption [] "include-dotfiles" "don't skip dotfiles"+optParser :: CmdParamsDesc -> Parser AddOptions+optParser desc = AddOptions+	<$> cmdParams desc+	<*> switch+		( long "include-dotfiles"+		<> help "don't skip dotfiles"+		)  {- Add acts on both files not checked into git yet, and unlocked files.  -  - In direct mode, it acts on any files that have changed. -}-seek :: CommandSeek-seek ps = do+seek :: AddOptions -> CommandSeek+seek o = do 	matcher <- largeFilesMatcher-	let go a = flip a ps $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)+	let go a = flip a (addThese o) $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force) 		( start file 		, startSmall file 		)-	skipdotfiles <- not <$> Annex.getFlag (optionName includeDotFilesOption)-	go $ withFilesNotInGit skipdotfiles+	go $ withFilesNotInGit (not $ includeDotFiles o) 	ifM isDirect 		( go withFilesMaybeModified 		, go withFilesUnlocked@@ -70,8 +77,8 @@  performAdd :: FilePath -> CommandPerform performAdd file = do-	params <- forceParams-	Annex.Queue.addCommand "add" (params++[Param "--"]) [file]+	ps <- forceParams+	Annex.Queue.addCommand "add" (ps++[Param "--"]) [file] 	next $ return True  {- The add subcommand annexes a file, generating a key for it using a@@ -278,8 +285,8 @@ addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig) 	( do 		_ <- link file key mcache-		params <- forceParams-		Annex.Queue.addCommand "add" (params++[Param "--"]) [file]+		ps <- forceParams+		Annex.Queue.addCommand "add" (ps++[Param "--"]) [file] 	, do 		l <- link file key mcache 		addAnnexLink l file
Command/AddUnused.hs view
@@ -14,11 +14,13 @@ import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Types.Key -cmd :: [Command]-cmd = [notDirect $ command "addunused" (paramRepeating paramNumRange)-	seek SectionMaintenance "add back unused files"]+cmd :: Command+cmd = notDirect $ +	command "addunused" SectionMaintenance +		"add back unused files"+		(paramRepeating paramNumRange) (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withUnusedMaps start  start :: UnusedMaps -> Int -> CommandStart
Command/AddUrl.hs view
@@ -37,39 +37,66 @@ import qualified Utility.Quvi as Quvi #endif -cmd :: [Command]-cmd = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption, rawOption] $-	command "addurl" (paramRepeating paramUrl) seek-		SectionCommon "add urls to annex"]+cmd :: Command+cmd = notBareRepo $+	command "addurl" SectionCommon "add urls to annex"+		(paramRepeating paramUrl) (seek <$$> optParser) -fileOption :: Option-fileOption = fieldOption [] "file" paramFile "specify what file the url is added to"+data AddUrlOptions = AddUrlOptions+	{ addUrls :: CmdParams+	, fileOption :: Maybe FilePath+	, pathdepthOption :: Maybe Int+	, prefixOption :: Maybe String+	, suffixOption :: Maybe String+	, relaxedOption :: Bool+	, rawOption :: Bool+	} -pathdepthOption :: Option-pathdepthOption = fieldOption [] "pathdepth" paramNumber "path components to use in filename"+optParser :: CmdParamsDesc -> Parser AddUrlOptions+optParser desc = AddUrlOptions+	<$> cmdParams desc+	<*> optional (strOption+		( long "file" <> metavar paramFile+		<> help "specify what file the url is added to"+		))+	<*> optional (option auto+		( long "pathdepth" <> metavar paramNumber+		<> help "number of url path components to use in filename"+		))+	<*> optional (strOption+		( long "prefix" <> metavar paramValue+		<> help "add a prefix to the filename"+		))+	<*> optional (strOption+		( long "suffix" <> metavar paramValue+		<> help "add a suffix to the filename"+		))+	<*> parseRelaxedOption+	<*> parseRawOption -relaxedOption :: Option-relaxedOption = flagOption [] "relaxed" "skip size check"+parseRelaxedOption :: Parser Bool+parseRelaxedOption = switch+	( long "relaxed"+	<> help "skip size check"+	) -rawOption :: Option-rawOption = flagOption [] "raw" "disable special handling for torrents, quvi, etc"+parseRawOption :: Parser Bool+parseRawOption = switch+	( long "raw"+	<> help "disable special handling for torrents, quvi, etc"+	) -seek :: CommandSeek-seek us = do-	optfile <- getOptionField fileOption return-	relaxed <- getOptionFlag relaxedOption-	raw <- getOptionFlag rawOption-	pathdepth <- getOptionField pathdepthOption (return . maybe Nothing readish)-	forM_ us $ \u -> do-		r <- Remote.claimingUrl u-		if Remote.uuid r == webUUID || raw-			then void $ commandAction $ startWeb relaxed optfile pathdepth u-			else checkUrl r u optfile relaxed pathdepth+seek :: AddUrlOptions -> CommandSeek+seek o = forM_ (addUrls o) $ \u -> do+	r <- Remote.claimingUrl u+	if Remote.uuid r == webUUID || rawOption o+		then void $ commandAction $ startWeb o u+		else checkUrl r o u -checkUrl :: Remote -> URLString -> Maybe FilePath -> Bool -> Maybe Int -> Annex ()-checkUrl r u optfile relaxed pathdepth = do+checkUrl :: Remote -> AddUrlOptions -> URLString -> Annex ()+checkUrl r o u = do 	pathmax <- liftIO $ fileNameLengthLimit "."-	let deffile = fromMaybe (urlString2file u pathdepth pathmax) optfile+	let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption o) 	go deffile =<< maybe 		(error $ "unable to checkUrl of " ++ Remote.name r) 		(tryNonAsync . flip id u)@@ -81,14 +108,15 @@ 		warning (show e) 		next $ next $ return False 	go deffile (Right (UrlContents sz mf)) = do-		let f = fromMaybe (maybe deffile fromSafeFilePath mf) optfile+		let f = adjustFile o (fromMaybe (maybe deffile fromSafeFilePath mf) (fileOption o)) 		void $ commandAction $-			startRemote r relaxed f u sz+			startRemote r (relaxedOption o) f u sz 	go deffile (Right (UrlMulti l))-		| isNothing optfile =-			forM_ l $ \(u', sz, f) ->+		| isNothing (fileOption o) =+			forM_ l $ \(u', sz, f) -> do+				let f' = adjustFile o (deffile </> fromSafeFilePath f) 				void $ commandAction $-					startRemote r relaxed (deffile </> fromSafeFilePath f) u' sz+					startRemote r (relaxedOption o) f' u' sz 		| otherwise = error $ unwords 			[ "That url contains multiple files according to the" 			, Remote.name r@@ -134,8 +162,8 @@   where 	loguri = setDownloader uri OtherDownloader -startWeb :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart-startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring+startWeb :: AddUrlOptions -> String -> CommandStart+startWeb o s = go $ fromMaybe bad $ parseURI urlstring   where 	(urlstring, downloader) = getDownloader s 	bad = fromMaybe (error $ "bad url " ++ urlstring) $@@ -153,22 +181,22 @@ #endif 	regulardownload url = do 		pathmax <- liftIO $ fileNameLengthLimit "."-		urlinfo <- if relaxed+		urlinfo <- if relaxedOption o 			then pure $ Url.UrlInfo True Nothing Nothing 			else Url.withUrlOptions (Url.getUrlInfo urlstring)-		file <- case optfile of+		file <- adjustFile o <$> case fileOption o of 			Just f -> pure f 			Nothing -> case Url.urlSuggestedFile urlinfo of-				Nothing -> pure $ url2file url pathdepth pathmax+				Nothing -> pure $ url2file url (pathdepthOption o) pathmax 				Just sf -> do 					let f = truncateFilePath pathmax $ 						sanitizeFilePath sf 					ifM (liftIO $ doesFileExist f <||> doesDirectoryExist f)-						( pure $ url2file url pathdepth pathmax+						( pure $ url2file url (pathdepthOption o) pathmax 						, pure f 						) 		showStart "addurl" file-		next $ performWeb relaxed urlstring file urlinfo+		next $ performWeb (relaxedOption o) urlstring file urlinfo #ifdef WITH_QUVI 	badquvi = error $ "quvi does not know how to download url " ++ urlstring 	usequvi = do@@ -176,11 +204,11 @@ 			<$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] urlstring 		let link = fromMaybe badquvi $ headMaybe $ Quvi.pageLinks page 		pathmax <- liftIO $ fileNameLengthLimit "."-		let file = flip fromMaybe optfile $+		let file = adjustFile o $ flip fromMaybe (fileOption o) $ 			truncateFilePath pathmax $ sanitizeFilePath $ 				Quvi.pageTitle page ++ "." ++ fromMaybe "m" (Quvi.linkSuffix link) 		showStart "addurl" file-		next $ performQuvi relaxed urlstring (Quvi.linkUrl link) file+		next $ performQuvi (relaxedOption o) urlstring (Quvi.linkUrl link) file #else 	usequvi = error "not built with quvi support" #endif@@ -350,3 +378,9 @@ urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of 	Nothing -> error $ "bad uri " ++ s 	Just u -> url2file u pathdepth pathmax++adjustFile :: AddUrlOptions -> FilePath -> FilePath+adjustFile o = addprefix . addsuffix+  where+	addprefix f = maybe f (++ f) (prefixOption o)+	addsuffix f = maybe f (f ++) (suffixOption o)
Command/Assistant.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -17,65 +17,60 @@ import Utility.HumanTime import Assistant.Install -import System.Environment--cmd :: [Command]-cmd = [noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $-	notBareRepo $ command "assistant" paramNothing seek SectionCommon-		"automatically sync changes"]--options :: [Option]-options =-	[ Command.Watch.foregroundOption-	, Command.Watch.stopOption-	, autoStartOption-	, startDelayOption-	, autoStopOption-	]--autoStartOption :: Option-autoStartOption = flagOption [] "autostart" "start in known repositories"+cmd :: Command+cmd = dontCheck repoExists $ notBareRepo $+	noRepo (startNoRepo <$$> optParser) $+		command "assistant" SectionCommon+			"automatically sync changes"+			paramNothing (seek <$$> optParser) -autoStopOption :: Option-autoStopOption = flagOption [] "autostop" "stop in known repositories"+data AssistantOptions = AssistantOptions+	{ daemonOptions :: DaemonOptions+	, autoStartOption :: Bool+	, startDelayOption :: Maybe Duration+	, autoStopOption :: Bool+	} -startDelayOption :: Option-startDelayOption = fieldOption [] "startdelay" paramNumber "delay before running startup scan"+optParser :: CmdParamsDesc -> Parser AssistantOptions+optParser _ = AssistantOptions+	<$> parseDaemonOptions+	<*> switch+		( long "autostart"+		<> help "start in known repositories"+		)+	<*> optional (option (str >>= parseDuration)+		( long "startdelay" <> metavar paramNumber+		<> help "delay before running startup scan"+		))+	<*> switch+		( long "autostop"+		<> help "stop in known repositories"+		) -seek :: CommandSeek-seek ps = do-	stopdaemon <- getOptionFlag Command.Watch.stopOption-	foreground <- getOptionFlag Command.Watch.foregroundOption-	autostart <- getOptionFlag autoStartOption-	autostop <- getOptionFlag autoStopOption-	startdelay <- getOptionField startDelayOption (pure . maybe Nothing parseDuration)-	withNothing (start foreground stopdaemon autostart autostop startdelay) ps+seek :: AssistantOptions -> CommandSeek+seek = commandAction . start -start :: Bool -> Bool -> Bool -> Bool -> Maybe Duration -> CommandStart-start foreground stopdaemon autostart autostop startdelay-	| autostart = do-		liftIO $ autoStart startdelay+start :: AssistantOptions -> CommandStart+start o+	| autoStartOption o = do+		liftIO $ autoStart o 		stop-	| autostop = do+	| autoStopOption o = do 		liftIO autoStop 		stop 	| otherwise = do 		liftIO ensureInstalled 		ensureInitialized-		Command.Watch.start True foreground stopdaemon startdelay+		Command.Watch.start True (daemonOptions o) (startDelayOption o) -{- Run outside a git repository; support autostart and autostop mode. -}-checkNoRepoOpts :: CmdParams -> IO ()-checkNoRepoOpts _ = ifM (elem "--autostart" <$> getArgs)-	( autoStart Nothing-	, ifM (elem "--autostop" <$> getArgs)-		( autoStop-		, error "Not in a git repository."-		)-	) +startNoRepo :: AssistantOptions -> IO ()+startNoRepo o+	| autoStartOption o = autoStart o+	| autoStopOption o = autoStop+	| otherwise = error "Not in a git repository." -autoStart :: Maybe Duration -> IO ()-autoStart startdelay = do+autoStart :: AssistantOptions -> IO ()+autoStart o = do 	dirs <- liftIO readAutoStartFile 	when (null dirs) $ do 		f <- autoStartFile@@ -103,7 +98,7 @@ 	  where 		baseparams = 			[ Param "assistant"-			, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) startdelay)+			, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) (startDelayOption o)) 			]  autoStop :: IO ()
Command/CheckPresentKey.hs view
@@ -14,11 +14,14 @@ import Annex import Types.Messages -cmd :: [Command]-cmd = [noCommit $ command "checkpresentkey" (paramPair paramKey paramRemote) seek-	SectionPlumbing "check if key is present in remote"] +cmd :: Command+cmd = noCommit $ +	command "checkpresentkey" SectionPlumbing+		"check if key is present in remote"+		(paramPair paramKey paramRemote)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Commit.hs view
@@ -12,11 +12,12 @@ import qualified Annex.Branch import qualified Git -cmd :: [Command]-cmd = [command "commit" paramNothing seek-	SectionPlumbing "commits any staged changes to the git-annex branch"]+cmd :: Command+cmd = command "commit" SectionPlumbing +	"commits any staged changes to the git-annex branch"+	paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/ConfigList.hs view
@@ -15,11 +15,13 @@ import qualified Git.Config import Remote.GCrypt (coreGCryptId) -cmd :: [Command]-cmd = [noCommit $ command "configlist" paramNothing seek-	SectionPlumbing "outputs relevant git configuration"]+cmd :: Command+cmd = noCommit $ +	command "configlist" SectionPlumbing +		"outputs relevant git configuration"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/ContentLocation.hs view
@@ -11,20 +11,20 @@ import Command import CmdLine.Batch import Annex.Content--cmd :: [Command]-cmd = [withOptions [batchOption] $ noCommit $ noMessages $-	command "contentlocation" (paramRepeating paramKey) seek-		SectionPlumbing "looks up content for a key"]+import Types.Key -seek :: CommandSeek-seek = batchable withKeys start+cmd :: Command+cmd = noCommit $ noMessages $+	command "contentlocation" SectionPlumbing +		"looks up content for a key"+		(paramRepeating paramKey)+		(batchable run (pure ())) -start :: Batchable Key-start batchmode k = do-	maybe (batchBadInput batchmode) (liftIO . putStrLn)+run :: () -> String -> Annex Bool+run _ p = do+	let k = fromMaybe (error "bad key") $ file2key p+	maybe (return False) (\f -> liftIO (putStrLn f) >> return True) 		=<< inAnnex' (pure True) Nothing check k-	stop   where 	check f = ifM (liftIO (doesFileExist f)) 		( return (Just f)
Command/Copy.hs view
@@ -14,33 +14,44 @@ import Annex.Wanted import Annex.NumCopies -cmd :: [Command]-cmd = [withOptions copyOptions $ command "copy" paramPaths seek-	SectionCommon "copy content of files to/from another repository"]+cmd :: Command+cmd = command "copy" SectionCommon+	"copy content of files to/from another repository"+	paramPaths (seek <--< optParser) -copyOptions :: [Option]-copyOptions = Command.Move.moveOptions ++ [autoOption]+data CopyOptions = CopyOptions+	{ moveOptions :: Command.Move.MoveOptions+	, autoMode :: Bool+	} -seek :: CommandSeek-seek ps = do-	to <- getOptionField toOption Remote.byNameWithUUID-	from <- getOptionField fromOption Remote.byNameWithUUID-	auto <- getOptionFlag autoOption-	withKeyOptions auto-		(Command.Move.startKey to from False)-		(withFilesInGit $ whenAnnexed $ start auto to from)-		ps+optParser :: CmdParamsDesc -> Parser CopyOptions+optParser desc = CopyOptions+	<$> Command.Move.optParser desc+	<*> parseAutoOption +instance DeferredParseClass CopyOptions where+	finishParse v = CopyOptions+		<$> finishParse (moveOptions v)+		<*> pure (autoMode v)++seek :: CopyOptions -> CommandSeek+seek o = withKeyOptions (Command.Move.keyOptions $ moveOptions o) (autoMode o)+	(Command.Move.startKey (moveOptions o) False)+	(withFilesInGit $ whenAnnexed $ start o)+	(Command.Move.moveFiles $ moveOptions o)+ {- A copy is just a move that does not delete the source file.  - However, auto mode avoids unnecessary copies, and avoids getting or  - sending non-preferred content. -}-start :: Bool -> Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart-start auto to from file key = stopUnless shouldCopy $ -	Command.Move.start to from False file key+start :: CopyOptions -> FilePath -> Key -> CommandStart+start o file key = stopUnless shouldCopy $ +	Command.Move.start (moveOptions o) False file key   where 	shouldCopy-		| auto = want <||> numCopiesCheck file key (<)+		| autoMode o = want <||> numCopiesCheck file key (<) 		| otherwise = return True-	want = case to of-		Nothing -> wantGet False (Just key) (Just file)-		Just r -> wantSend False (Just key) (Just file) (Remote.uuid r)+	want = case Command.Move.fromToOptions (moveOptions o) of+		ToRemote _ -> +			wantGet False (Just key) (Just file)+		FromRemote dest -> (Remote.uuid <$> getParsed dest) >>=+			wantSend False (Just key) (Just file)
Command/Dead.hs view
@@ -9,26 +9,29 @@  import Command import Common.Annex-import qualified Annex import Types.TrustLevel import Types.Key import Command.Trust (trustCommand) import Logs.Location import Remote (keyLocations)+import Git.Types -cmd :: [Command]-cmd = [withOptions [keyOption] $ -	command "dead" (paramRepeating paramRemote) seek-		SectionSetup "hide a lost repository or key"]+cmd :: Command+cmd = command "dead" SectionSetup "hide a lost repository or key"+	(paramRepeating paramRemote) (seek <$$> optParser) -seek :: CommandSeek-seek ps = maybe (trustCommand "dead" DeadTrusted ps) (flip seekKey ps)-	=<< Annex.getField "key"+data DeadOptions = DeadRemotes [RemoteName] | DeadKeys [Key] -seekKey :: String -> CommandSeek-seekKey ks = case file2key ks of-	Nothing -> error "Invalid key"-	Just key -> withNothing (startKey key)+optParser :: CmdParamsDesc -> Parser DeadOptions+optParser desc = (DeadRemotes <$> cmdParams desc)+	<|> (DeadKeys <$> many (option (str >>= parseKey)+		( long "key" <> metavar paramKey+		<> help "keys whose content has been irretrievably lost"+		)))++seek :: DeadOptions -> CommandSeek+seek (DeadRemotes rs) = trustCommand "dead" DeadTrusted rs+seek (DeadKeys ks) = seekActions $ pure $ map startKey ks  startKey :: Key -> CommandStart startKey key = do
Command/Describe.hs view
@@ -12,11 +12,13 @@ import qualified Remote import Logs.UUID -cmd :: [Command]-cmd = [command "describe" (paramPair paramRemote paramDesc) seek-	SectionSetup "change description of a repository"]+cmd :: Command+cmd = command "describe" SectionSetup+	"change description of a repository"+	(paramPair paramRemote paramDesc)+	(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/DiffDriver.hs view
@@ -13,12 +13,13 @@ import Annex.Link import Git.Types -cmd :: [Command]-cmd = [dontCheck repoExists $-	command "diffdriver" ("[-- cmd --]") seek-		SectionPlumbing "external git diff driver shim"]+cmd :: Command+cmd = dontCheck repoExists $+	command "diffdriver" SectionPlumbing +		"external git diff driver shim"+		("-- cmd --") (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Direct.hs view
@@ -15,12 +15,12 @@ import Config import Annex.Direct -cmd :: [Command]-cmd = [notBareRepo $ noDaemonRunning $-	command "direct" paramNothing seek-		SectionSetup "switch repository to direct mode"]+cmd :: Command+cmd = notBareRepo $ noDaemonRunning $+	command "direct" SectionSetup "switch repository to direct mode"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/Drop.hs view
@@ -22,46 +22,61 @@  import qualified Data.Set as S -cmd :: [Command]-cmd = [withOptions (dropOptions) $ command "drop" paramPaths seek-	SectionCommon "indicate content of files not currently wanted"]+cmd :: Command+cmd = withGlobalOptions annexedMatchingOptions $+	command "drop" SectionCommon+		"remove content of files from repository"+		paramPaths (seek <$$> optParser) -dropOptions :: [Option]-dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions+data DropOptions = DropOptions+	{ dropFiles :: CmdParams+	, dropFrom :: Maybe (DeferredParse Remote)+	, autoMode :: Bool+	, keyOptions :: Maybe KeyOptions+	} -dropFromOption :: Option-dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"+optParser :: CmdParamsDesc -> Parser DropOptions+optParser desc = DropOptions+	<$> cmdParams desc+	<*> optional parseDropFromOption+	<*> parseAutoOption+	<*> optional (parseKeyOptions False) -seek :: CommandSeek-seek ps = do-	from <- getOptionField dropFromOption Remote.byNameWithUUID-	auto <- getOptionFlag autoOption-	withKeyOptions auto-		(startKeys auto from)-		(withFilesInGit $ whenAnnexed $ start auto from)-		ps+parseDropFromOption :: Parser (DeferredParse Remote)+parseDropFromOption = parseRemoteOption $ strOption+	( long "from" <> short 'f' <> metavar paramRemote+	<> help "drop content from a remote"+	) -start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart-start auto from file key = start' auto from key (Just file)+seek :: DropOptions -> CommandSeek+seek o = withKeyOptions (keyOptions o) (autoMode o)+	(startKeys o)+	(withFilesInGit $ whenAnnexed $ start o)+	(dropFiles o) -start' :: Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart-start' auto from key afile = checkDropAuto auto from afile key $ \numcopies ->-	stopUnless want $-		case from of-			Nothing -> startLocal afile numcopies key Nothing-			Just remote -> do-				u <- getUUID-				if Remote.uuid remote == u-					then startLocal afile numcopies key Nothing-					else startRemote afile numcopies key remote-  where-	want-		| auto = wantDrop False (Remote.uuid <$> from) (Just key) afile-		| otherwise = return True+start :: DropOptions -> FilePath -> Key -> CommandStart+start o file key = start' o key (Just file) -startKeys :: Bool -> Maybe Remote -> Key -> CommandStart-startKeys auto from key = start' auto from key Nothing+start' :: DropOptions -> Key -> AssociatedFile -> CommandStart+start' o key afile = do+	from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)+	checkDropAuto (autoMode o) from afile key $ \numcopies ->+		stopUnless (want from) $+			case from of+				Nothing -> startLocal afile numcopies key Nothing+				Just remote -> do+					u <- getUUID+					if Remote.uuid remote == u+						then startLocal afile numcopies key Nothing+						else startRemote afile numcopies key remote+	  where+		want from+			| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile+			| otherwise = return True +startKeys :: DropOptions -> Key -> CommandStart+startKeys o key = start' o key Nothing+ startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do 	showStart' "drop" key afile@@ -164,10 +179,10 @@ {- In auto mode, only runs the action if there are enough  - copies on other semitrusted repositories. -} checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart-checkDropAuto auto mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile+checkDropAuto automode mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile   where 	go numcopies-		| auto = do+		| automode = do 			locs <- Remote.keyLocations key 			uuid <- getUUID 			let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote
Command/DropKey.hs view
@@ -13,11 +13,14 @@ import Logs.Location import Annex.Content -cmd :: [Command]-cmd = [noCommit $ command "dropkey" (paramRepeating paramKey) seek-	SectionPlumbing "drops annexed content for specified keys"] +cmd :: Command+cmd = noCommit $ +	command "dropkey" SectionPlumbing+		"drops annexed content for specified keys"+		(paramRepeating paramKey)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withKeys start  start :: Key -> CommandStart
Command/DropUnused.hs view
@@ -9,34 +9,42 @@  import Common.Annex import Command-import qualified Annex import qualified Command.Drop import qualified Remote import qualified Git import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Annex.NumCopies -cmd :: [Command]-cmd = [withOptions [Command.Drop.dropFromOption] $-	command "dropunused" (paramRepeating paramNumRange)-		seek SectionMaintenance "drop unused file content"]+cmd :: Command+cmd = command "dropunused" SectionMaintenance+	"drop unused file content"+	(paramRepeating paramNumRange) (seek <$$> optParser) -seek :: CommandSeek-seek ps = do+data DropUnusedOptions = DropUnusedOptions+	{ rangesToDrop :: CmdParams+	, dropFrom :: Maybe (DeferredParse Remote)+	}++optParser :: CmdParamsDesc -> Parser DropUnusedOptions+optParser desc = DropUnusedOptions+	<$> cmdParams desc+	<*> optional (Command.Drop.parseDropFromOption)++seek :: DropUnusedOptions -> CommandSeek+seek o = do 	numcopies <- getNumCopies-	withUnusedMaps (start numcopies) ps+	from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)+	withUnusedMaps (start from numcopies) (rangesToDrop o) -start :: NumCopies -> UnusedMaps -> Int -> CommandStart-start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation)+start :: Maybe Remote -> NumCopies -> UnusedMaps -> Int -> CommandStart+start from numcopies = startUnused "dropunused" (perform from numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation) -perform :: NumCopies -> Key -> CommandPerform-perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from-  where-	dropremote r = do+perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform+perform from numcopies key = case from of+	Just r -> do 		showAction $ "from " ++ Remote.name r 		Command.Drop.performRemote key Nothing numcopies r-	droplocal = Command.Drop.performLocal key Nothing numcopies Nothing-	from = Annex.getField $ optionName Command.Drop.dropFromOption+	Nothing -> Command.Drop.performLocal key Nothing numcopies Nothing  performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform performOther filespec key = do
Command/EnableRemote.hs view
@@ -15,12 +15,13 @@  import qualified Data.Map as M -cmd :: [Command]-cmd = [command "enableremote"+cmd :: Command+cmd = command "enableremote" SectionSetup+	"enables use of an existing special remote" 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)-	seek SectionSetup "enables use of an existing special remote"]+	(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/ExamineKey.hs view
@@ -11,20 +11,18 @@ import Command import CmdLine.Batch import qualified Utility.Format-import Command.Find (formatOption, getFormat, showFormatted, keyVars)+import Command.Find (parseFormatOption, showFormatted, keyVars) import Types.Key -cmd :: [Command]-cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $-	command "examinekey" (paramRepeating paramKey) seek-	SectionPlumbing "prints information from a key"]--seek :: CommandSeek-seek ps = do-	format <- getFormat-	batchable withKeys (start format) ps+cmd :: Command+cmd = noCommit $ noMessages $ withGlobalOptions [jsonOption] $+	command "examinekey" SectionPlumbing +		"prints information from a key"+		(paramRepeating paramKey)+		(batchable run (optional parseFormatOption)) -start :: Maybe Utility.Format.Format -> Batchable Key-start format _ key = do-	showFormatted format (key2file key) (keyVars key)-	stop+run :: Maybe Utility.Format.Format -> String -> Annex Bool+run format p = do+	let k = fromMaybe (error "bad key") $ file2key p+	showFormatted format (key2file k) (keyVars k)+	return True
Command/Expire.hs view
@@ -20,29 +20,40 @@ import Data.Time.Clock.POSIX import qualified Data.Map as M -cmd :: [Command]-cmd = [withOptions [activityOption, noActOption] $ command "expire" paramExpire seek-	SectionMaintenance "expire inactive repositories"]+cmd :: Command+cmd = command "expire" SectionMaintenance+	"expire inactive repositories"+	paramExpire (seek <$$> optParser)  paramExpire :: String paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime) -activityOption :: Option-activityOption = fieldOption [] "activity" "Name" "specify activity"+data ExpireOptions = ExpireOptions+	{ expireParams :: CmdParams+	, activityOption :: Maybe Activity+	, noActOption :: Bool+	} -noActOption :: Option-noActOption = flagOption [] "no-act" "don't really do anything"+optParser :: CmdParamsDesc -> Parser ExpireOptions+optParser desc = ExpireOptions+	<$> cmdParams desc+	<*> optional (option (str >>= parseActivity)+		( long "activity" <> metavar paramName+		<> help "specify activity that prevents expiry"+		))+	<*> switch+		( long "no-act"+		<> help "don't really do anything"+		) -seek :: CommandSeek-seek ps = do-	expire <- parseExpire ps-	wantact <- getOptionField activityOption (pure . parseActivity)-	noact <- getOptionFlag noActOption-	actlog <- lastActivities wantact+seek :: ExpireOptions -> CommandSeek+seek o = do+	expire <- parseExpire (expireParams o)+	actlog <- lastActivities (activityOption o) 	u <- getUUID 	us <- filter (/= u) . M.keys <$> uuidMap 	descs <- uuidMap-	seekActions $ pure $ map (start expire noact actlog descs) us+	seekActions $ pure $ map (start expire (noActOption o) actlog descs) us  start :: Expire -> Bool -> Log Activity -> M.Map UUID String -> UUID -> CommandStart start (Expire expire) noact actlog descs u =@@ -97,10 +108,9 @@ 		Nothing -> error $ "bad expire time: " ++ s 		Just d -> Just (now - durationToPOSIXTime d) -parseActivity :: Maybe String -> Maybe Activity-parseActivity Nothing = Nothing-parseActivity (Just s) = case readish s of-	Nothing -> error $ "Unknown activity. Choose from: " ++ +parseActivity :: Monad m => String -> m Activity+parseActivity s = case readish s of+	Nothing -> fail $ "Unknown activity. Choose from: " ++  		unwords (map show [minBound..maxBound :: Activity])-	Just v -> Just v+	Just v -> return v
Command/Find.hs view
@@ -14,41 +14,48 @@ import Command import Annex.Content import Limit-import qualified Annex import qualified Utility.Format import Utility.DataUnits import Types.Key -cmd :: [Command]-cmd = [withOptions annexedMatchingOptions $ mkCommand $-	command "find" paramPaths seek SectionQuery "lists available files"]+cmd :: Command+cmd = withGlobalOptions annexedMatchingOptions $ mkCommand $+	command "find" SectionQuery "lists available files"+		paramPaths (seek <$$> optParser)  mkCommand :: Command -> Command-mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption]+mkCommand = noCommit . noMessages . withGlobalOptions [jsonOption] -formatOption :: Option-formatOption = fieldOption [] "format" paramFormat "control format of output"+data FindOptions = FindOptions+	{ findThese :: CmdParams+	, formatOption :: Maybe Utility.Format.Format+	} -getFormat :: Annex (Maybe Utility.Format.Format)-getFormat = getOptionField formatOption $ return . fmap Utility.Format.gen+optParser :: CmdParamsDesc -> Parser FindOptions+optParser desc = FindOptions+	<$> cmdParams desc+	<*> optional parseFormatOption -print0Option :: Option-print0Option = Option [] ["print0"] (NoArg set)-	"terminate output with null"-  where-	set = Annex.setField (optionName formatOption) "${file}\0"+parseFormatOption :: Parser Utility.Format.Format+parseFormatOption = +	option (Utility.Format.gen <$> str)+		( long "format" <> metavar paramFormat+		<> help "control format of output"+		)+	<|> flag' (Utility.Format.gen "${file}\0")+		( long "print0"+		<> help "output filenames terminated with nulls"+		) -seek :: CommandSeek-seek ps = do-	format <- getFormat-	withFilesInGit (whenAnnexed $ start format) ps+seek :: FindOptions -> CommandSeek+seek o = withFilesInGit (whenAnnexed $ start o) (findThese o) -start :: Maybe Utility.Format.Format -> FilePath -> Key -> CommandStart-start format file key = do+start :: FindOptions -> FilePath -> Key -> CommandStart+start o file key = do 	-- only files inAnnex are shown, unless the user has requested 	-- others via a limit 	whenM (limited <||> inAnnex key) $-		showFormatted format file $ ("file", file) : keyVars key+		showFormatted (formatOption o) file $ ("file", file) : keyVars key 	stop  showFormatted :: Maybe Utility.Format.Format -> String -> [(String, String)] -> Annex ()
Command/FindRef.hs view
@@ -7,15 +7,15 @@  module Command.FindRef where +import Common.Annex import Command import qualified Command.Find as Find -cmd :: [Command]-cmd = [withOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ -	command "findref" paramRef seek SectionPlumbing-		"lists files in a git ref"]+cmd :: Command+cmd = withGlobalOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ +	command "findref" SectionPlumbing+		"lists files in a git ref"+		paramRef (seek <$$> Find.optParser) -seek :: CommandSeek-seek refs = do-	format <- Find.getFormat-	Find.start format `withFilesInRefs` refs+seek :: Find.FindOptions -> CommandSeek+seek o = Find.start o `withFilesInRefs` Find.findThese o
Command/Fix.hs view
@@ -18,12 +18,13 @@ #endif #endif -cmd :: [Command]-cmd = [notDirect $ noCommit $ withOptions annexedMatchingOptions $-	command "fix" paramPaths seek-		SectionMaintenance "fix up symlinks to point to annexed content"]+cmd :: Command+cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $+	command "fix" SectionMaintenance+		"fix up symlinks to point to annexed content"+		paramPaths (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withFilesInGit $ whenAnnexed start  {- Fixes the symlink to an annexed file. -}
Command/Forget.hs view
@@ -15,27 +15,31 @@  import Data.Time.Clock.POSIX -cmd :: [Command]-cmd = [withOptions forgetOptions $ command "forget" paramNothing seek-		SectionMaintenance "prune git-annex branch history"]+cmd :: Command+cmd = command "forget" SectionMaintenance +	"prune git-annex branch history"+	paramNothing (seek <$$> optParser) -forgetOptions :: [Option]-forgetOptions = [dropDeadOption]+data ForgetOptions = ForgetOptions+	{ dropDead :: Bool+	} -dropDeadOption :: Option-dropDeadOption = flagOption [] "drop-dead" "drop references to dead repositories"+optParser :: CmdParamsDesc -> Parser ForgetOptions+optParser _ = ForgetOptions+	<$> switch+		( long "drop-dead"+		<> help "drop references to dead repositories"+		) -seek :: CommandSeek-seek ps = do-	dropdead <- getOptionFlag dropDeadOption-	withNothing (start dropdead) ps+seek :: ForgetOptions -> CommandSeek+seek = commandAction . start -start :: Bool -> CommandStart-start dropdead = do+start :: ForgetOptions -> CommandStart+start o = do 	showStart "forget" "git-annex" 	now <- liftIO getPOSIXTime 	let basets = addTransition now ForgetGitHistory noTransitions-	let ts = if dropdead+	let ts = if dropDead o 		then addTransition now ForgetDeadRemotes basets 		else basets 	next $ perform ts =<< Annex.getState Annex.force
Command/FromKey.hs view
@@ -19,12 +19,13 @@  import Network.URI -cmd :: [Command]-cmd = [notDirect $ notBareRepo $-	command "fromkey" (paramPair paramKey paramPath) seek-		SectionPlumbing "adds a file using a specific key"]+cmd :: Command+cmd = notDirect $ notBareRepo $+	command "fromkey" SectionPlumbing "adds a file using a specific key"+		(paramPair paramKey paramPath)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek ps = do 	force <- Annex.getState Annex.force 	withWords (start force) ps
Command/Fsck.hs view
@@ -30,51 +30,71 @@ import Utility.DataUnits import Config import Types.Key-import Types.CleanupActions import Utility.HumanTime import Utility.CopyFile import Git.FilePath import Utility.PID++#ifdef WITH_DATABASE import qualified Database.Fsck as FsckDb+import Types.CleanupActions+#endif  import Data.Time.Clock.POSIX import System.Posix.Types (EpochTime) -cmd :: [Command]-cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek-	SectionMaintenance "check for problems"]--fsckFromOption :: Option-fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote"--startIncrementalOption :: Option-startIncrementalOption = flagOption ['S'] "incremental" "start an incremental fsck"+cmd :: Command+cmd = withGlobalOptions annexedMatchingOptions $+	command "fsck" SectionMaintenance+		"find and fix problems"+		paramPaths (seek <$$> optParser) -moreIncrementalOption :: Option-moreIncrementalOption = flagOption ['m'] "more" "continue an incremental fsck"+data FsckOptions = FsckOptions+	{ fsckFiles :: CmdParams+	, fsckFromOption :: Maybe (DeferredParse Remote)+	, incrementalOpt :: Maybe IncrementalOpt+	, keyOptions :: Maybe KeyOptions+	} -incrementalScheduleOption :: Option-incrementalScheduleOption = fieldOption [] "incremental-schedule" paramTime-	"schedule incremental fscking"+data IncrementalOpt+	= StartIncrementalO+	| MoreIncrementalO+	| ScheduleIncrementalO Duration -fsckOptions :: [Option]-fsckOptions = -	[ fsckFromOption-	, startIncrementalOption-	, moreIncrementalOption-	, incrementalScheduleOption-	] ++ keyOptions ++ annexedMatchingOptions+optParser :: CmdParamsDesc -> Parser FsckOptions+optParser desc = FsckOptions+	<$> cmdParams desc+	<*> optional (parseRemoteOption $ strOption +		( long "from" <> short 'f' <> metavar paramRemote +		<> help "check remote"+		))+	<*> optional parseincremental+	<*> optional (parseKeyOptions False)+  where+	parseincremental =+		flag' StartIncrementalO+			( long "incremental" <> short 'S'+			<> help "start an incremental fsck"+			)+		<|> flag' MoreIncrementalO+			( long "more" <> short 'm'+			<> help "continue an incremental fsck"+			)+		<|> (ScheduleIncrementalO <$> option (str >>= parseDuration)+			( long "incremental-schedule" <> metavar paramTime+			<> help "schedule incremental fscking"+			)) -seek :: CommandSeek-seek ps = do-	from <- getOptionField fsckFromOption Remote.byNameWithUUID+seek :: FsckOptions -> CommandSeek+seek o = do+	from <- maybe (pure Nothing) (Just <$$> getParsed) (fsckFromOption o) 	u <- maybe getUUID (pure . Remote.uuid) from-	i <- getIncremental u-	withKeyOptions False+	i <- prepIncremental u (incrementalOpt o)+	withKeyOptions (keyOptions o) False 		(\k -> startKey i k =<< getNumCopies) 		(withFilesInGit $ whenAnnexed $ start from i)-		ps-	withFsckDb i FsckDb.closeDb+		(fsckFiles o)+	cleanupIncremental i 	void $ tryIO $ recordActivity Fsck u  start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart@@ -437,16 +457,24 @@  {- Check if a key needs to be fscked, with support for incremental fscks. -} needFsck :: Incremental -> Key -> Annex Bool+#ifdef WITH_DATABASE needFsck (ContIncremental h) key = liftIO $ not <$> FsckDb.inDb h key+#endif needFsck _ _ = return True +#ifdef WITH_DATABASE withFsckDb :: Incremental -> (FsckDb.FsckHandle -> Annex ()) -> Annex () withFsckDb (ContIncremental h) a = a h withFsckDb (StartIncremental h) a = a h withFsckDb NonIncremental _ = noop+#endif  recordFsckTime :: Incremental -> Key -> Annex ()+#ifdef WITH_DATABASE recordFsckTime inc key = withFsckDb inc $ \h -> liftIO $ FsckDb.addDb h key+#else+recordFsckTime _ _ = return ()+#endif  {- Records the start time of an incremental fsck.  -@@ -495,39 +523,44 @@ 		fromfile >= fromstatus #endif -data Incremental = StartIncremental FsckDb.FsckHandle | ContIncremental FsckDb.FsckHandle | NonIncremental+data Incremental+	= NonIncremental+#ifdef WITH_DATABASE+	| StartIncremental FsckDb.FsckHandle +	| ContIncremental FsckDb.FsckHandle +#endif -getIncremental :: UUID -> Annex Incremental-getIncremental u = do-	i <- maybe (return False) (checkschedule . parseDuration)-		=<< Annex.getField (optionName incrementalScheduleOption)-	starti <- getOptionFlag startIncrementalOption-	morei <- getOptionFlag moreIncrementalOption-	case (i, starti, morei) of-		(False, False, False) -> return NonIncremental-		(False, True, False) -> startIncremental-		(False ,False, True) -> contIncremental-		(True, False, False) ->-			maybe startIncremental (const contIncremental)-				=<< getStartTime u-		_ -> error "Specify only one of --incremental, --more, or --incremental-schedule"-  where-	startIncremental = do-		recordStartTime u-		ifM (FsckDb.newPass u)-			( StartIncremental <$> FsckDb.openDb u-			, error "Cannot start a new --incremental fsck pass; another fsck process is already running."-			)-	contIncremental = ContIncremental <$> FsckDb.openDb u+prepIncremental :: UUID -> Maybe IncrementalOpt -> Annex Incremental+prepIncremental _ Nothing = pure NonIncremental+#ifdef WITH_DATABASE+prepIncremental u (Just StartIncrementalO) = do+	recordStartTime u+	ifM (FsckDb.newPass u)+		( StartIncremental <$> FsckDb.openDb u+		, error "Cannot start a new --incremental fsck pass; another fsck process is already running."+		)+prepIncremental u (Just MoreIncrementalO) =+	ContIncremental <$> FsckDb.openDb u+prepIncremental u (Just (ScheduleIncrementalO delta)) = do+	Annex.addCleanup FsckCleanup $ do+		v <- getStartTime u+		case v of+			Nothing -> noop+			Just started -> do+				now <- liftIO getPOSIXTime+				when (now - realToFrac started >= durationToPOSIXTime delta) $+					resetStartTime u+	started <- getStartTime u+	prepIncremental u $ Just $ case started of+		Nothing -> StartIncrementalO+		Just _ -> MoreIncrementalO+#else+prepIncremental _ _ = error "This git-annex was not built with database support; incremental fsck not supported"+#endif -	checkschedule Nothing = error "bad --incremental-schedule value"-	checkschedule (Just delta) = do-		Annex.addCleanup FsckCleanup $ do-			v <- getStartTime u-			case v of-				Nothing -> noop-				Just started -> do-					now <- liftIO getPOSIXTime-					when (now - realToFrac started >= durationToPOSIXTime delta) $-						resetStartTime u-		return True+cleanupIncremental :: Incremental -> Annex ()+#ifdef WITH_DATABASE+cleanupIncremental i = withFsckDb i FsckDb.closeDb+#else+cleanupIncremental _ = return ()+#endif
Command/FuzzTest.hs view
@@ -20,11 +20,13 @@ import Test.QuickCheck import Control.Concurrent -cmd :: [Command]-cmd = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting-	"generates fuzz test files"]+cmd :: Command+cmd = notBareRepo $+	command "fuzztest" SectionTesting+		"generates fuzz test files"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart@@ -53,9 +55,9 @@  fuzz :: Handle -> Annex () fuzz logh = do-	action <- genFuzzAction-	record logh $ flip Started action-	result <- tryNonAsync $ runFuzzAction action+	fuzzer <- genFuzzAction+	record logh $ flip Started fuzzer+	result <- tryNonAsync $ runFuzzAction fuzzer 	record logh $ flip Finished $ 		either (const False) (const True) result
Command/GCryptSetup.hs view
@@ -13,12 +13,13 @@ import qualified Remote.GCrypt import qualified Git -cmd :: [Command]-cmd = [dontCheck repoExists $ noCommit $-	command "gcryptsetup" paramValue seek-		SectionPlumbing "sets up gcrypt repository"]+cmd :: Command+cmd = dontCheck repoExists $ noCommit $+	command "gcryptsetup" SectionPlumbing +		"sets up gcrypt repository"+		paramValue (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withStrings start  start :: String -> CommandStart
Command/Get.hs view
@@ -16,28 +16,39 @@ import Annex.Wanted import qualified Command.Move -cmd :: [Command]-cmd = [withOptions getOptions $ command "get" paramPaths seek-	SectionCommon "make content of annexed files available"]+cmd :: Command+cmd = withGlobalOptions (jobsOption : annexedMatchingOptions) $ +	command "get" SectionCommon +		"make content of annexed files available"+		paramPaths (seek <$$> optParser) -getOptions :: [Option]-getOptions = fromOption : autoOption : jobsOption : annexedMatchingOptions-	++ incompleteOption : keyOptions+data GetOptions = GetOptions+	{ getFiles :: CmdParams+	, getFrom :: Maybe (DeferredParse Remote)+	, autoMode :: Bool+	, keyOptions :: Maybe KeyOptions+	} -seek :: CommandSeek-seek ps = do-	from <- getOptionField fromOption Remote.byNameWithUUID-	auto <- getOptionFlag autoOption-	withKeyOptions auto+optParser :: CmdParamsDesc -> Parser GetOptions+optParser desc = GetOptions+	<$> cmdParams desc+	<*> optional parseFromOption+	<*> parseAutoOption+	<*> optional (parseKeyOptions True)++seek :: GetOptions -> CommandSeek+seek o = do+	from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)+	withKeyOptions (keyOptions o) (autoMode o) 		(startKeys from)-		(withFilesInGit $ whenAnnexed $ start auto from)-		ps+		(withFilesInGit $ whenAnnexed $ start o from)+		(getFiles o) -start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart-start auto from file key = start' expensivecheck from key (Just file)+start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart+start o from file key = start' expensivecheck from key (Just file)   where 	expensivecheck-		| auto = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)+		| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file) 		| otherwise = return True  startKeys :: Maybe Remote -> Key -> CommandStart
Command/Group.hs view
@@ -15,11 +15,11 @@  import qualified Data.Set as S -cmd :: [Command]-cmd = [command "group" (paramPair paramRemote paramDesc) seek-	SectionSetup "add a repository to a group"]+cmd :: Command+cmd = command "group" SectionSetup "add a repository to a group"+	(paramPair paramRemote paramDesc) (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/GroupWanted.hs view
@@ -12,11 +12,13 @@ import Logs.PreferredContent import Command.Wanted (performGet, performSet) -cmd :: [Command]-cmd = [command "groupwanted" (paramPair paramGroup (paramOptional paramExpression)) seek-	SectionSetup "get or set groupwanted expression"]+cmd :: Command+cmd = command "groupwanted" SectionSetup +	"get or set groupwanted expression"+	(paramPair paramGroup (paramOptional paramExpression))+	(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Help.hs view
@@ -19,13 +19,15 @@ import qualified Command.Whereis import qualified Command.Fsck -import System.Console.GetOpt--cmd :: [Command]-cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $-	command "help" (paramOptional "COMMAND") seek SectionCommon "display help"]+cmd :: Command+cmd = noCommit $ dontCheck repoExists $+	noRepo (parseparams startNoRepo) $ +		command "help" SectionCommon "display help"+			"COMMAND" (parseparams seek)+  where+	parseparams = withParams -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart@@ -37,17 +39,13 @@ startNoRepo = start'  start' :: [String] -> IO ()-start' ["options"] = showCommonOptions start' [c] = showGitHelp c start' _ = showGeneralHelp -showCommonOptions :: IO ()-showCommonOptions = putStrLn $ usageInfo "Common options:" gitAnnexOptions- showGeneralHelp :: IO () showGeneralHelp = putStrLn $ unlines 	[ "The most frequently used git-annex commands are:"-	, unlines $ map cmdline $ concat+	, unlines $ map cmdline $ 		[ Command.Init.cmd 		, Command.Add.cmd 		, Command.Drop.cmd@@ -58,9 +56,8 @@ 		, Command.Whereis.cmd 		, Command.Fsck.cmd 		]-	, "Run 'git-annex' for a complete command list."-	, "Run 'git-annex help command' for help on a specific command."-	, "Run `git annex help options' for a list of common options."+	, "For a complete command list, run: git-annex"+	, "For help on a specific command, run: git-annex help COMMAND" 	]   where 	cmdline c = "\t" ++ cmdname c ++ "\t" ++ cmddesc c
Command/Import.hs view
@@ -22,52 +22,51 @@ import Types.TrustLevel import Logs.Trust -cmd :: [Command]-cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek-	SectionCommon "move and add files from outside git working copy"]--opts :: [Option]-opts = duplicateModeOptions ++ fileMatchingOptions+cmd :: Command+cmd = withGlobalOptions fileMatchingOptions $ notBareRepo $+	command "import" SectionCommon +		"move and add files from outside git working copy"+		paramPaths (seek <$$> optParser)  data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates-	deriving (Eq, Enum, Bounded)+	deriving (Eq) -associatedOption :: DuplicateMode -> Maybe Option-associatedOption Default = Nothing-associatedOption Duplicate = Just $-	flagOption [] "duplicate" "do not delete source files"-associatedOption DeDuplicate = Just $-	flagOption [] "deduplicate" "delete source files whose content was imported before"-associatedOption CleanDuplicates = Just $-	flagOption [] "clean-duplicates" "delete duplicate source files (import nothing)"-associatedOption SkipDuplicates = Just $-	flagOption [] "skip-duplicates" "import only new files"+data ImportOptions = ImportOptions+	{ importFiles :: CmdParams+	, duplicateMode :: DuplicateMode+	} -duplicateModeOptions :: [Option]-duplicateModeOptions = mapMaybe associatedOption [minBound..maxBound]+optParser :: CmdParamsDesc -> Parser ImportOptions+optParser desc = ImportOptions+	<$> cmdParams desc+	<*> (fromMaybe Default <$> optional duplicateModeParser) -getDuplicateMode :: Annex DuplicateMode-getDuplicateMode = go . catMaybes <$> mapM getflag [minBound..maxBound]-  where-	getflag m = case associatedOption m of-		Nothing -> return Nothing-		Just o -> ifM (Annex.getFlag (optionName o))-			( return (Just m)-			, return Nothing-			)-	go [] = Default-	go [m] = m-	go ms = error $ "cannot combine " ++-		unwords (map (optionParam . fromJust . associatedOption) ms)+duplicateModeParser :: Parser DuplicateMode+duplicateModeParser = +	flag' Duplicate+		( long "duplicate" +		<> help "do not delete source files"+		)+	<|> flag' DeDuplicate+		( long "deduplicate"+		<> help "delete source files whose content was imported before"+		)+	<|> flag' CleanDuplicates+		( long "clean-duplicates"+		<> help "delete duplicate source files (import nothing)"+		)+	<|> flag' SkipDuplicates+		( long "skip-duplicates"+		<> help "import only new files"+		) -seek :: CommandSeek-seek ps = do-	mode <- getDuplicateMode+seek :: ImportOptions -> CommandSeek+seek o = do 	repopath <- liftIO . absPath =<< fromRepo Git.repoPath-	inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath ps+	inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath (importFiles o) 	unless (null inrepops) $ do 		error $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops-	withPathContents (start mode) ps+	withPathContents (start (duplicateMode o)) (importFiles o)  start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart start mode (srcfile, destfile) =
Command/ImportFeed.hs view
@@ -30,7 +30,7 @@ import Logs.Web import qualified Utility.Format import Utility.Tmp-import Command.AddUrl (addUrlFile, downloadRemoteFile, relaxedOption, rawOption)+import Command.AddUrl (addUrlFile, downloadRemoteFile, parseRelaxedOption, parseRawOption) import Annex.Perms import Annex.UUID import Backend.URL (fromUrl)@@ -43,34 +43,39 @@ import Logs.MetaData import Annex.MetaData -cmd :: [Command]-cmd = [notBareRepo $ withOptions [templateOption, relaxedOption, rawOption] $-	command "importfeed" (paramRepeating paramUrl) seek-		SectionCommon "import files from podcast feeds"]+cmd :: Command+cmd = notBareRepo $+	command "importfeed" SectionCommon "import files from podcast feeds"+		(paramRepeating paramUrl) (seek <$$> optParser) -templateOption :: Option-templateOption = fieldOption [] "template" paramFormat "template for filenames"+data ImportFeedOptions = ImportFeedOptions+	{ feedUrls :: CmdParams+	, templateOption :: Maybe String+	, relaxedOption :: Bool+	, rawOption :: Bool+	} -seek :: CommandSeek-seek ps = do-	tmpl <- getOptionField templateOption return-	relaxed <- getOptionFlag relaxedOption-	raw <- getOptionFlag rawOption-	let opts = Opts { relaxedOpt = relaxed, rawOpt = raw }-	cache <- getCache tmpl-	withStrings (start opts cache) ps+optParser :: CmdParamsDesc -> Parser ImportFeedOptions+optParser desc = ImportFeedOptions+	<$> cmdParams desc+	<*> optional (strOption+		( long "template" <> metavar paramFormat+		<> help "template for filenames"+		))+	<*> parseRelaxedOption+	<*> parseRawOption -data Opts = Opts-	{ relaxedOpt :: Bool-	, rawOpt :: Bool-	}+seek :: ImportFeedOptions -> CommandSeek+seek o = do+	cache <- getCache (templateOption o)+	withStrings (start o cache) (feedUrls o) -start :: Opts -> Cache -> URLString -> CommandStart+start :: ImportFeedOptions -> Cache -> URLString -> CommandStart start opts cache url = do 	showStart "importfeed" url 	next $ perform opts cache url -perform :: Opts -> Cache -> URLString -> CommandPerform+perform :: ImportFeedOptions -> Cache -> URLString -> CommandPerform perform opts cache url = do 	v <- findDownloads url 	case v of@@ -160,15 +165,15 @@ 				, return Nothing 				) -performDownload :: Opts -> Cache -> ToDownload -> Annex Bool+performDownload :: ImportFeedOptions -> Cache -> ToDownload -> Annex Bool performDownload opts cache todownload = case location todownload of 	Enclosure url -> checkknown url $ 		rundownload url (takeExtension url) $ \f -> do 			r <- Remote.claimingUrl url-			if Remote.uuid r == webUUID || rawOpt opts+			if Remote.uuid r == webUUID || rawOption opts 				then do 					urlinfo <- Url.withUrlOptions (Url.getUrlInfo url)-					maybeToList <$> addUrlFile (relaxedOpt opts) url urlinfo f+					maybeToList <$> addUrlFile (relaxedOption opts) url urlinfo f 				else do 					res <- tryNonAsync $ maybe 						(error $ "unable to checkUrl of " ++ Remote.name r)@@ -178,10 +183,10 @@ 						Left _ -> return [] 						Right (UrlContents sz _) -> 							maybeToList <$>-								downloadRemoteFile r (relaxedOpt opts) url f sz+								downloadRemoteFile r (relaxedOption opts) url f sz 						Right (UrlMulti l) -> do 							kl <- forM l $ \(url', sz, subf) ->-								downloadRemoteFile r (relaxedOpt opts) url' (f </> fromSafeFilePath subf) sz+								downloadRemoteFile r (relaxedOption opts) url' (f </> fromSafeFilePath subf) sz 							return $ if all isJust kl 								then catMaybes kl 								else []@@ -199,7 +204,7 @@ 						let videourl = Quvi.linkUrl link 						checkknown videourl $ 							rundownload videourl ("." ++ fromMaybe "m" (Quvi.linkSuffix link)) $ \f ->-								maybeToList <$> addUrlFileQuvi (relaxedOpt opts) quviurl videourl f+								maybeToList <$> addUrlFileQuvi (relaxedOption opts) quviurl videourl f #else 		return False #endif@@ -214,8 +219,7 @@ 		| otherwise = a  	knownitemid = case getItemId (item todownload) of-		-- only when it's a permalink-		Just (True, itemid) -> S.member itemid (knownitems cache)+		Just (_, itemid) -> S.member itemid (knownitems cache) 		_ -> False  	rundownload url extension getter = do
Command/InAnnex.hs view
@@ -11,11 +11,14 @@ import Command import Annex.Content -cmd :: [Command]-cmd = [noCommit $ command "inannex" (paramRepeating paramKey) seek-	SectionPlumbing "checks if keys are present in the annex"]+cmd :: Command+cmd = noCommit $ +	command "inannex" SectionPlumbing +		"checks if keys are present in the annex"+		(paramRepeating paramKey)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withKeys start  start :: Key -> CommandStart
Command/Indirect.hs view
@@ -22,12 +22,12 @@ import Annex.Init import qualified Command.Add -cmd :: [Command]-cmd = [notBareRepo $ noDaemonRunning $-	command "indirect" paramNothing seek-		SectionSetup "switch repository to indirect mode"]+cmd :: Command+cmd = notBareRepo $ noDaemonRunning $+	command "indirect" SectionSetup "switch repository to indirect mode"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/Info.hs view
@@ -70,79 +70,94 @@ 	, referencedData :: Maybe KeyData 	, repoData :: M.Map UUID KeyData 	, numCopiesStats :: Maybe NumCopiesStats+	, infoOptions :: InfoOptions 	} -emptyStatInfo :: StatInfo+emptyStatInfo :: InfoOptions -> StatInfo emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing  -- a state monad for running Stats in type StatState = StateT StatInfo Annex -cmd :: [Command]-cmd = [noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $-	command "info" (paramOptional $ paramRepeating paramItem) seek SectionQuery-	"shows information about the specified item or the repository as a whole"]+cmd :: Command+cmd = noCommit $ dontCheck repoExists $ withGlobalOptions (jsonOption : annexedMatchingOptions) $+	command "info" SectionQuery+		"shows  information about the specified item or the repository as a whole"+		(paramRepeating paramItem) (seek <$$> optParser) -seek :: CommandSeek-seek = withWords start+data InfoOptions = InfoOptions+	{ infoFor :: CmdParams+	, bytesOption :: Bool+	} -start :: [String] -> CommandStart-start [] = do-	globalInfo+optParser :: CmdParamsDesc -> Parser InfoOptions+optParser desc = InfoOptions+	<$> cmdParams desc+	<*> switch+		( long "bytes"+		<> help "display file sizes in bytes"+		)++seek :: InfoOptions -> CommandSeek+seek o = withWords (start o) (infoFor o)++start :: InfoOptions -> [String] -> CommandStart+start o [] = do+	globalInfo o 	stop-start ps = do-	mapM_ itemInfo ps+start o ps = do+	mapM_ (itemInfo o) ps 	stop -globalInfo :: Annex ()-globalInfo = do+globalInfo :: InfoOptions -> Annex ()+globalInfo o = do 	stats <- selStats global_fast_stats global_slow_stats 	showCustom "info" $ do-		evalStateT (mapM_ showStat stats) emptyStatInfo+		evalStateT (mapM_ showStat stats) (emptyStatInfo o) 		return True -itemInfo :: String -> Annex ()-itemInfo p = ifM (isdir p)-	( dirInfo p+itemInfo :: InfoOptions -> String -> Annex ()+itemInfo o p = ifM (isdir p)+	( dirInfo o p 	, do 		v <- Remote.byName' p 		case v of-			Right r -> remoteInfo r+			Right r -> remoteInfo o r 			Left _ -> do 				v' <- Remote.nameToUUID' p 				case v' of-					Right u -> uuidInfo u-					Left _ -> maybe noinfo (fileInfo p)+					Right u -> uuidInfo o u+					Left _ -> maybe noinfo (fileInfo o p) 						=<< isAnnexLink p 	)   where 	isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) 	noinfo = error $ p ++ " is not a directory or an annexed file or a remote or a uuid" -dirInfo :: FilePath -> Annex ()-dirInfo dir = showCustom (unwords ["info", dir]) $ do+dirInfo :: InfoOptions -> FilePath -> Annex ()+dirInfo o dir = showCustom (unwords ["info", dir]) $ do 	stats <- selStats (tostats dir_fast_stats) (tostats dir_slow_stats)-	evalStateT (mapM_ showStat stats) =<< getDirStatInfo dir+	evalStateT (mapM_ showStat stats) =<< getDirStatInfo o dir 	return True   where 	tostats = map (\s -> s dir) -fileInfo :: FilePath -> Key -> Annex ()-fileInfo file k = showCustom (unwords ["info", file]) $ do-	evalStateT (mapM_ showStat (file_stats file k)) emptyStatInfo+fileInfo :: InfoOptions -> FilePath -> Key -> Annex ()+fileInfo o file k = showCustom (unwords ["info", file]) $ do+	evalStateT (mapM_ showStat (file_stats file k)) (emptyStatInfo o) 	return True -remoteInfo :: Remote -> Annex ()-remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do-	info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r-	l <- selStats (remote_fast_stats r ++ info) (uuid_slow_stats (Remote.uuid r))-	evalStateT (mapM_ showStat l) emptyStatInfo+remoteInfo :: InfoOptions -> Remote -> Annex ()+remoteInfo o r = showCustom (unwords ["info", Remote.name r]) $ do+	i <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r+	l <- selStats (remote_fast_stats r ++ i) (uuid_slow_stats (Remote.uuid r))+	evalStateT (mapM_ showStat l) (emptyStatInfo o) 	return True -uuidInfo :: UUID -> Annex ()-uuidInfo u = showCustom (unwords ["info", fromUUID u]) $ do+uuidInfo :: InfoOptions -> UUID -> Annex ()+uuidInfo o u = showCustom (unwords ["info", fromUUID u]) $ do 	l <- selStats [] ((uuid_slow_stats u))-	evalStateT (mapM_ showStat l) emptyStatInfo+	evalStateT (mapM_ showStat l) (emptyStatInfo o) 	return True  selStats :: [Stat] -> [Stat] -> Annex [Stat]@@ -298,7 +313,7 @@  local_annex_size :: Stat local_annex_size = simpleStat "local annex size" $-	lift . showSizeKeys =<< cachedPresentData+	showSizeKeys =<< cachedPresentData  remote_annex_keys :: UUID -> Stat remote_annex_keys u = stat "remote annex keys" $ json show $@@ -306,7 +321,7 @@  remote_annex_size :: UUID -> Stat remote_annex_size u = simpleStat "remote annex size" $-	lift . showSizeKeys =<< cachedRemoteData u+	showSizeKeys =<< cachedRemoteData u  known_annex_files :: Stat known_annex_files = stat "annexed files in working tree" $ json show $@@ -314,7 +329,7 @@  known_annex_size :: Stat known_annex_size = simpleStat "size of annexed files in working tree" $-	lift . showSizeKeys =<< cachedReferencedData+	showSizeKeys =<< cachedReferencedData  tmp_size :: Stat tmp_size = staleSize "temporary object directory size" gitAnnexTmpObjectDir@@ -323,7 +338,7 @@ bad_data_size = staleSize "bad keys size" gitAnnexBadDir  key_size :: Key -> Stat-key_size k = simpleStat "size" $ lift $ showSizeKeys $ foldKeys [k]+key_size k = simpleStat "size" $ showSizeKeys $ foldKeys [k]  key_name :: Key -> Stat key_name k = simpleStat "key" $ pure $ key2file k@@ -339,7 +354,7 @@  	-- Two bloom filters are used at the same time when running 	-- git-annex unused, so double the size of one.-	sizer <- lift mkSizer+	sizer <- mkSizer 	size <- sizer memoryUnits False . (* 2) . fromIntegral . fst <$> 		lift bloomBitsHashes @@ -371,10 +386,10 @@ 		]  disk_size :: Stat-disk_size = simpleStat "available local disk space" $ lift $+disk_size = simpleStat "available local disk space" $ 	calcfree-		<$> (annexDiskReserve <$> Annex.getGitConfig)-		<*> inRepo (getDiskFree . gitAnnexDir)+		<$> (lift $ annexDiskReserve <$> Annex.getGitConfig)+		<*> (lift $ inRepo $ getDiskFree . gitAnnexDir) 		<*> mkSizer   where 	calcfree reserve (Just have) sizer = unwords@@ -408,7 +423,7 @@  reposizes_stats :: Stat reposizes_stats = stat desc $ nojson $ do-	sizer <- lift mkSizer+	sizer <- mkSizer 	l <- map (\(u, kd) -> (u, sizer storageUnits True (sizeKeys kd))) 		. sortBy (flip (comparing (sizeKeys . snd))) 		. M.toList@@ -465,14 +480,14 @@ cachedRepoData :: StatState (M.Map UUID KeyData) cachedRepoData = repoData <$> get -getDirStatInfo :: FilePath -> Annex StatInfo-getDirStatInfo dir = do+getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo+getDirStatInfo o dir = do 	fast <- Annex.getState Annex.fast 	matcher <- Limit.getMatcher 	(presentdata, referenceddata, numcopiesstats, repodata) <- 		Command.Unused.withKeysFilesReferencedIn dir initial 			(update matcher fast)-	return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats)+	return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats) o   where 	initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats, M.empty) 	update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) =@@ -529,7 +544,7 @@ 	let !ret = NumCopiesStats m' 	return ret -showSizeKeys :: KeyData -> Annex String+showSizeKeys :: KeyData -> StatState String showSizeKeys d = do 	sizer <- mkSizer 	return $ total sizer ++ missingnote@@ -549,7 +564,7 @@ 	onsize 0 = nostat 	onsize size = stat label $ 		json (++ aside "clean up with git-annex unused") $ do-			sizer <- lift mkSizer+			sizer <- mkSizer 			return $ sizer storageUnits False size 	keysizes keys = do 		dir <- lift $ fromRepo dirspec@@ -562,11 +577,8 @@ multiLine :: [String] -> String multiLine = concatMap (\l -> "\n\t" ++ l) -mkSizer :: Annex ([Unit] -> Bool -> ByteSize -> String)-mkSizer = ifM (getOptionFlag bytesOption)+mkSizer :: StatState ([Unit] -> Bool -> ByteSize -> String)+mkSizer = ifM (bytesOption . infoOptions <$> get) 	( return (const $ const show) 	, return roughSize 	)--bytesOption :: Option-bytesOption = flagOption [] "bytes" "display file sizes in bytes"
Command/Init.hs view
@@ -11,11 +11,12 @@ import Command import Annex.Init 	-cmd :: [Command]-cmd = [dontCheck repoExists $-	command "init" paramDesc seek SectionSetup "initialize git-annex"]+cmd :: Command+cmd = dontCheck repoExists $+	command "init" SectionSetup "initialize git-annex"+		paramDesc (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/InitRemote.hs view
@@ -19,12 +19,13 @@  import Data.Ord -cmd :: [Command]-cmd = [command "initremote"+cmd :: Command+cmd = command "initremote" SectionSetup+	"creates a special (non-git) remote" 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)-	seek SectionSetup "creates a special (non-git) remote"]+	(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/List.hs view
@@ -20,28 +20,37 @@ import Logs.Trust import Logs.UUID import Annex.UUID-import qualified Annex import Git.Types (RemoteName) -cmd :: [Command]-cmd = [noCommit $ withOptions (allrepos : annexedMatchingOptions) $-	command "list" paramPaths seek-		SectionQuery "show which remotes contain files"]+cmd :: Command+cmd = noCommit $ withGlobalOptions annexedMatchingOptions $+	command "list" SectionQuery +		"show which remotes contain files"+		paramPaths (seek <$$> optParser) -allrepos :: Option-allrepos = flagOption [] "allrepos" "show all repositories, not only remotes"+data ListOptions = ListOptions+	{ listThese :: CmdParams+	, allRepos :: Bool+	} -seek :: CommandSeek-seek ps = do-	list <- getList+optParser :: CmdParamsDesc -> Parser ListOptions+optParser desc = ListOptions+	<$> cmdParams desc+	<*> switch+		( long "allrepos"+		<> help "show all repositories, not only remotes"+		)++seek :: ListOptions -> CommandSeek+seek o = do+	list <- getList o 	printHeader list-	withFilesInGit (whenAnnexed $ start list) ps+	withFilesInGit (whenAnnexed $ start list) (listThese o) -getList :: Annex [(UUID, RemoteName, TrustLevel)]-getList = ifM (Annex.getFlag $ optionName allrepos)-	( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)-	, getRemotes-	)+getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)]+getList o+	| allRepos o = nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)+	| otherwise = getRemotes   where 	getRemotes = do 		rs <- remoteList@@ -59,7 +68,7 @@ 			filter (\t -> thd3 t /= DeadTrusted) rs3  printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()-printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l+printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l  start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart start l file key = do@@ -69,8 +78,8 @@  type Present = Bool -header :: [(RemoteName, TrustLevel)] -> String-header remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)+lheader :: [(RemoteName, TrustLevel)] -> String+lheader remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)   where 	formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel 	pipes = flip replicate '|'
Command/Lock.hs view
@@ -12,12 +12,13 @@ import qualified Annex.Queue import qualified Annex 	-cmd :: [Command]-cmd = [notDirect $ withOptions annexedMatchingOptions $-	command "lock" paramPaths seek SectionCommon-	"undo unlock command"]+cmd :: Command+cmd = notDirect $ withGlobalOptions annexedMatchingOptions $+	command "lock" SectionCommon+		"undo unlock command"+		paramPaths (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek ps = do 	withFilesUnlocked start ps 	withFilesUnlockedToBeCommitted start ps
Command/Log.hs view
@@ -38,52 +38,62 @@  type Outputter = Bool -> POSIXTime -> [UUID] -> Annex () -cmd :: [Command]-cmd = [withOptions options $-	command "log" paramPaths seek SectionQuery "shows location log"]+cmd :: Command+cmd = withGlobalOptions annexedMatchingOptions $+	command "log" SectionQuery "shows location log"+		paramPaths (seek <$$> optParser) -options :: [Option]-options = passthruOptions ++ [gourceOption] ++ annexedMatchingOptions+data LogOptions = LogOptions+	{ logFiles :: CmdParams+	, gourceOption :: Bool+	, passthruOptions :: [CommandParam]+	} -passthruOptions :: [Option]-passthruOptions = map odate ["since", "after", "until", "before"] ++-	[ fieldOption ['n'] "max-count" paramNumber-		"limit number of logs displayed"-	]+optParser :: CmdParamsDesc -> Parser LogOptions+optParser desc = LogOptions+	<$> cmdParams desc+	<*> switch+		( long "gource"+		<> help "format output for gource"+		)+	<*> (concat <$> many passthru)   where-	odate n = fieldOption [] n paramDate $ "show log " ++ n ++ " date"--gourceOption :: Option-gourceOption = flagOption [] "gource" "format output for gource"+	passthru :: Parser [CommandParam]+	passthru = datepassthru "since"+		<|> datepassthru "after"+		<|> datepassthru "until"+		<|> datepassthru "before"+		<|> (mkpassthru "max-count" <$> strOption+			( long "max-count" <> metavar paramNumber+			<> help "limit number of logs displayed"+			))+	datepassthru n = mkpassthru n <$> strOption+		( long n <> metavar paramDate+		<> help ("show log " ++ n ++ " date")+		)+	mkpassthru n v = [Param ("--" ++ n), Param v] -seek :: CommandSeek-seek ps = do+seek :: LogOptions -> CommandSeek+seek o = do 	m <- Remote.uuidDescriptions 	zone <- liftIO getCurrentTimeZone-	os <- concat <$> mapM getoption passthruOptions-	gource <- getOptionFlag gourceOption-	withFilesInGit (whenAnnexed $ start m zone os gource) ps-  where-	getoption o = maybe [] (use o) <$>-		Annex.getField (optionName o)-	use o v = [Param ("--" ++ optionName o), Param v]+	withFilesInGit (whenAnnexed $ start m zone o) (logFiles o)  start 	:: M.Map UUID String 	-> TimeZone-	-> [CommandParam]-	-> Bool+	-> LogOptions 	-> FilePath 	-> Key 	-> CommandStart-start m zone os gource file key = do-	showLog output =<< readLog <$> getLog key os+start m zone o file key = do+	showLog output =<< readLog <$> getLog key (passthruOptions o) 	-- getLog produces a zombie; reap it 	liftIO reapZombies 	stop   where 	output-		| gource = gourceOutput lookupdescription file+		| (gourceOption o) = gourceOutput lookupdescription file 		| otherwise = normalOutput lookupdescription file zone 	lookupdescription u = fromMaybe (fromUUID u) $ M.lookup u m
Command/LookupKey.hs view
@@ -13,16 +13,18 @@ import Annex.CatFile import Types.Key -cmd :: [Command]-cmd = [withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $-	command "lookupkey" (paramRepeating paramFile) seek-		SectionPlumbing "looks up key used for file"]--seek :: CommandSeek-seek = batchable withStrings start+cmd :: Command+cmd = notBareRepo $ noCommit $ noMessages $+	command "lookupkey" SectionPlumbing +		"looks up key used for file"+		(paramRepeating paramFile)+		(batchable run (pure ())) -start :: Batchable String-start batchmode file = do-	maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file)-		=<< catKeyFile file-	stop+run :: () -> String -> Annex Bool+run _ file = do+	mk <- catKeyFile file+	case mk of+		Just k  -> do+			liftIO $ putStrLn $ key2file k+			return True+		Nothing -> return False
Command/Map.hs view
@@ -25,12 +25,13 @@ -- a link from the first repository to the second (its remote) data Link = Link Git.Repo Git.Repo -cmd :: [Command]-cmd = [dontCheck repoExists $-	command "map" paramNothing seek SectionQuery-		"generate map of repositories"]+cmd :: Command+cmd = dontCheck repoExists $+	command "map" SectionQuery+		"generate map of repositories"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/Merge.hs view
@@ -13,11 +13,12 @@ import qualified Git.Branch import Command.Sync (prepMerge, mergeLocal) -cmd :: [Command]-cmd = [command "merge" paramNothing seek SectionMaintenance-	"automatically merge changes from remotes"]+cmd :: Command+cmd = command "merge" SectionMaintenance+	"automatically merge changes from remotes"+	paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek ps = do 	withNothing mergeBranch ps 	withNothing mergeSynced ps
Command/MetaData.hs view
@@ -8,7 +8,6 @@ module Command.MetaData where  import Common.Annex-import qualified Annex import Command import Annex.MetaData import Logs.MetaData@@ -16,71 +15,70 @@ import qualified Data.Set as S import Data.Time.Clock.POSIX -cmd :: [Command]-cmd = [withOptions metaDataOptions $-	command "metadata" paramPaths seek-	SectionMetaData "sets or gets metadata of a file"]--metaDataOptions :: [Option]-metaDataOptions =-	[ setOption-	, tagOption-	, untagOption-	, getOption-	, jsonOption-	] ++ keyOptions ++ annexedMatchingOptions--storeModMeta :: ModMeta -> Annex ()-storeModMeta modmeta = Annex.changeState $-	\s -> s { Annex.modmeta = modmeta:Annex.modmeta s }--setOption :: Option-setOption = Option ['s'] ["set"] (ReqArg mkmod "FIELD[+-]=VALUE") "set metadata"-  where-	mkmod = either error storeModMeta . parseModMeta+cmd :: Command+cmd = withGlobalOptions ([jsonOption] ++ annexedMatchingOptions) $ +	command "metadata" SectionMetaData+		"sets or gets metadata of a file"+		paramPaths (seek <$$> optParser) -getOption :: Option-getOption = fieldOption ['g'] "get" paramField "get single metadata field"+data MetaDataOptions = MetaDataOptions+	{ forFiles :: CmdParams+	, getSet :: GetSet+	, keyOptions :: Maybe KeyOptions+	} -tagOption :: Option-tagOption = Option ['t'] ["tag"] (ReqArg mkmod "TAG") "set a tag"-  where-	mkmod = storeModMeta . AddMeta tagMetaField . toMetaValue+data GetSet = Get MetaField | Set [ModMeta] -untagOption :: Option-untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag"+optParser :: CmdParamsDesc -> Parser MetaDataOptions+optParser desc = MetaDataOptions+	<$> cmdParams desc+	<*> ((Get <$> getopt) <|> (Set <$> many modopts))+	<*> optional (parseKeyOptions False)   where-	mkmod = storeModMeta . AddMeta tagMetaField . mkMetaValue (CurrentlySet False)+	getopt = option (eitherReader mkMetaField)+		( long "get" <> short 'g' <> metavar paramField+		<> help "get single metadata field"+		)+	modopts = option (eitherReader parseModMeta)+		( long "set" <> short 's' <> metavar "FIELD[+-]=VALUE"+		<> help "set or unset metadata value"+		)+		<|> (AddMeta tagMetaField . toMetaValue <$> strOption+			( long "tag" <> short 't' <> metavar "TAG"+			<> help "set a tag"+			))+		<|> (AddMeta tagMetaField . mkMetaValue (CurrentlySet False) <$> strOption+			( long "untag" <> short 'u' <> metavar "TAG"+			<> help "remove a tag"+			)) -seek :: CommandSeek-seek ps = do-	modmeta <- Annex.getState Annex.modmeta-	getfield <- getOptionField getOption $ \ms ->-		return $ either error id . mkMetaField <$> ms+seek :: MetaDataOptions -> CommandSeek+seek o = do 	now <- liftIO getPOSIXTime-	let seeker = if null modmeta-		then withFilesInGit-		else withFilesInGitNonRecursive-	withKeyOptions False-		(startKeys now getfield modmeta)-		(seeker $ whenAnnexed $ start now getfield modmeta)-		ps+	let seeker = case getSet o of+		Get _ -> withFilesInGit+		Set _ -> withFilesInGitNonRecursive+	withKeyOptions (keyOptions o) False+		(startKeys now o)+		(seeker $ whenAnnexed $ start now o)+		(forFiles o) -start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart-start now f ms file = start' (Just file) now f ms+start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart+start now o file = start' (Just file) now o -startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart+startKeys :: POSIXTime -> MetaDataOptions -> Key -> CommandStart startKeys = start' Nothing -start' :: AssociatedFile -> POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart-start' afile now Nothing ms k = do-	showStart' "metadata" k afile-	next $ perform now ms k-start' _ _ (Just f) _ k = do-	l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k-	liftIO $ forM_ l $-		putStrLn . fromMetaValue-	stop+start' :: AssociatedFile -> POSIXTime -> MetaDataOptions -> Key -> CommandStart+start' afile now o k = case getSet o of+	Set ms -> do+		showStart' "metadata" k afile+		next $ perform now ms k+	Get f -> do+		l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k+		liftIO $ forM_ l $+			putStrLn . fromMetaValue+		stop  perform :: POSIXTime -> [ModMeta] -> Key -> CommandPerform perform _ [] k = next $ cleanup k
Command/Migrate.hs view
@@ -18,12 +18,13 @@ import qualified Command.Fsck import qualified Annex -cmd :: [Command]-cmd = [notDirect $ withOptions annexedMatchingOptions $-	command "migrate" paramPaths seek-		SectionUtility "switch data to different backend"]+cmd :: Command+cmd = notDirect $ withGlobalOptions annexedMatchingOptions $+	command "migrate" SectionUtility +		"switch data to different backend"+		paramPaths (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withFilesInGit $ whenAnnexed start  start :: FilePath -> Key -> CommandStart
Command/Mirror.hs view
@@ -16,41 +16,49 @@ import Annex.Content import Annex.NumCopies -cmd :: [Command]-cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek-	SectionCommon "mirror content of files to/from another repository"]+cmd :: Command+cmd = withGlobalOptions ([jobsOption] ++ annexedMatchingOptions) $+	command "mirror" SectionCommon +		"mirror content of files to/from another repository"+		paramPaths (seek <--< optParser) -mirrorOptions :: [Option]-mirrorOptions = fromToOptions ++ [jobsOption] ++ annexedMatchingOptions ++ keyOptions+data MirrorOptions = MirrorOptions+	{ mirrorFiles :: CmdParams+	, fromToOptions :: FromToOptions+	, keyOptions :: Maybe KeyOptions+	} -seek :: CommandSeek-seek ps = do-	to <- getOptionField toOption Remote.byNameWithUUID-	from <- getOptionField fromOption Remote.byNameWithUUID-	withKeyOptions False-		(startKey to from Nothing)-		(withFilesInGit $ whenAnnexed $ start to from)-		ps+optParser :: CmdParamsDesc -> Parser MirrorOptions+optParser desc = MirrorOptions+	<$> cmdParams desc+	<*> parseFromToOptions+	<*> optional (parseKeyOptions False) -start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart-start to from file = startKey to from (Just file)+instance DeferredParseClass MirrorOptions where+	finishParse v = MirrorOptions+		<$> pure (mirrorFiles v)+		<*> finishParse (fromToOptions v)+		<*> pure (keyOptions v) -startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart-startKey to from afile key =-	case (from, to) of-		(Nothing, Nothing) -> error "specify either --from or --to"-		(Nothing, Just r) -> mirrorto r-		(Just r, Nothing) -> mirrorfrom r-		_ -> error "only one of --from or --to can be specified"-  where-	mirrorto r = ifM (inAnnex key)-		( Command.Move.toStart r False afile key+seek :: MirrorOptions -> CommandSeek+seek o = withKeyOptions (keyOptions o) False+	(startKey o Nothing)+	(withFilesInGit $ whenAnnexed $ start o)+	(mirrorFiles o)++start :: MirrorOptions -> FilePath -> Key -> CommandStart+start o file = startKey o (Just file)++startKey :: MirrorOptions -> Maybe FilePath -> Key -> CommandStart+startKey o afile key = case fromToOptions o of+	ToRemote r -> ifM (inAnnex key)+		( Command.Move.toStart False afile key =<< getParsed r 		, do 			numcopies <- getnumcopies-			Command.Drop.startRemote afile numcopies key r+			Command.Drop.startRemote afile numcopies key =<< getParsed r 		)-	mirrorfrom r = do-		haskey <- Remote.hasKey r key+	FromRemote r -> do+		haskey <- flip Remote.hasKey key =<< getParsed r 		case haskey of 			Left _ -> stop 			Right True -> Command.Get.start' (return True) Nothing key afile@@ -60,4 +68,5 @@ 					Command.Drop.startLocal afile numcopies key Nothing 				, stop 				)+  where 	getnumcopies = maybe getNumCopies getFileNumCopies afile
Command/Move.hs view
@@ -17,36 +17,48 @@ import Annex.Transfer import Logs.Presence -cmd :: [Command]-cmd = [withOptions moveOptions $ command "move" paramPaths seek-	SectionCommon "move content of files to/from another repository"]+cmd :: Command+cmd = withGlobalOptions (jobsOption : annexedMatchingOptions) $+	command "move" SectionCommon+		"move content of files to/from another repository"+		paramPaths (seek <--< optParser) -moveOptions :: [Option]-moveOptions = fromToOptions ++ [jobsOption] ++ keyOptions ++ annexedMatchingOptions+data MoveOptions = MoveOptions+	{ moveFiles :: CmdParams+	, fromToOptions :: FromToOptions+	, keyOptions :: Maybe KeyOptions+	} -seek :: CommandSeek-seek ps = do-	to <- getOptionField toOption Remote.byNameWithUUID-	from <- getOptionField fromOption Remote.byNameWithUUID-	withKeyOptions False-		(startKey to from True)-		(withFilesInGit $ whenAnnexed $ start to from True)-		ps+optParser :: CmdParamsDesc -> Parser MoveOptions+optParser desc = MoveOptions+	<$> cmdParams desc+	<*> parseFromToOptions+	<*> optional (parseKeyOptions False) -start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart-start to from move = start' to from move . Just+instance DeferredParseClass MoveOptions where+	finishParse v = MoveOptions+		<$> pure (moveFiles v)+		<*> finishParse (fromToOptions v)+		<*> pure (keyOptions v) -startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart-startKey to from move = start' to from move Nothing+seek :: MoveOptions -> CommandSeek+seek o = withKeyOptions (keyOptions o) False+	(startKey o True)+	(withFilesInGit $ whenAnnexed $ start o True)+	(moveFiles o) -start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart-start' to from move afile key = do-	case (from, to) of-		(Nothing, Nothing) -> error "specify either --from or --to"-		(Nothing, Just dest) -> toStart dest move afile key-		(Just src, Nothing) -> fromStart src move afile key-		_ -> error "only one of --from or --to can be specified"+start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart+start o move = start' o move . Just +startKey :: MoveOptions -> Bool -> Key -> CommandStart+startKey o move = start' o move Nothing++start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> CommandStart+start' o move afile key = +	case fromToOptions o of+		FromRemote src -> fromStart move afile key =<< getParsed src+		ToRemote dest -> toStart move afile key =<< getParsed dest+ showMoveAction :: Bool -> Key -> AssociatedFile -> Annex () showMoveAction move = showStart' (if move then "move" else "copy") @@ -59,8 +71,8 @@  - A file's content can be moved even if there are insufficient copies to  - allow it to be dropped.  -}-toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart-toStart dest move afile key = do+toStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart+toStart move afile key dest = do 	u <- getUUID 	ishere <- inAnnex key 	if not ishere || u == Remote.uuid dest@@ -122,8 +134,8 @@  - If the current repository already has the content, it is still removed  - from the remote.  -}-fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart-fromStart src move afile key+fromStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart+fromStart move afile key src 	| move = go 	| otherwise = stopUnless (not <$> inAnnex key) go   where
Command/NotifyChanges.hs view
@@ -19,11 +19,13 @@ import Control.Concurrent.Async import Control.Concurrent.STM -cmd :: [Command]-cmd = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing-	"sends notification when git refs are changed"]+cmd :: Command+cmd = noCommit $ +	command "notifychanges" SectionPlumbing+		"sends notification when git refs are changed"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/NumCopies.hs view
@@ -13,11 +13,12 @@ import Annex.NumCopies import Types.Messages -cmd :: [Command]-cmd = [command "numcopies" paramNumber seek-	SectionSetup "configure desired number of copies"]+cmd :: Command+cmd = command "numcopies" SectionSetup +	"configure desired number of copies"+	paramNumber (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/PreCommit.hs view
@@ -28,11 +28,13 @@  import qualified Data.Set as S -cmd :: [Command]-cmd = [command "pre-commit" paramPaths seek SectionPlumbing-	"run by git pre-commit hook"]+cmd :: Command+cmd = command "pre-commit" SectionPlumbing+	"run by git pre-commit hook"+	paramPaths+	(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek ps = lockPreCommitHook $ ifM isDirect 	( do 		-- update direct mode mappings for committed files
Command/Proxy.hs view
@@ -17,12 +17,13 @@ import qualified Git.Ref import qualified Git.Branch -cmd :: [Command]-cmd = [notBareRepo $-	command "proxy" ("-- git command") seek-		SectionPlumbing "safely bypass direct mode guard"]+cmd :: Command+cmd = notBareRepo $+	command "proxy" SectionPlumbing +		"safely bypass direct mode guard"+		("-- git command") (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/ReKey.hs view
@@ -18,12 +18,14 @@ import Utility.CopyFile import qualified Remote -cmd :: [Command]-cmd = [notDirect $ command "rekey"-	(paramOptional $ paramRepeating $ paramPair paramPath paramKey)-	seek SectionPlumbing "change keys used for files"]+cmd :: Command+cmd = notDirect $ +	command "rekey" SectionPlumbing+		"change keys used for files"+		(paramRepeating $ paramPair paramPath paramKey)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withPairs start  start :: (FilePath, String) -> CommandStart
Command/ReadPresentKey.hs view
@@ -12,11 +12,14 @@ import Logs.Location import Types.Key -cmd :: [Command]-cmd = [noCommit $ command "readpresentkey" (paramPair paramKey paramUUID) seek-	SectionPlumbing "read records of where key is present"] +cmd :: Command+cmd = noCommit $ +	command "readpresentkey" SectionPlumbing+		"read records of where key is present"+		(paramPair paramKey paramUUID)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/RecvKey.hs view
@@ -20,11 +20,12 @@ import qualified Types.Backend import qualified Backend -cmd :: [Command]-cmd = [noCommit $ command "recvkey" paramKey seek-	SectionPlumbing "runs rsync in server mode to receive content"]+cmd :: Command+cmd = noCommit $ command "recvkey" SectionPlumbing +	"runs rsync in server mode to receive content"+	paramKey (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withKeys start  start :: Key -> CommandStart
Command/RegisterUrl.hs view
@@ -15,12 +15,14 @@ import Annex.UUID import Command.FromKey (mkKey) -cmd :: [Command]-cmd = [notDirect $ notBareRepo $-	command "registerurl" (paramPair paramKey paramUrl) seek-		SectionPlumbing "registers an url for a key"]+cmd :: Command+cmd = notDirect $ notBareRepo $+	command "registerurl"+		SectionPlumbing "registers an url for a key"+		(paramPair paramKey paramUrl)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Reinit.hs view
@@ -14,11 +14,14 @@ import Types.UUID import qualified Remote 	-cmd :: [Command]-cmd = [dontCheck repoExists $-	command "reinit" (paramUUID ++ "|" ++ paramDesc) seek SectionUtility "initialize repository, reusing old UUID"]+cmd :: Command+cmd = dontCheck repoExists $+	command "reinit" SectionUtility +		"initialize repository, reusing old UUID"+		(paramUUID ++ "|" ++ paramDesc)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Reinject.hs view
@@ -14,11 +14,12 @@ import qualified Command.Fsck import qualified Backend -cmd :: [Command]-cmd = [command "reinject" (paramPair "SRC" "DEST") seek-	SectionUtility "sets content of annexed file"]+cmd :: Command+cmd = command "reinject" SectionUtility +	"sets content of annexed file"+	(paramPair "SRC" "DEST") (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [FilePath] -> CommandStart
Command/RemoteDaemon.hs view
@@ -11,11 +11,13 @@ import Command import RemoteDaemon.Core -cmd :: [Command]-cmd = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing-	"detects when remotes have changed, and fetches from them"]+cmd :: Command+cmd = noCommit $ +	command "remotedaemon" SectionPlumbing+		"detects when remotes have changed, and fetches from them"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/Repair.hs view
@@ -16,11 +16,13 @@ import Git.Types import Annex.Version -cmd :: [Command]-cmd = [noCommit $ dontCheck repoExists $-	command "repair" paramNothing seek SectionMaintenance "recover broken git repository"]+cmd :: Command+cmd = noCommit $ dontCheck repoExists $+	command "repair" SectionMaintenance +		"recover broken git repository"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/Required.hs view
@@ -11,7 +11,7 @@ import Logs.PreferredContent import qualified Command.Wanted -cmd :: [Command]+cmd :: Command cmd = Command.Wanted.cmd' "required" "get or set required content expression" 	requiredContentMapRaw 	requiredContentSet
Command/ResolveMerge.hs view
@@ -14,11 +14,12 @@ import qualified Git.Branch import Annex.AutoMerge -cmd :: [Command]-cmd = [command "resolvemerge" paramNothing seek SectionPlumbing-	"resolve merge conflicts"]+cmd :: Command+cmd = command "resolvemerge" SectionPlumbing+	"resolve merge conflicts"+	paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/RmUrl.hs view
@@ -13,12 +13,14 @@ import Annex.UUID import qualified Remote -cmd :: [Command]-cmd = [notBareRepo $-	command "rmurl" (paramPair paramFile paramUrl) seek-		SectionCommon "record file is not available at url"]+cmd :: Command+cmd = notBareRepo $+	command "rmurl" SectionCommon +		"record file is not available at url"+		(paramPair paramFile paramUrl)+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withPairs start  start :: (FilePath, String) -> CommandStart
Command/Schedule.hs view
@@ -17,11 +17,12 @@  import qualified Data.Set as S -cmd :: [Command]-cmd = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek-	SectionSetup "get or set scheduled jobs"]+cmd :: Command+cmd = command "schedule" SectionSetup "get or set scheduled jobs"+	(paramPair paramRemote (paramOptional paramExpression))+	(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Semitrust.hs view
@@ -11,9 +11,10 @@ import Types.TrustLevel import Command.Trust (trustCommand) -cmd :: [Command]-cmd = [command "semitrust" (paramRepeating paramRemote) seek-	SectionSetup "return repository to default trust level"]+cmd :: Command+cmd = command "semitrust" SectionSetup +	"return repository to default trust level"+	(paramRepeating paramRemote) (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = trustCommand "semitrust" SemiTrusted
Command/SendKey.hs view
@@ -16,11 +16,13 @@ import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered -cmd :: [Command]-cmd = [noCommit $ command "sendkey" paramKey seek-	SectionPlumbing "runs rsync in server mode to send content"]+cmd :: Command+cmd = noCommit $ +	command "sendkey" SectionPlumbing +		"runs rsync in server mode to send content"+		paramKey (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withKeys start  start :: Key -> CommandStart
Command/SetKey.hs view
@@ -13,11 +13,12 @@ import Annex.Content import Types.Key -cmd :: [Command]-cmd = [command "setkey" (paramPair paramKey paramPath) seek-	SectionPlumbing "sets annexed content for a key"]+cmd :: Command+cmd = command "setkey" SectionPlumbing "sets annexed content for a key"+	(paramPair paramKey paramPath)+	(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/SetPresentKey.hs view
@@ -13,11 +13,14 @@ import Logs.Presence.Pure import Types.Key -cmd :: [Command]-cmd = [noCommit $ command "setpresentkey" (paramPair paramKey (paramPair paramUUID "[1|0]")) seek-	SectionPlumbing "change records of where key is present"] +cmd :: Command+cmd = noCommit $ +	command "setpresentkey" SectionPlumbing+		"change records of where key is present"+		(paramPair paramKey (paramPair paramUUID "[1|0]"))+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Status.hs view
@@ -16,12 +16,13 @@ import qualified Git.Ref import qualified Git -cmd :: [Command]-cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $-	command "status" paramPaths seek SectionCommon-		"show the working tree status"]+cmd :: Command+cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $+	command "status" SectionCommon+		"show the working tree status"+		paramPaths (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [FilePath] -> CommandStart
Command/Sync.hs view
@@ -51,26 +51,33 @@ import Control.Concurrent.MVar import qualified Data.Map as M -cmd :: [Command]-cmd = [withOptions syncOptions $-	command "sync" (paramOptional (paramRepeating paramRemote))-	seek SectionCommon "synchronize local repository with remotes"]--syncOptions :: [Option]-syncOptions =-	[ contentOption-	, messageOption-	, allOption-	]+cmd :: Command+cmd = command "sync" SectionCommon +	"synchronize local repository with remotes"+	(paramRepeating paramRemote) (seek <$$> optParser) -contentOption :: Option-contentOption = flagOption [] "content" "also transfer file contents"+data SyncOptions  = SyncOptions+	{ syncWith :: CmdParams+	, contentOption :: Bool+	, messageOption :: Maybe String+	, keyOptions :: Maybe KeyOptions+	} -messageOption :: Option-messageOption = fieldOption ['m'] "message" "MSG" "specify commit message"+optParser :: CmdParamsDesc -> Parser SyncOptions+optParser desc = SyncOptions+	<$> cmdParams desc+	<*> switch+		( long "content"+		<> help "also transfer file contents"+		)+	<*> optional (strOption+		( long "message" <> short 'm' <> metavar "MSG"+		<> help "commit message"+		))+	<*> optional parseAllOption -seek :: CommandSeek-seek rs = do+seek :: SyncOptions -> CommandSeek+seek o = do 	prepMerge  	-- There may not be a branch checked out until after the commit,@@ -89,20 +96,20 @@ 		) 	let withbranch a = a =<< getbranch -	remotes <- syncRemotes rs+	remotes <- syncRemotes (syncWith o) 	let gitremotes = filter Remote.gitSyncableRemote remotes 	let dataremotes = filter (not . remoteAnnexIgnore . Remote.gitconfig) remotes  	-- Syncing involves many actions, any of which can independently 	-- fail, without preventing the others from running. 	seekActions $ return $ concat-		[ [ commit ]+		[ [ commit o ] 		, [ withbranch mergeLocal ] 		, map (withbranch . pullRemote) gitremotes 		,  [ mergeAnnex ] 		]-	whenM (Annex.getFlag $ optionName contentOption) $-		whenM (seekSyncContent dataremotes) $+	when (contentOption o) $+		whenM (seekSyncContent o dataremotes) $ 			-- Transferring content can take a while, 			-- and other changes can be pushed to the git-annex 			-- branch on the remotes in the meantime, so pull@@ -150,15 +157,14 @@ 	 	fastest = fromMaybe [] . headMaybe . Remote.byCost -commit :: CommandStart-commit = ifM (annexAutoCommit <$> Annex.getGitConfig)+commit :: SyncOptions -> CommandStart+commit o = ifM (annexAutoCommit <$> Annex.getGitConfig) 	( go 	, stop 	)   where 	go = next $ next $ do-		commitmessage <- maybe commitMsg return-			=<< Annex.getField (optionName messageOption)+		commitmessage <- maybe commitMsg return (messageOption o) 		showStart "commit" "" 		Annex.Branch.commit "update" 		ifM isDirect@@ -371,14 +377,16 @@  -  - If any file movements were generated, returns true.  -}-seekSyncContent :: [Remote] -> Annex Bool-seekSyncContent rs = do+seekSyncContent :: SyncOptions -> [Remote] -> Annex Bool+seekSyncContent o rs = do 	mvar <- liftIO newEmptyMVar-	bloom <- ifM (Annex.getFlag "all")-		( Just <$> genBloomFilter (seekworktree mvar [])-		, seekworktree mvar [] (const noop) >> pure Nothing-		)-	withKeyOptions' False (seekkeys mvar bloom) (const noop) []+	bloom <- case keyOptions o of+		Just WantAllKeys -> Just <$> genBloomFilter (seekworktree mvar [])+		_ -> seekworktree mvar [] (const noop) >> pure Nothing+	withKeyOptions' (keyOptions o) False+		(seekkeys mvar bloom) +		(const noop)+		[] 	liftIO $ not <$> isEmptyMVar mvar   where 	seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=@@ -406,7 +414,7 @@ 	let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs  	got <- anyM id =<< handleget have-	putrs <- catMaybes . snd . unzip <$> (sequence =<< handleput lack)+	putrs <- handleput lack  	u <- getUUID 	let locs' = concat [[u | got], putrs, locs]@@ -447,12 +455,14 @@ 	wantput r 		| Remote.readonly r || remoteAnnexReadOnly (Remote.gitconfig r) = return False 		| otherwise = wantSend True (Just k) af (Remote.uuid r)-	handleput lack = ifM (inAnnex k)-		( map put <$> filterM wantput lack+	handleput lack = catMaybes <$> ifM (inAnnex k)+		( forM lack $ \r ->+			ifM (wantput r <&&> put r)+				( return (Just (Remote.uuid r))+				, return Nothing+				) 		, return [] 		)-	put dest = do-		ok <- includeCommandAction $ do-			showStart' "copy" k af-			Command.Move.toStart' dest False af k-		return (ok, if ok then Just (Remote.uuid dest) else Nothing)+	put dest = includeCommandAction $ do+		showStart' "copy" k af+		Command.Move.toStart' dest False af k
Command/Test.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2013 Joey Hess <id@joeyh.name>+ - Copyright 2013-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -10,28 +10,23 @@ import Common import Command import Messages+import Types.Test -cmd :: [Command]-cmd = [ noRepo startIO $ dontCheck repoExists $-	command "test" paramNothing seek SectionTesting-		"run built-in test suite"]+cmd :: Parser TestOptions -> Maybe TestRunner -> Command+cmd optparser runner = noRepo (startIO runner <$$> const optparser) $+	dontCheck repoExists $+		command "test" SectionTesting+			"run built-in test suite"+			paramNothing (seek runner <$$> const optparser) -seek :: CommandSeek-seek = withWords start+seek :: Maybe TestRunner -> TestOptions -> CommandSeek+seek runner o = commandAction $ start runner o -{- We don't actually run the test suite here because of a dependency loop.- - The main program notices when the command is test and runs it; this- - function is never run if that works.- -- - However, if git-annex is built without the test suite, just print a- - warning, and do not exit nonzero. This is so git-annex test can be run- - in debian/rules despite some architectures not being able to build the- - test suite.- -}-start :: [String] -> CommandStart-start ps = do-	liftIO $ startIO ps+start :: Maybe TestRunner -> TestOptions -> CommandStart+start runner o = do+	liftIO $ startIO runner o 	stop -startIO :: CmdParams -> IO ()-startIO _ = warningIO "git-annex was built without its test suite; not testing"+startIO :: Maybe TestRunner -> TestOptions -> IO ()+startIO Nothing _ = warningIO "git-annex was built without its test suite; not testing"+startIO (Just runner) o = runner o
Command/TestRemote.hs view
@@ -27,6 +27,7 @@ import Types.Messages import Remote.Helper.Chunked import Locations+import Git.Types  import Test.Tasty import Test.Tasty.Runners@@ -36,25 +37,30 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Map as M -cmd :: [Command]-cmd = [ withOptions [sizeOption] $-		command "testremote" paramRemote seek SectionTesting-			"test transfers to/from a remote"]+cmd :: Command+cmd = command "testremote" SectionTesting+	"test transfers to/from a remote"+	paramRemote (seek <$$> optParser) -sizeOption :: Option-sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)"+data TestRemoteOptions = TestRemoteOptions+	{ testRemote :: RemoteName+	, sizeOption :: ByteSize+	} -seek :: CommandSeek-seek ps = do-	basesz <- fromInteger . fromMaybe (1024 * 1024)-		<$> getOptionField sizeOption (pure . getsize)-	withWords (start basesz) ps-  where-	getsize v = v >>= readSize dataUnits+optParser :: CmdParamsDesc -> Parser TestRemoteOptions+optParser desc = TestRemoteOptions+	<$> argument str ( metavar desc )+	<*> option (str >>= maybe (fail "parse error") return . readSize dataUnits)+		( long "size" <> metavar paramSize+		<> value (1024 * 1024)+		<> help "base key size (default 1MiB)"+		) -start :: Int -> [String] -> CommandStart-start basesz ws = do-	let name = unwords ws+seek :: TestRemoteOptions -> CommandSeek+seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o) ++start :: Int -> RemoteName -> CommandStart+start basesz name = do 	showStart "testremote" name 	r <- either error id <$> Remote.byName' name 	showSideAction "generating test keys"
Command/TransferInfo.hs view
@@ -15,11 +15,13 @@ import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered -cmd :: [Command]-cmd = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing-	"updates sender on number of bytes of content received"]+cmd :: Command+cmd = noCommit $ +	command "transferinfo" SectionPlumbing+		"updates sender on number of bytes of content received"+		paramKey (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  {- Security:@@ -47,8 +49,8 @@ 				, transferUUID = u 				, transferKey = key 				}-			info <- liftIO $ startTransferInfo file-			(update, tfile, _) <- mkProgressUpdater t info+			tinfo <- liftIO $ startTransferInfo file+			(update, tfile, _) <- mkProgressUpdater t tinfo 			liftIO $ mapM_ void 				[ tryIO $ forever $ do 					bytes <- readUpdate
Command/TransferKey.hs view
@@ -15,41 +15,51 @@ import qualified Remote import Types.Remote -cmd :: [Command]-cmd = [withOptions transferKeyOptions $-	noCommit $ command "transferkey" paramKey seek SectionPlumbing-		"transfers a key from or to a remote"]+cmd :: Command+cmd = noCommit $+	command "transferkey" SectionPlumbing+		"transfers a key from or to a remote"+		paramKey (seek <--< optParser) -transferKeyOptions :: [Option]-transferKeyOptions = fileOption : fromToOptions+data TransferKeyOptions = TransferKeyOptions+	{ keyOptions :: CmdParams +	, fromToOptions :: FromToOptions+	, fileOption :: AssociatedFile+	} -fileOption :: Option-fileOption = fieldOption [] "file" paramFile "the associated file"+optParser :: CmdParamsDesc -> Parser TransferKeyOptions+optParser desc  = TransferKeyOptions+	<$> cmdParams desc+	<*> parseFromToOptions+	<*> optional (strOption+		( long "file" <> metavar paramFile+		<> help "the associated file"+		)) -seek :: CommandSeek-seek ps = do-	to <- getOptionField toOption Remote.byNameWithUUID-	from <- getOptionField fromOption Remote.byNameWithUUID-	file <- getOptionField fileOption return-	withKeys (start to from file) ps+instance DeferredParseClass TransferKeyOptions where+	finishParse v = TransferKeyOptions+		<$> pure (keyOptions v)+		<*> finishParse (fromToOptions v)+		<*> pure (fileOption v) -start :: Maybe Remote -> Maybe Remote -> AssociatedFile -> Key -> CommandStart-start to from file key =-	case (from, to) of-		(Nothing, Just dest) -> next $ toPerform dest key file-		(Just src, Nothing) -> next $ fromPerform src key file-		_ -> error "specify either --from or --to"+seek :: TransferKeyOptions -> CommandSeek+seek o = withKeys (start o) (keyOptions o) -toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform-toPerform remote key file = go Upload file $+start :: TransferKeyOptions -> Key -> CommandStart+start o key = case fromToOptions o of+	ToRemote dest -> next $ toPerform key (fileOption o) =<< getParsed dest+	FromRemote src -> next $ fromPerform key (fileOption o) =<< getParsed src++toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform+toPerform key file remote = go Upload file $ 	upload (uuid remote) key file forwardRetry noObserver $ \p -> do 		ok <- Remote.storeKey remote key file p 		when ok $ 			Remote.logStatus remote key InfoPresent 		return ok -fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform-fromPerform remote key file = go Upload file $+fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform+fromPerform key file remote = go Upload file $ 	download (uuid remote) key file forwardRetry noObserver $ \p -> 		getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
Command/TransferKeys.hs view
@@ -21,11 +21,11 @@  data TransferRequest = TransferRequest Direction Remote Key AssociatedFile -cmd :: [Command]-cmd = [command "transferkeys" paramNothing seek-	SectionPlumbing "transfers keys"]+cmd :: Command+cmd = command "transferkeys" SectionPlumbing "transfers keys"+	paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart@@ -45,7 +45,7 @@ 			download (Remote.uuid remote) key file forwardRetry observer $ \p -> 				getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p 	-	observer False t info = recordFailedTransfer t info+	observer False t tinfo = recordFailedTransfer t tinfo 	observer True _ _ = noop  runRequests@@ -80,14 +80,14 @@ 		hFlush writeh  sendRequest :: Transfer -> TransferInfo -> Handle -> IO ()-sendRequest t info h = do+sendRequest t tinfo h = do 	hPutStr h $ intercalate fieldSep 		[ serialize (transferDirection t) 		, maybe (serialize (fromUUID (transferUUID t))) 			(serialize . Remote.name)-			(transferRemote info)+			(transferRemote tinfo) 		, serialize (transferKey t)-		, serialize (associatedFile info)+		, serialize (associatedFile tinfo) 		, "" -- adds a trailing null 		] 	hFlush h
Command/Trust.hs view
@@ -16,14 +16,14 @@  import qualified Data.Set as S -cmd :: [Command]-cmd = [command "trust" (paramRepeating paramRemote) seek-	SectionSetup "trust a repository"]+cmd :: Command+cmd = command "trust" SectionSetup "trust a repository"+	(paramRepeating paramRemote) (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = trustCommand "trust" Trusted -trustCommand :: String -> TrustLevel -> CommandSeek+trustCommand :: String -> TrustLevel -> CmdParams -> CommandSeek trustCommand c level = withWords start   where 	start ws = do
Command/Unannex.hs view
@@ -22,12 +22,13 @@ import Utility.CopyFile import Command.PreCommit (lockPreCommitHook) -cmd :: [Command]-cmd = [withOptions annexedMatchingOptions $-	command "unannex" paramPaths seek SectionUtility-		"undo accidential add command"]+cmd :: Command+cmd = withGlobalOptions annexedMatchingOptions $+	command "unannex" SectionUtility+		"undo accidential add command"+		paramPaths (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = wrapUnannex . (withFilesInGit $ whenAnnexed start)  wrapUnannex :: Annex a -> Annex a
Command/Undo.hs view
@@ -21,12 +21,13 @@ import qualified Git.Branch import qualified Command.Sync -cmd :: [Command]-cmd = [notBareRepo $-	command "undo" paramPaths seek-		SectionCommon "undo last change to a file or directory"]+cmd :: Command+cmd = notBareRepo $+	command "undo" SectionCommon +		"undo last change to a file or directory"+		paramPaths (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek ps = do 	-- Safety first; avoid any undo that would touch files that are not 	-- in the index.
Command/Ungroup.hs view
@@ -15,11 +15,11 @@  import qualified Data.Set as S -cmd :: [Command]-cmd = [command "ungroup" (paramPair paramRemote paramDesc) seek-	SectionSetup "remove a repository from a group"]+cmd :: Command+cmd = command "ungroup" SectionSetup "remove a repository from a group"+	(paramPair paramRemote paramDesc) (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Uninit.hs view
@@ -21,9 +21,11 @@ import System.IO.HVFS import System.IO.HVFS.Utils -cmd :: [Command]-cmd = [addCheck check $ command "uninit" paramPaths seek -	SectionUtility "de-initialize git-annex and clean out repository"]+cmd :: Command+cmd = addCheck check $ +	command "uninit" SectionUtility+		"de-initialize git-annex and clean out repository"+		paramPaths (withParams seek)  check :: Annex () check = do@@ -39,7 +41,7 @@ 	revhead = inRepo $ Git.Command.pipeReadStrict 		[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"] -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek ps = do 	withFilesNotInGit False (whenAnnexed startCheckIncomplete) ps 	Annex.changeState $ \s -> s { Annex.fast = True }
Command/Unlock.hs view
@@ -13,16 +13,17 @@ import Annex.CatFile import Utility.CopyFile -cmd :: [Command]-cmd =-	[ c "unlock" "unlock files for modification"-	, c "edit" "same as unlock"-	]-  where-	c n = notDirect . withOptions annexedMatchingOptions -		. command n paramPaths seek SectionCommon+cmd :: Command+cmd = mkcmd "unlock" "unlock files for modification" -seek :: CommandSeek+editcmd :: Command+editcmd = mkcmd "edit" "same as unlock"++mkcmd :: String -> String -> Command+mkcmd n d = notDirect $ withGlobalOptions annexedMatchingOptions $+	command n SectionCommon d paramPaths (withParams seek)++seek :: CmdParams -> CommandSeek seek = withFilesInGit $ whenAnnexed start  {- The unlock subcommand replaces the symlink with a copy of the file's
Command/Untrust.hs view
@@ -11,9 +11,9 @@ import Types.TrustLevel import Command.Trust (trustCommand) -cmd :: [Command]-cmd = [command "untrust" (paramRepeating paramRemote) seek-	SectionSetup "do not trust a repository"]+cmd :: Command+cmd = command "untrust" SectionSetup "do not trust a repository"+	(paramRepeating paramRemote) (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = trustCommand "untrust" UnTrusted
Command/Unused.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010-2012 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -31,38 +31,47 @@ import Types.Key import Types.RefSpec import Git.FilePath+import Git.Types import Logs.View (is_branchView) import Annex.BloomFilter -cmd :: [Command]-cmd = [withOptions [unusedFromOption, refSpecOption] $-	command "unused" paramNothing seek-		SectionMaintenance "look for unused file content"]+cmd :: Command+cmd = -- withGlobalOptions [unusedFromOption, refSpecOption] $+	command "unused" SectionMaintenance +		"look for unused file content"+		paramNothing (seek <$$> optParser) -unusedFromOption :: Option-unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content"+data UnusedOptions = UnusedOptions+	{ fromRemote :: Maybe RemoteName+	, refSpecOption :: Maybe RefSpec+	} -refSpecOption :: Option-refSpecOption = fieldOption [] "used-refspec" paramRefSpec "refs to consider used (default: all refs)"+optParser :: CmdParamsDesc -> Parser UnusedOptions+optParser _ = UnusedOptions+	<$> optional (strOption+		( long "from" <> short 'f' <> metavar paramRemote+		<> help "remote to check for unused content"+		))+	<*> optional (option (eitherReader parseRefSpec)+		( long "unused-refspec" <> metavar paramRefSpec+		<> help "refs to consider used (default: all branches)"+		)) -seek :: CommandSeek-seek = withNothing start+seek :: UnusedOptions -> CommandSeek+seek = commandAction . start -{- Finds unused content in the annex. -} -start :: CommandStart-start = do+start :: UnusedOptions -> CommandStart+start o = do 	cfgrefspec <- fromMaybe allRefSpec . annexUsedRefSpec 		<$> Annex.getGitConfig-	!refspec <- maybe cfgrefspec (either error id . parseRefSpec)-		<$> Annex.getField (optionName refSpecOption)-	from <- Annex.getField (optionName unusedFromOption)-	let (name, action) = case from of+	let refspec = fromMaybe cfgrefspec (refSpecOption o)+	let (name, perform) = case fromRemote o of 		Nothing -> (".", checkUnused refspec) 		Just "." -> (".", checkUnused refspec) 		Just "here" -> (".", checkUnused refspec) 		Just n -> (n, checkRemoteUnused n refspec) 	showStart "unused" name-	next action+	next perform  checkUnused :: RefSpec -> CommandPerform checkUnused refspec = chain 0@@ -126,11 +135,11 @@ 	["Some annexed data is no longer used by any files:"] 	[dropMsg Nothing] unusedMsg' :: [(Int, Key)] -> [String] -> [String] -> String-unusedMsg' u header trailer = unlines $-	header +++unusedMsg' u mheader mtrailer = unlines $+	mheader ++ 	table u ++ 	["(To see where data was previously used, try: git log --stat -S'KEY')"] ++-	trailer+	mtrailer  remoteUnusedMsg :: Remote -> [(Int, Key)] -> String remoteUnusedMsg r u = unusedMsg' u@@ -267,7 +276,7 @@ 	, unusedTmpMap :: UnusedMap 	} -withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CommandSeek+withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CmdParams -> CommandSeek withUnusedMaps a params = do 	unused <- readUnusedMap "" 	unusedbad <- readUnusedMap "bad"
Command/Upgrade.hs view
@@ -11,12 +11,12 @@ import Command import Upgrade -cmd :: [Command]-cmd = [dontCheck repoExists $ -- because an old version may not seem to exist-	command "upgrade" paramNothing seek-		SectionMaintenance "upgrade repository layout"]+cmd :: Command+cmd = dontCheck repoExists $ -- because an old version may not seem to exist+	command "upgrade" SectionMaintenance "upgrade repository layout"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart
Command/VAdd.hs view
@@ -12,11 +12,14 @@ import Annex.View import Command.View (checkoutViewBranch) -cmd :: [Command]-cmd = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB")-	seek SectionMetaData "add subdirs to current view"]+cmd :: Command+cmd = notBareRepo $ notDirect $+	command "vadd" SectionMetaData +		"add subdirs to current view"+		(paramRepeating "FIELD=GLOB")+		(withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/VCycle.hs view
@@ -14,12 +14,13 @@ import Logs.View import Command.View (checkoutViewBranch) -cmd :: [Command]-cmd = [notBareRepo $ notDirect $-	command "vcycle" paramNothing seek SectionMetaData-	"switch view to next layout"]+cmd :: Command+cmd = notBareRepo $ notDirect $+	command "vcycle" SectionMetaData+		"switch view to next layout"+		paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start ::CommandStart
Command/VFilter.hs view
@@ -12,11 +12,12 @@ import Annex.View import Command.View (paramView, checkoutViewBranch) -cmd :: [Command]-cmd = [notBareRepo $ notDirect $-	command "vfilter" paramView seek SectionMetaData "filter current view"]+cmd :: Command+cmd = notBareRepo $ notDirect $+	command "vfilter" SectionMetaData "filter current view"+		paramView (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/VPop.hs view
@@ -16,12 +16,12 @@ import Logs.View import Command.View (checkoutViewBranch) -cmd :: [Command]-cmd = [notBareRepo $ notDirect $-	command "vpop" (paramOptional paramNumber) seek SectionMetaData-	"switch back to previous view"]+cmd :: Command+cmd = notBareRepo $ notDirect $+	command "vpop" SectionMetaData "switch back to previous view"+		paramNumber (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart
Command/Version.hs view
@@ -17,45 +17,54 @@ import qualified Remote import qualified Backend -cmd :: [Command]-cmd = [withOptions [rawOption] $-	noCommit $ noRepo startNoRepo $ dontCheck repoExists $-	command "version" paramNothing seek SectionQuery "show version info"]+cmd :: Command+cmd = dontCheck repoExists $ noCommit $ +	noRepo (seekNoRepo <$$> optParser) $ +		command "version" SectionQuery "show version info"+			paramNothing (seek <$$> optParser) -rawOption :: Option-rawOption = flagOption [] "raw" "output only program version"+data VersionOptions = VersionOptions+	{ rawOption :: Bool+	} -seek :: CommandSeek-seek = withNothing $ ifM (getOptionFlag rawOption) (startRaw, start)+optParser :: CmdParamsDesc -> Parser VersionOptions+optParser _ = VersionOptions+	<$> switch+		( long "raw"+		<> help "output only program version"+		) -startRaw :: CommandStart-startRaw = do-	liftIO $ do-		putStr SysConfig.packageversion-		hFlush stdout-	stop+seek :: VersionOptions -> CommandSeek+seek o+	| rawOption o = liftIO showRawVersion+	| otherwise = showVersion -start :: CommandStart-start = do+seekNoRepo :: VersionOptions -> IO ()+seekNoRepo o+	| rawOption o = showRawVersion+	| otherwise = showPackageVersion++showVersion :: Annex ()+showVersion = do 	v <- getVersion 	liftIO $ do- 		showPackageVersion-		info "local repository version" $ fromMaybe "unknown" v-		info "supported repository version" supportedVersion-		info "upgrade supported from repository versions" $+		vinfo "local repository version" $ fromMaybe "unknown" v+		vinfo "supported repository version" supportedVersion+		vinfo "upgrade supported from repository versions" $ 			unwords upgradableVersions-	stop -startNoRepo :: CmdParams -> IO ()-startNoRepo _ = showPackageVersion- showPackageVersion :: IO () showPackageVersion = do-	info "git-annex version" SysConfig.packageversion-	info "build flags" $ unwords buildFlags-	info "key/value backends" $ unwords $ map B.name Backend.list-	info "remote types" $ unwords $ map R.typename Remote.remoteTypes+	vinfo "git-annex version" SysConfig.packageversion+	vinfo "build flags" $ unwords buildFlags+	vinfo "key/value backends" $ unwords $ map B.name Backend.list+	vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes -info :: String -> String -> IO ()-info k v = putStrLn $ k ++ ": " ++ v+showRawVersion :: IO ()+showRawVersion = do+	putStr SysConfig.packageversion+	hFlush stdout -- no newline, so flush++vinfo :: String -> String -> IO ()+vinfo k v = putStrLn $ k ++ ": " ++ v
Command/Vicfg.hs view
@@ -29,11 +29,11 @@ import Types.ScheduledActivity import Remote -cmd :: [Command]-cmd = [command "vicfg" paramNothing seek-	SectionSetup "edit git-annex's configuration"]+cmd :: Command+cmd = command "vicfg" SectionSetup "edit git-annex's configuration"+	paramNothing (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withNothing start  start :: CommandStart@@ -175,7 +175,7 @@ 		(\(s, g) -> gline g s) 		(\g -> gline g "") 	  where-		gline g value = [ unwords ["groupwanted", g, "=", value] ]+		gline g val = [ unwords ["groupwanted", g, "=", val] ] 		allgroups = S.unions $ stdgroups : M.elems (cfgGroupMap cfg) 		stdgroups = S.fromList $ map fromStandardGroup [minBound..maxBound] @@ -198,9 +198,9 @@ 		(\(l, u) -> line "schedule" u $ fromScheduledActivities l) 		(\u -> line "schedule" u "") -	line setting u value =+	line setting u val = 		[ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")"-		, unwords [setting, fromUUID u, "=", value]+		, unwords [setting, fromUUID u, "=", val] 		] 	 settings :: Ord v => Cfg -> M.Map UUID String -> (Cfg -> M.Map UUID v) -> [String] -> ((v, UUID) -> [String]) -> (UUID -> [String]) -> [String]@@ -235,42 +235,42 @@ 		| null l = Right cfg 		| "#" `isPrefixOf` l = Right cfg 		| null setting || null f = Left "missing field"-		| otherwise = parsed cfg f setting value'+		| otherwise = parsed cfg f setting val' 	  where 		(setting, rest) = separate isSpace l-		(r, value) = separate (== '=') rest-		value' = trimspace value+		(r, val) = separate (== '=') rest+		val' = trimspace val 		f = reverse $ trimspace $ reverse $ trimspace r 		trimspace = dropWhile isSpace -	parsed cfg f setting value-		| setting == "trust" = case readTrustLevel value of-			Nothing -> badval "trust value" value+	parsed cfg f setting val+		| setting == "trust" = case readTrustLevel val of+			Nothing -> badval "trust value" val 			Just t -> 				let m = M.insert u t (cfgTrustMap cfg) 				in Right $ cfg { cfgTrustMap = m } 		| setting == "group" =-			let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)+			let m = M.insert u (S.fromList $ words val) (cfgGroupMap cfg) 			in Right $ cfg { cfgGroupMap = m } 		| setting == "wanted" = -			case checkPreferredContentExpression value of+			case checkPreferredContentExpression val of 				Just e -> Left e 				Nothing ->-					let m = M.insert u value (cfgPreferredContentMap cfg)+					let m = M.insert u val (cfgPreferredContentMap cfg) 					in Right $ cfg { cfgPreferredContentMap = m } 		| setting == "required" = -			case checkPreferredContentExpression value of+			case checkPreferredContentExpression val of 				Just e -> Left e 				Nothing ->-					let m = M.insert u value (cfgRequiredContentMap cfg)+					let m = M.insert u val (cfgRequiredContentMap cfg) 					in Right $ cfg { cfgRequiredContentMap = m } 		| setting == "groupwanted" =-			case checkPreferredContentExpression value of+			case checkPreferredContentExpression val of 				Just e -> Left e 				Nothing ->-					let m = M.insert f value (cfgGroupPreferredContentMap cfg)+					let m = M.insert f val (cfgGroupPreferredContentMap cfg) 					in Right $ cfg { cfgGroupPreferredContentMap = m }-		| setting == "schedule" = case parseScheduledActivities value of+		| setting == "schedule" = case parseScheduledActivities val of 			Left e -> Left e 			Right l ->  				let m = M.insert u l (cfgScheduleMap cfg)
Command/View.hs view
@@ -17,18 +17,19 @@ import Annex.View import Logs.View -cmd :: [Command]-cmd = [notBareRepo $ notDirect $-	command "view" paramView seek SectionMetaData "enter a view branch"]+cmd :: Command+cmd = notBareRepo $ notDirect $+	command "view" SectionMetaData "enter a view branch"+		paramView (withParams seek) -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start  start :: [String] -> CommandStart start [] = error "Specify metadata to include in view"-start params = do+start ps = do 	showStart "view" ""-	view <- mkView params+	view <- mkView ps 	go view  =<< currentView   where 	go view Nothing = next $ perform view@@ -45,11 +46,11 @@ paramView = paramRepeating "FIELD=VALUE"  mkView :: [String] -> Annex View-mkView params = go =<< inRepo Git.Branch.current+mkView ps = go =<< inRepo Git.Branch.current   where 	go Nothing = error "not on any branch!" 	go (Just b) = return $ fst $ refineView (View b []) $-		map parseViewParam $ reverse params+		map parseViewParam $ reverse ps  checkoutViewBranch :: View -> (View -> Annex Git.Branch) -> CommandCleanup checkoutViewBranch view mkbranch = do
Command/Wanted.hs view
@@ -17,7 +17,7 @@  import qualified Data.Map as M -cmd :: [Command]+cmd :: Command cmd = cmd' "wanted" "get or set preferred content expression"  	preferredContentMapRaw 	preferredContentSet@@ -27,8 +27,8 @@ 	-> String 	-> Annex (M.Map UUID PreferredContentExpression) 	-> (UUID -> PreferredContentExpression -> Annex ())-	-> [Command]-cmd' name desc getter setter = [command name pdesc seek SectionSetup desc]+	-> Command+cmd' name desc getter setter = command name SectionSetup desc pdesc (withParams seek)   where 	pdesc = paramPair paramRemote (paramOptional paramExpression)
Command/Watch.hs view
@@ -12,25 +12,18 @@ import Command import Utility.HumanTime -cmd :: [Command]-cmd = [notBareRepo $ withOptions [foregroundOption, stopOption] $ -	command "watch" paramNothing seek SectionCommon "watch for changes and autocommit"]--seek :: CommandSeek-seek ps = do-	stopdaemon <- getOptionFlag stopOption-	foreground <- getOptionFlag foregroundOption-	withNothing (start False foreground stopdaemon Nothing) ps--foregroundOption :: Option-foregroundOption = flagOption [] "foreground" "do not daemonize"+cmd :: Command+cmd = notBareRepo $+	command "watch" SectionCommon +		"watch for changes and autocommit"+		paramNothing (seek <$$> const parseDaemonOptions) -stopOption :: Option-stopOption = flagOption [] "stop" "stop daemon"+seek :: DaemonOptions -> CommandSeek+seek o = commandAction $ start False o Nothing -start :: Bool -> Bool -> Bool -> Maybe Duration -> CommandStart-start assistant foreground stopdaemon startdelay = do-	if stopdaemon+start :: Bool -> DaemonOptions -> Maybe Duration -> CommandStart+start assistant o startdelay = do+	if stopDaemonOption o 		then stopDaemon-		else startDaemon assistant foreground startdelay Nothing Nothing Nothing -- does not return+		else startDaemon assistant (foregroundDaemonOption o) startdelay Nothing Nothing Nothing -- does not return 	stop
Command/WebApp.hs view
@@ -34,33 +34,37 @@  import Control.Concurrent import Control.Concurrent.STM-import Network.Socket (HostName)-import System.Environment (getArgs) -cmd :: [Command]-cmd = [ withOptions [listenOption] $-	noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $-	command "webapp" paramNothing seek SectionCommon "launch webapp"]+cmd :: Command+cmd = noCommit $ dontCheck repoExists $ notBareRepo $+	noRepo (startNoRepo <$$> optParser) $+		command "webapp" SectionCommon "launch webapp"+			paramNothing (seek <$$> optParser) -listenOption :: Option-listenOption = fieldOption [] "listen" paramAddress-	"accept connections to this address"+data WebAppOptions = WebAppOptions+	{ listenAddress :: Maybe String+	} -seek :: CommandSeek-seek ps = do-	listenhost <- getOptionField listenOption return-	withNothing (start listenhost) ps+optParser :: CmdParamsDesc -> Parser WebAppOptions+optParser _ = WebAppOptions+	<$> optional (strOption+		( long "listen" <> metavar paramAddress+		<> help "accept connections to this address"+		)) -start :: Maybe HostName -> CommandStart+seek :: WebAppOptions -> CommandSeek+seek = commandAction . start++start :: WebAppOptions -> CommandStart start = start' True -start' :: Bool -> Maybe HostName -> CommandStart-start' allowauto listenhost = do+start' :: Bool -> WebAppOptions -> CommandStart+start' allowauto o = do 	liftIO ensureInstalled 	ifM isInitialized  		( maybe notinitialized (go <=< needsUpgrade) =<< getVersion 		, if allowauto-			then liftIO $ startNoRepo []+			then liftIO $ startNoRepo o 			else notinitialized 		) 	stop@@ -68,22 +72,22 @@ 	go cannotrun = do 		browser <- fromRepo webBrowser 		f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim-		listenhost' <- if isJust listenhost-			then pure listenhost+		listenAddress' <- if isJust (listenAddress o)+			then pure (listenAddress o) 			else annexListen <$> Annex.getGitConfig 		ifM (checkpid <&&> checkshim f)-			( if isJust listenhost+			( if isJust (listenAddress o) 				then error "The assistant is already running, so --listen cannot be used." 				else do 					url <- liftIO . readFile 						=<< fromRepo gitAnnexUrlFile-					liftIO $ if isJust listenhost'+					liftIO $ if isJust listenAddress' 						then putStrLn url 						else liftIO $ openBrowser browser f url Nothing Nothing 			, do-				startDaemon True True Nothing cannotrun listenhost' $ Just $ +				startDaemon True True Nothing cannotrun listenAddress' $ Just $  					\origout origerr url htmlshim ->-						if isJust listenhost'+						if isJust listenAddress' 							then maybe noop (`hPutStrLn` url) origout 							else openBrowser browser htmlshim url origout origerr 			)@@ -94,34 +98,27 @@ 	notinitialized = do 		g <- Annex.gitRepo 		liftIO $ cannotStartIn (Git.repoLocation g) "repository has not been initialized by git-annex"-		liftIO $ firstRun listenhost+		liftIO $ firstRun o  {- When run without a repo, start the first available listed repository in  - the autostart file. If none, it's our first time being run! -}-startNoRepo :: CmdParams -> IO ()-startNoRepo _ = do-	-- FIXME should be able to reuse regular getopt, but -	-- it currently runs in the Annex monad.-	args <- getArgs-	let listenhost = headMaybe $ map (snd . separate (== '=')) $ -		filter ("--listen=" `isPrefixOf`) args--	go listenhost =<< liftIO (filterM doesDirectoryExist =<< readAutoStartFile)+startNoRepo :: WebAppOptions -> IO ()+startNoRepo o = go =<< liftIO (filterM doesDirectoryExist =<< readAutoStartFile)   where-	go listenhost [] = firstRun listenhost-	go listenhost (d:ds) = do+	go [] = firstRun o+	go (d:ds) = do 		v <- tryNonAsync $ do 			setCurrentDirectory d 			Annex.new =<< Git.CurrentRepo.get 		case v of 			Left e -> do 				cannotStartIn d (show e)-				go listenhost ds+				go ds 			Right state -> void $ Annex.eval state $ do 				whenM (fromRepo Git.repoIsLocalBare) $ 					error $ d ++ " is a bare git repository, cannot run the webapp in it" 				callCommandAction $-					start' False listenhost+					start' False o  cannotStartIn :: FilePath -> String -> IO () cannotStartIn d reason = warningIO $ "unable to start webapp in repository " ++ d ++ ": " ++ reason@@ -139,8 +136,8 @@  - Note that it's important that mainthread never terminates! Much  - of this complication is due to needing to keep the mainthread running.  -}-firstRun :: Maybe HostName -> IO ()-firstRun listenhost = do+firstRun :: WebAppOptions -> IO ()+firstRun o = do 	checkEnvironmentIO 	{- Without a repository, we cannot have an Annex monad, so cannot 	 - get a ThreadState. This is only safe because the@@ -157,7 +154,7 @@ 		startNamedThread urlrenderer $ 			webAppThread d urlrenderer True Nothing 				(callback signaler)-				listenhost+				(listenAddress o) 				(callback mainthread) 		waitNamedThreads   where@@ -165,7 +162,7 @@ 		putMVar v "" 		takeMVar v 	mainthread v url htmlshim-		| isJust listenhost = do+		| isJust (listenAddress o)= do 			putStrLn url 			hFlush stdout 			go@@ -179,7 +176,7 @@ 			_wait <- takeMVar v 			state <- Annex.new =<< Git.CurrentRepo.get 			Annex.eval state $-				startDaemon True True Nothing Nothing listenhost $ Just $+				startDaemon True True Nothing Nothing (listenAddress o) $ Just $ 					sendurlback v 	sendurlback v _origout _origerr url _htmlshim = do 		recordUrl url
Command/Whereis.hs view
@@ -15,18 +15,29 @@ import Logs.Trust import Logs.Web -cmd :: [Command]-cmd = [noCommit $ withOptions (jsonOption : annexedMatchingOptions ++ keyOptions) $-	command "whereis" paramPaths seek SectionQuery-		"lists repositories that have file content"]+cmd :: Command+cmd = noCommit $ withGlobalOptions (jsonOption : annexedMatchingOptions) $+	command "whereis" SectionQuery+		"lists repositories that have file content"+		paramPaths (seek <$$> optParser) -seek :: CommandSeek-seek ps = do+data WhereisOptions = WhereisOptions+	{ whereisFiles :: CmdParams+	, keyOptions :: Maybe KeyOptions+	}++optParser :: CmdParamsDesc -> Parser WhereisOptions+optParser desc = WhereisOptions+	<$> cmdParams desc+	<*> optional (parseKeyOptions False)++seek :: WhereisOptions -> CommandSeek+seek o = do 	m <- remoteMap id-	withKeyOptions False+	withKeyOptions (keyOptions o) False 		(startKeys m) 		(withFilesInGit $ whenAnnexed $ start m)-		ps+		(whereisFiles o)  start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart start remotemap file key = start' remotemap key (Just file)
Command/XMPPGit.hs view
@@ -11,15 +11,18 @@ import Command import Assistant.XMPP.Git -cmd :: [Command]-cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $-	command "xmppgit" paramNothing seek-		SectionPlumbing "git to XMPP relay"]+cmd :: Command+cmd = noCommit $ dontCheck repoExists $+	noRepo (parseparams startNoRepo) $ +		command "xmppgit" SectionPlumbing "git to XMPP relay"+			paramNothing (parseparams seek)+  where+	parseparams = withParams -seek :: CommandSeek+seek :: CmdParams -> CommandSeek seek = withWords start -start :: [String] -> CommandStart+start :: CmdParams -> CommandStart start _ = do 	liftIO gitRemoteHelper 	liftIO xmppGitRelay
Makefile view
@@ -12,9 +12,7 @@ all=fast endif -build: build-stamp-build-stamp: $(all)-	touch $@+build: $(all)  Build/SysConfig.hs: configure.hs Build/TestConfig.hs Build/Configure.hs 	if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi@@ -48,6 +46,8 @@ 	install git-annex $(DESTDIR)$(PREFIX)/bin 	ln -sf git-annex $(DESTDIR)$(PREFIX)/bin/git-annex-shell 	./Build/InstallDesktopFile $(PREFIX)/bin/git-annex || true+	install -d $(DESTDIR)$(PREFIX)/share/bash-completion/completions+	install -m 0644 bash-completion.bash $(DESTDIR)$(PREFIX)/share/bash-completion/completions/git-annex  test: git-annex 	./git-annex test@@ -85,7 +85,7 @@  clean: 	rm -rf tmp dist git-annex $(mans) configure  *.tix .hpc \-		doc/.ikiwiki html dist tags Build/SysConfig.hs build-stamp \+		doc/.ikiwiki html dist tags Build/SysConfig.hs \ 		Setup Build/InstallDesktopFile Build/EvilSplicer \ 		Build/Standalone Build/OSXMkLibs Build/LinuxMkLibs \ 		Build/DistributionUpdate Build/BuildVersion \@@ -262,4 +262,4 @@ 	ghc -Wall --make Build/DistributionUpdate -XPackageImports -optP-include -optPdist/build/autogen/cabal_macros.h 	./Build/DistributionUpdate -.PHONY: git-annex git-union-merge git-recover-repository tags build-stamp+.PHONY: git-annex git-union-merge tags
Remote/Helper/Special.hs view
@@ -184,12 +184,14 @@ 	-- chunk, then encrypt, then feed to the storer 	storeKeyGen k f p enc = safely $ preparestorer k $ safely . go 	  where-		go (Just storer) = sendAnnex k rollback $ \src ->+		go (Just storer) = preparecheckpresent k $ safely . go' storer+		go Nothing = return False+		go' storer (Just checker) = sendAnnex k rollback $ \src -> 			displayprogress p k f $ \p' -> 				storeChunks (uuid baser) chunkconfig k src p' 					(storechunk enc storer)-					(checkPresent baser)-		go Nothing = return False+					checker+		go' _ Nothing = return False 		rollback = void $ removeKey encr k  	storechunk Nothing storer k content p = storer k content p
Test.hs view
@@ -1,6 +1,6 @@ {- git-annex test suite  -- - Copyright 2010-2013 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -9,7 +9,22 @@  module Test where +import Options.Applicative.Types++#ifndef WITH_TESTSUITE++import Options.Applicative (pure)++optParser :: Parser ()+optParser = pure ()++runner :: Maybe (() -> IO ())+runner = Nothing++#else+ import Test.Tasty+import Test.Tasty.Options import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck@@ -20,7 +35,6 @@  import Common -import qualified Utility.SubTasty import qualified Utility.SafeCommand import qualified Annex import qualified Annex.UUID@@ -81,19 +95,20 @@ import qualified Utility.Gpg #endif -main :: [String] -> IO ()-main ps = do-	opts <- Utility.SubTasty.parseOpts "test" ingredients tests ("test":ps)-	case tryIngredients ingredients opts tests of-		Nothing -> error "No tests found!?"-		Just act -> ifM act-			( exitSuccess-			, do-				putStrLn "  (This could be due to a bug in git-annex, or an incompatability"-				putStrLn "   with utilities, such as git, installed on this system.)"-				exitFailure-			)+optParser :: Parser OptionSet+optParser = suiteOptionParser ingredients tests +runner :: Maybe (OptionSet -> IO ())+runner = Just $ \opts -> case tryIngredients ingredients opts tests of+	Nothing -> error "No tests found!?"+	Just act -> ifM act+		( exitSuccess+		, do+			putStrLn "  (This could be due to a bug in git-annex, or an incompatability"+			putStrLn "   with utilities, such as git, installed on this system.)"+			exitFailure+		)+ ingredients :: [Ingredient] ingredients = 	[ listingTests@@ -1419,12 +1434,12 @@ git_annex :: String -> [String] -> IO Bool git_annex command params = do 	-- catch all errors, including normally fatal errors-	r <- try run::IO (Either SomeException ())+	r <- try run ::IO (Either SomeException ()) 	case r of 		Right _ -> return True 		Left _ -> return False   where-	run = GitAnnex.run (command:"-q":params)+	run = GitAnnex.run optParser Nothing (command:"-q":params)  {- Runs git-annex and returns its output. -} git_annex_output :: String -> [String] -> IO String@@ -1762,3 +1777,5 @@  backend_ :: String -> Types.Backend backend_ = Backend.lookupBackendName++#endif
Types/Command.hs view
@@ -1,6 +1,6 @@ {- git-annex command data types  -- - Copyright 2010-2011 Joey Hess <id@joeyh.name>+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -8,46 +8,52 @@ module Types.Command where  import Data.Ord+import Options.Applicative.Types (Parser)  import Types  {- A command runs in these stages.  -- - a. The check stage runs checks, that error out if+ - a. The parser stage parses the command line and generates a CommandSeek+ -    action. -}+type CommandParser = Parser CommandSeek+{- b. The check stage runs checks, that error out if  -    anything prevents the command from running. -} data CommandCheck = CommandCheck { idCheck :: Int, runCheck :: Annex () }-{- b. The seek stage takes the parameters passed to the command,- -    looks through the repo to find the ones that are relevant- -    to that command (ie, new files to add), and runs commandAction- -    to handle all necessary actions. -}-type CommandSeek = [String] -> Annex ()-{- c. The start stage is run before anything is printed about the+{- c. The seek stage is passed input from the parser, looks through+ -    the repo to find things to act on (ie, new files to add), and+ -    runs commandAction to handle all necessary actions. -}+type CommandSeek = Annex ()+{- d. The start stage is run before anything is printed about the  -    command, is passed some input, and can early abort it  -    if the input does not make sense. It should run quickly and  -    should not modify Annex state. -} type CommandStart = Annex (Maybe CommandPerform)-{- d. The perform stage is run after a message is printed about the command+{- e. The perform stage is run after a message is printed about the command  -    being run, and it should be where the bulk of the work happens. -} type CommandPerform = Annex (Maybe CommandCleanup)-{- e. The cleanup stage is run only if the perform stage succeeds, and it+{- f. The cleanup stage is run only if the perform stage succeeds, and it  -    returns the overall success/fail of the command. -} type CommandCleanup = Annex Bool  {- A command is defined by specifying these things. -} data Command = Command-	{ cmdoptions :: [Option]     -- command-specific options-	, cmdnorepo :: Maybe (CmdParams -> IO ()) -- an action to run when not in a repo-	, cmdcheck :: [CommandCheck] -- check stage+	{ cmdcheck :: [CommandCheck] -- check stage 	, cmdnocommit :: Bool        -- don't commit journalled state changes 	, cmdnomessages :: Bool      -- don't output normal messages 	, cmdname :: String-	, cmdparamdesc :: String     -- description of params for usage-	, cmdseek :: CommandSeek+	, cmdparamdesc :: CmdParamsDesc -- description of params for usage 	, cmdsection :: CommandSection 	, cmddesc :: String          -- description of command for usage+	, cmdparser :: CommandParser -- command line parser+	, cmdnorepo :: Maybe (Parser (IO ())) -- used when not in a repo 	} +{- Command-line parameters, after the command is selected and options+ - are parsed. -} type CmdParams = [String]++type CmdParamsDesc = String  {- CommandCheck functions can be compared using their unique id. -} instance Eq CommandCheck where
+ Types/DeferredParse.hs view
@@ -0,0 +1,42 @@+{- git-annex deferred parse values+ -+ - Copyright 2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE FlexibleInstances #-}++module Types.DeferredParse where++import Annex+import Common++import Options.Applicative++-- Some values cannot be fully parsed without performing an action.+-- The action may be expensive, so it's best to call finishParse on such a+-- value before using getParsed repeatedly.+data DeferredParse a = DeferredParse (Annex a) | ReadyParse a++class DeferredParseClass a where+	finishParse :: a -> Annex a++getParsed :: DeferredParse a -> Annex a+getParsed (DeferredParse a) = a+getParsed (ReadyParse a) = pure a++instance DeferredParseClass (DeferredParse a) where+	finishParse (DeferredParse a) = ReadyParse <$> a+	finishParse (ReadyParse a) = pure (ReadyParse a)++instance DeferredParseClass (Maybe (DeferredParse a)) where+	finishParse Nothing = pure Nothing+	finishParse (Just v) = Just <$> finishParse v++instance DeferredParseClass [DeferredParse a] where+	finishParse v = mapM finishParse v++-- Use when the Annex action modifies Annex state.+type GlobalSetter = DeferredParse ()+type GlobalOption = Parser GlobalSetter
+ Types/Test.hs view
@@ -0,0 +1,22 @@+{- git-annex test data types.+ -+ - Copyright 2011-2015 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Types.Test where++#ifdef WITH_TESTSUITE+import Test.Tasty.Options+#endif++#ifdef WITH_TESTSUITE+type TestOptions = OptionSet+#else+type TestOptions = ()+#endif++type TestRunner = TestOptions -> IO ()
Utility/HumanTime.hs view
@@ -17,7 +17,6 @@ ) where  import Utility.PartialPrelude-import Utility.Applicative import Utility.QuickCheck  import qualified Data.Map as M@@ -45,8 +44,8 @@ daysToDuration i = Duration $ i * dsecs  {- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}-parseDuration :: String -> Maybe Duration-parseDuration = Duration <$$> go 0+parseDuration :: Monad m => String -> m Duration+parseDuration = maybe parsefail (return . Duration) . go 0   where 	go n [] = return n 	go n s = do@@ -56,6 +55,7 @@ 				u <- M.lookup c unitmap 				go (n + num * u) rest 			_ -> return $ n + num+	parsefail = fail "duration parse error; expected eg \"5m\" or \"1h5m\""  fromDuration :: Duration -> String fromDuration Duration { durationSeconds = d }
− Utility/SubTasty.hs 
@@ -1,25 +0,0 @@-{- Running tasty as a subcommand.- -- - Copyright 2015 Joey Hess <id@joeyh.name>- -- - License: BSD-2-clause- -}--module Utility.SubTasty where--import Test.Tasty-import Test.Tasty.Options-import Test.Tasty.Runners-import Options.Applicative---- Uses tasty's option parser, modified to expect a subcommand.-parseOpts :: String -> [Ingredient] -> TestTree -> [String] -> IO OptionSet-parseOpts subcommand is ts = -	handleParseResult . execParserPure (prefs idm) pinfo-  where-	pinfo = info (helper <*> subpinfo) (fullDesc <> header desc)-	subpinfo = subparser $ command subcommand $ -		suiteOptionParser is ts-			`info`-		progDesc desc-	desc = "Builtin test suite"
+ bash-completion.bash view
@@ -0,0 +1,37 @@+# Use git-annex's built-in bash completion+# This bash completion is generated by the option parser, so it covers all+# commands, all options, and will never go out of date!+_git-annex()+{+    local cmdline+    CMDLINE=(--bash-completion-index $COMP_CWORD)++    for arg in ${COMP_WORDS[@]}; do+        CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)+    done++    COMPREPLY=( $(git-annex "${CMDLINE[@]}") )+}++complete -o bashdefault -o default -o filenames -F _git-annex git-annex++# Called by git's bash completion script when completing "git annex"+_git_annex() {+    local cmdline+    CMDLINE=(--bash-completion-index $(($COMP_CWORD - 1)))++    local seen_git+    local seen_annex+    for arg in ${COMP_WORDS[@]}; do+        if [ "$arg" = git ] && [ -z "$seen_git" ]; then+		seen_git=1+		CMDLINE=(${CMDLINE[@]} --bash-completion-word git-annex)+	elif [ "$arg" = annex ] && [ -z "$seen_annex" ]; then+		seen_annex=1+	else+		CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)+	fi+    done++    COMPREPLY=( $(git-annex "${CMDLINE[@]}") )+}
debian/changelog view
@@ -1,3 +1,41 @@+git-annex (5.20150727) unstable; urgency=medium++  * Fix bug that prevented uploads to remotes using new-style chunking+    from resuming after the last successfully uploaded chunk.+  * Switched option parsing to use optparse-applicative. This was a very large+    and invasive change, and may have caused some minor behavior changes to+    edge cases of option parsing. (For example, the metadata command no+    longer accepts the combination of --get and --set, which never actually+    worked.)+  * Bash completion file is now included in the git-annex source tree, +    and installed into Debian package (and any other packages built using make+    install). This bash completion is generated by the option parser, so it+    covers all commands, all options, and will never go out of date!+  * As well as tab completing "git-annex" commands, "git annex" will also tab+    complete. However, git's bash completion script needs a patch,+    which I've submitted, for this to work prefectly.+  * version --raw now works when run outside a git repository.+  * assistant --startdelay now works when run outside a git repository.+  * dead now accepts multiple --key options.+  * addurl now accepts --prefix and --suffix options to adjust the+    filenames used.+  * sync --content: Fix bug that caused files to be uploaded to eg,+    more archive remotes than wanted copies, only to later be dropped+    to satisfy the preferred content settings.+  * importfeed: Improve detection of known items whose url has changed,+    and avoid adding redundant files. Where before this only looked at+    permalinks in rss feeds, it now also looks at guids.+  * importfeed: Look at not only permalinks, but now also guids+    to identify previously downloaded files.+  * Webapp: Now features easy setup of git-annex repositories on gitlab.com.+  * Adjust debian build deps: The webapp can now build on arm64, s390x+    and hurd-i386. WebDAV support is also available on those architectures.+  * Debian package now maintained by Richard Hartmann.+  * Support building without persistent database on for systems that+    lack TH. This removes support for incremental fsck.++ -- Joey Hess <id@joeyh.name>  Mon, 27 Jul 2015 12:24:49 -0400+ git-annex (5.20150710) unstable; urgency=medium    * add: Stage symlinks the same as git add would, even if they are not a@@ -282,7 +320,7 @@     downloader prefix from logged url info before checking for the     specified prefix.   * importfeed: Avoid downloading a redundant item from a feed whose-    guid has been downloaded before, even when the url has changed.+    permalink has been seen before, even when the url has changed.   * importfeed: Always store itemid in metadata; before this was only     done when annex.genmetadata was set.   * Relax debian package dependencies to git >= 1:1.8.1 rather
debian/control view
@@ -15,7 +15,6 @@ 	libghc-aws-dev (>= 0.9.2-2~), 	libghc-conduit-dev, 	libghc-resourcet-dev,-	libghc-dav-dev (>= 1.0) [amd64 armel armhf i386 kfreebsd-amd64 kfreebsd-i386 powerpc ppc64el hurd-i386], 	libghc-quickcheck2-dev, 	libghc-monad-control-dev (>= 0.3), 	libghc-exceptions-dev (>= 0.6),@@ -32,17 +31,22 @@ 	libghc-stm-dev (>= 2.3), 	libghc-dbus-dev (>= 0.10.7) [linux-any], 	libghc-fdo-notify-dev (>= 0.3) [linux-any],-	libghc-yesod-dev (>= 1.2.6.1) [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],-	libghc-yesod-core-dev (>= 1.2.19) [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],-	libghc-yesod-form-dev (>= 1.3.15) [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],-	libghc-yesod-static-dev (>= 1.2.4) [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],-	libghc-yesod-default-dev (>= 1.2.0) [i386 amd64 armel armhf kfreebsd-amd64 powerpc ppc64el],-	libghc-shakespeare-dev (>= 2.0.0) [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],-	libghc-clientsession-dev [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],-	libghc-warp-dev (>= 3.0.0.5) [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],-	libghc-warp-tls-dev [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],-	libghc-wai-dev [i386 amd64 kfreebsd-i386 armel armhf kfreebsd-amd64 powerpc ppc64el],-	libghc-wai-extra-dev [i386 amd64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el],+	libghc-yesod-dev (>= 1.2.6.1)       [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-yesod-core-dev (>= 1.2.19)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-yesod-form-dev (>= 1.3.15)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-yesod-static-dev (>= 1.2.4)  [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-yesod-default-dev (>= 1.2.0) [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-shakespeare-dev (>= 2.0.0)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-clientsession-dev            [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-warp-dev (>= 3.0.0.5)        [i386 amd64 armel armhf armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-warp-tls-dev                 [i386 amd64 armel armhf armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-wai-dev                      [i386 amd64 armel armhf armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-wai-extra-dev                [i386 amd64 armel armhf armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-dav-dev (>= 1.0)             [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-persistent-dev               [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-persistent-template-dev      [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-persistent-sqlite-dev        [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386],+	libghc-esqueleto-dev                [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 powerpc ppc64el s390x hurd-i386], 	libghc-securemem-dev, 	libghc-byteable-dev, 	libghc-dns-dev,@@ -58,10 +62,6 @@ 	libghc-gnutls-dev (>= 0.1.4), 	libghc-xml-types-dev, 	libghc-async-dev,-	libghc-persistent-dev,-	libghc-persistent-template-dev,-	libghc-persistent-sqlite-dev,-	libghc-esqueleto-dev, 	libghc-monad-logger-dev, 	libghc-feed-dev (>= 0.3.9.2), 	libghc-regex-tdfa-dev,@@ -70,7 +70,7 @@ 	libghc-tasty-quickcheck-dev, 	libghc-tasty-rerun-dev, 	libghc-optparse-applicative-dev (>= 0.10),-	lsof [!kfreebsd-i386 !kfreebsd-amd64 !hurd-any],+	lsof [linux-any], 	ikiwiki, 	perlmagick, 	git (>= 1:1.8.1),@@ -79,7 +79,7 @@ 	curl, 	openssh-client, 	git-remote-gcrypt (>= 0.20130908-6),-Maintainer: Gergely Nagy <algernon@madhouse-project.org>+Maintainer: Richard Hartmann <richih@debian.org> Standards-Version: 3.9.6 Vcs-Git: git://git.kitenet.net/git-annex Homepage: http://git-annex.branchable.com/
doc/bugs/Installation_on_ArchLinux_fails.mdwn view
@@ -31,3 +31,6 @@     error: target not found: haskell-hs3  as these packages are not available on AUR.++> I have updated the arch documentation to replace the failing package with+> the haskell-core one. [[done]] --[[Joey]]
− doc/bugs/Metadata_changes_are_not_reflected_in_a_view.mdwn 
@@ -1,31 +0,0 @@-### Please describe the problem.-Changing metadata while being in an active view will not update the view.--### What steps will reproduce the problem?-(inside a repository)--1. Create a file--        $ uuidgen >file--2. switch into a view--       $ git annex view !blah-       $ ls-       file--3. changed the metadata the view is based upon--       $ git annex metadata -t blah file-       $ ls-       file--   It would be nice/expected that the view gets updated when the metadata changes, hiding 'file' now-  --### What version of git-annex are you using? On what operating system?--git-annex version: 5.20141024~bpo70+1-on debian wheezy with backports--### Please provide any additional information below.
+ doc/bugs/OOM_while_configuring_git-annex.mdwn view
@@ -0,0 +1,46 @@+### Please describe the problem.+When running configure, the system runs out of memory:++[[https://kojipkgs.fedoraproject.org//work/tasks/1587/10431587/build.log]]++built with versions from:++[[https://kojipkgs.fedoraproject.org//work/tasks/1587/10431587/root.log]]++### What steps will reproduce the problem?+Rebuilding on koji. Also occurs in mock. Haven't tried a naked build (yet).++### What version of git-annex are you using? On what operating system?+Currently, 5.20141203. Newest snapshot requires deps not yet packaged in Fedora.++### Please provide any additional information below.++[[!format sh """++ ./Setup configure --prefix=/usr --libdir=/usr/lib --docdir=/usr/share/doc/git-annex '--libsubdir=$compiler/$pkgid' '--datasubdir=$pkgid' --ghc --enable-executable-dynamic '--ghc-options= -optc-O2 -optc-g -optc-pipe -optc-Wall -optc-Werror=format-security -optc-Wp,-D_FORTIFY_SOURCE=2 -optc-fexceptions -optc-fstack-protector-strong -optc--param=ssp-buffer-size=4 -optc-grecord-gcc-switches -optc-specs=/usr/lib/rpm/redhat/redhat-hardened-cc1 -optc-m32 -optc-march=i686 -optc-mtune=atom -optc-fasynchronous-unwind-tables  -optl-Wl,-z,relro'+  checking version...fatal: Not a git repository (or any of the parent directories): .git+ 5.20141203+  checking UPGRADE_LOCATION... not available+  checking git... yes+  checking git version... 2.4.6+  checking cp -a... yes+  checking cp -p... yes+  checking cp --preserve=timestamps... yes+  checking cp --reflink=auto... yes+  checking xargs -0... yes+  checking rsync... yes+  checking curl... yes+  checking wget... no+  checking bup... no+  checking nice... yes+  checking ionice... yes+  checking nocache... no+  checking gpg... gpg2+  checking lsof... not available+  checking git-remote-gcrypt... not available+  checking ssh connection caching... yes+  checking sha1... sha1sum+  checking sha256... sha256sum+  checking sha512... sha512sum+  checking sha224... sha224sum+  checking sha384...Setup: out of memory (requested 1048576 bytes)+"""]]
+ doc/bugs/cannot_change_locale___40__en__95__US.UTF-8__41__.mdwn view
@@ -0,0 +1,30 @@+### Please describe the problem.++All git annex commands run successfully but are prefixed by an annoying error message:++"/bin/sh: warning: setlocale: LC_ALL: cannot change locale (en_US.UTF-8)"+++### What steps will reproduce the problem?++`git annex init` or just about any git annex command.+++### What version of git-annex are you using? On what operating system?++git-annex version: 5.20150710-g8fd7052 on arch linux 4.0.7-2.++### Please provide any additional information below.++# locale -a +C+en_US+en_US.iso88591+en_US.utf8+hebrew+he_IL+he_IL.iso88598+he_IL.utf8+POSIX++
+ doc/bugs/enabling_existing_gitlab_repo_in_webapp_broken.mdwn view
@@ -0,0 +1,6 @@+Enabling a gitlab repo that was set up elsewhere in the webapp doesn't+work.++This is a SMOP; it needs to detect that the repo is on gitlab and use a+custom enabling process and no the generic one, which doesn't work.+--[[Joey]]
doc/bugs/git_annex_sync_--content_may_copy_then_drop_a_file_to_a_remote.mdwn view
@@ -31,3 +31,5 @@  # End of transcript or log. """]]++> [[fixed|done]] --[[Joey]]
doc/bugs/git_annex_sync_--content_not_syncing_all_objects.mdwn view
@@ -31,3 +31,6 @@ """]]  [[!tag confirmed]]++> `git annex sync --content --all` was added in version 5.20150617.+> [[done]] --[[Joey]]
+ doc/bugs/gitlab_repos_cannot_use_gcrypt.mdwn view
@@ -0,0 +1,12 @@+It's not possible to use gcrypt with gitlab repos, despite the webapp+currently offering this as an option. The resulting remote works as far as+pushes go, but fails with an error "Failed to connect to remote to set it+up."++It seems that the gitlab repo is somehow in a state where git-annex-shell+configlist reports it's not yet a git-annex repo, but git-annex-shell+gcryptsetup fails with "gcryptsetup refusing to run; this repository already has a git-annex uuid!"++This does not happen when I try the same setup on a self-hosted repo.+Unsure what is causing git-annex-shell to behave this way on gitlab.+--[[Joey]]
doc/bugs/importfeed_can__39__t_deal_with_pycon_rss_feeds.mdwn view
@@ -23,3 +23,6 @@     curl -s http://pyvideo.org/category/65/pycon-us-2015/rss | xmllint --xpath '//enclosure/@url' - | sed 's/url="/\n/g;s/"//' | while read url ; do git annex addurl --fast $url ; done  but it's pretty ugly! --[[anarcat]]++> Per my comments, I don't think this is a bug in git-annex, but in the+> feeds. So [[done]] --[[Joey]]
+ doc/bugs/rsync_remote_with_-J2_fails.mdwn view
@@ -0,0 +1,55 @@+### Please describe the problem.++Trying to `git annex copy` to an rsync special remote with the -J flag fails with a lot of errors. (And is slow without it).++### What steps will reproduce the problem?++$ git annex copy --to rsync-remote -J2++### What version of git-annex are you using? On what operating system?++5.20150710-g8fd7052 on Ubuntu.++### Please provide any additional information below.++[[!format sh """+$ git annex copy --to freenas-rsync -J2+E: file has vanished: "/media/depot/annex/.git/annex/tmp/rsynctmp/29637/caa/2d1/SHA256E-s4244--4ec1ea09c7605a589a9bf6cd927e96737c512d17d8053cbfaf0dcd364702400c.txt/SHA256E-s4244--4ec1ea09c7605a589a9bf6cd927e96737c512d17d8053cbfaf0dcd364702400c.txt"+E: rsync warning: some files vanished before they could be transferred (code 24) at main.c(1183) [sender=3.1.1]+E: rsync: change_dir "/media/depot/annex//.git/annex/tmp/rsynctmp/29637" failed: No such file or directory (2)+E: rsync error: some files/attrs were not transferred (see previous errors) (code 23) at main.c(1183) [sender=3.1.1]+  .git/annex/tmp/rsynctmp/29637/c17: removeDirectory: does not exist (No such file or directory)+  .git/annex/tmp/rsynctmp/29637: getDirectoryContents: does not exist (No such file or directory)+  .git/annex/tmp/rsynctmp/29637/67e: removeLink: does not exist (No such file or directory)+  .git/annex/tmp/rsynctmp/29637: getDirectoryContents: does not exist (No such file or directory)+  .git/annex/tmp/rsynctmp/29637: getDirectoryContents: does not exist (No such file or directory)+  .git/annex/tmp/rsynctmp/29637/49e/833: removeLink: inappropriate type (Is a directory)+^C++J1 hangs a long time:+$ git annex copy --to freenas-rsync -J1+^C++Works without J flag:+$ git annex copy --to freenas-rsync +copy GarageBand/._.DS_Store (checking freenas-rsync...) ok+copy GarageBand/._My Song.band (checking freenas-rsync...) ok+copy GarageBand/._code monkey.band (checking freenas-rsync...) ok+copy GarageBand/._first of may.band (checking freenas-rsync...) ok++Version:+$ git annex version+git-annex version: 5.20150710-g8fd7052+build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA+key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E MD5E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 MD5 WORM URL+remote types: git gcrypt S3 bup directory rsync web bittorrent webdav tahoe glacier ddar hook external+local repository version: 5+supported repository version: 5+upgrade supported from repository versions: 0 1 2 4++Repo config:+[remote "freenas-rsync"]+	annex-rsyncurl = freenas:/mnt/tank/home/jnewsome/annex-rsync-backend+	annex-uuid = f05581cc-7236-41ed-9db8-49424f863307++"""]]
+ doc/bugs/sync__47__git-annex_branch_not_syncing_in_the_assistant.mdwn view
@@ -0,0 +1,49 @@+### Please describe the problem.++It seems that the `synced/git-annex` branch (which I am a little confused about in the first place), doesn't get synced automatically by the assistant.++I was expecting the assistant to regularly do the equivalent of `git annex sync`. However, after a client pushed changes to the `git-annex` branch, I had to manually do a `git annex sync` for the changes of the `synced/git-annex` branch to be merged down into the local `git-annex`.++### What steps will reproduce the problem?++I have 3 machines in this setup (to simplify: there are more, but those are sufficient). Let's call them foo, bar and quux. foo and quuex are connected to bar through password-less SSH connexions.++foo commits a file to git-annex. the assistant syncs that to bar in the `synced/git-annex` branch.++quux syncs with bar, and seems to ignore the `synced/git-annex` branch.++git-annex sync on quux syncs the `synced/git-annex` branch into the local `git-annex`, working around the issue.++### What version of git-annex are you using? On what operating system?++foo is 5.20150610+gitg608172f-1~ndall+1 on Debian 7.8 (wheezy).++bar and quux are 5.20150409+git126-ga29f683-1~ndall+1 and 5.20150610+gitg608172f-1~ndall+1 (respectively) on Ubuntu 12.04 (precise) .++### Please provide any additional information below.++I guess a more general question is how and how often do those branches get merged by the assistant... it's still unclear to me how this works.++[[!format sh """+$ sudo -u www-data -H git annex sync+(merging origin/synced/git-annex into git-annex...)+(recording state in git...)+commit  ok+pull origin+Auto packing the repository in background for optimum performance.+See "git help gc" for manual housekeeping.++Already up-to-date.+ok+push origin+Counting objects: 373637, done.+# End of transcript or log.+"""]]++This was started at 20:23 UTC. Note that the sync had run previously under the assistant:++<pre>+[2015-07-22 20:09:06 UTC] RemoteControl: Syncing with origin+</pre>++Available, as usual, for further debugging. :) -- [[anarcat]]
+ doc/devblog/day_299__so_many_commands_and_options.mdwn view
@@ -0,0 +1,9 @@+Day 3 of the optparse-applicative conversion.  +116 files changed, 1607 insertions(+), 1135 deletions(-)  +At this point, everything is done except for around 20 sub-commands.+Probably takes 15 minutes work for each. Will finish plowing through+it in the evenings.++Meanwhile, made the release of version 5.20150710. The Android build for+this version is not available yet, since I broke the autobuilder last week+and haven't fixed it yet.
+ doc/devblog/day_300__optparse-applicative_landed.mdwn view
@@ -0,0 +1,3 @@+Worked through the rest of the changes this weekend and morning, and the+optparse-applicative branch has landed in master,+including bash completion support.
+ doc/devblog/day_301__completion_and_er_completion.mdwn view
@@ -0,0 +1,9 @@+Worked on bash tab completion some more. Got "git annex" to also tab complete.+However, for that to work perfectly when using bash-completion to demand-load+completion scripts, a small improvement is needed in git's own completion+script, to have it load git-annex's completion script. I sent a +[patch for that to the git developers](http://thread.gmane.org/gmane.comp.version-control.git/274034),+and hopefully it'll get accepted soon.++Then fixed a relatively long-standing bug that prevented uploads to+chunked remotes from resuming after the last successfully uploaded chunk.
+ doc/devblog/day_302-305__gitlab.mdwn view
@@ -0,0 +1,30 @@+I've been working on adding GitLab support to the webapp for the past 3+days.++That's not the only thing I've been working on; I've continued to work on+the older parts of the backlog, which is now shrunk to 91 messages, and+made some minor improvements and bugfixes.++But, GitLab support in the webapp has certianly taken longer than I'd have+expected. Only had to write 82 lines of GitLab specific code so far, but it+went slowly. The user will need to cut and paste repository url and+ssh public key back and forth between the webapp and GitLab for now. And+the way GitLab repositories use git-annex makes it a bit tricky to set up;+in one case the webapp has to do a forced push dry run to check if the+repository on GitLab can be accessed by ssh.++I found a way to adapt the existing code for setting up a ssh server to+also support GitLab, so beyond the repo url prompt and ssh key setup,+everything will be reused. I have something that works now, but there are+lots of cases to test (encrypted repositories, enabling existing+repositories, etc), so will need to work on it a bit more before merging+this feature.++Also took some time to split the [centralized git repository tutorial](http://git-annex.branchable.com/tips/centralized_git_repository_tutorial/)+into three parts, one for each of GitHub, GitLab, and self-administered servers.++----++The git-annex package in Debian unstable hasn't been updated for 8 months.+This is about to change; Richard Hartmann has stepped up and is preparing+an upload of a recent version. Yay!
+ doc/forum/Exclude_specific_files_from_a_special_remote.mdwn view
@@ -0,0 +1,3 @@+I have a special remote configured to/from which I can copy files correctly.+I would like to be prevent some annexed files to be copied to this remote, automatically (in other words, without excluding them manually on the command line)+How can this be done?
+ doc/forum/Full_restore_from_an_encrypted_special_remote.mdwn view
@@ -0,0 +1,3 @@+If I lose all my git-annex repositories is it possible to restore the content of a repo from a special remote in which encryption was enabled? I know git-annex isn't designed to be a backup solution but more for the archive and/or nomad use case. I do like the idea of being able to restore the files from an S3 special remote though. I imagine part of the answer to this question has to do with what type of encryption is used (hybrid and shared key rely on information stored in the repo but pubkey doesn't rely on the repo at all) and would probably be easier if there were an option to disable hashing the filenames of the files (less secure, but maybe ok in some cases).++Thoughts?
+ doc/forum/Is_setting_core.preloadindex_safe_with_git_annex__63__.mdwn view
@@ -0,0 +1,1 @@+I found [this suggestion](http://stackoverflow.com/a/2873039) on Stack Overflow. Is this safe to use in git annex? I don't know how the internals work. I have a very large annex and I don't want to screw it up.
+ doc/forum/Windows_-_You_don__39__t_have_access.mdwn view
@@ -0,0 +1,42 @@+git version: 1.9.5.msysgit.1+git-annex version: 5.20150710-g8fd7052++I have a repo up on GitLab. I have annex’d files in that repo. On a Linux server I can “git annex sync” and then “git annex get” just fine. On Windows when I try to run “git annex sync” I get:++GitLab: You don't have access++  Remote origin does not have git-annex installed; setting annex-ignore++  This could be a problem with the git-annex installation on the remote. Please make sure that git-a+nnex-shell is available in PATH when you ssh into the remote. Once you have fixed the git-annex inst+allation, run: git config remote.origin.annex-ignore false+commit  ok+pull origin+git-annex.exe: unknown command git@gitlab.server.com+…+fatal: Could not read from remote repository.++Please make sure you have the correct access rights+and the repository exists.+failed+git-annex: sync: 1 failed++I have access to the repo however. I can git pull/push…whatever. It’s just annex that is having problems with access and I’m not sure why. Here is my git config:++[core]+        repositoryformatversion = 0+        filemode = false+        bare = false+        logallrefupdates = true+        symlinks = false+        ignorecase = true+        hideDotFiles = dotGitOnly+[remote "origin"]+        url = git@gitlab.company.com:repo.git+        fetch = +refs/heads/*:refs/remotes/origin/*+        annex-ignore = false+[annex]+        uuid = 2noa1e70-9f88-4did-843c-3f8sdf3495990+        sshcaching = false+        crippledfilesystem = true+        version = 5
+ doc/forum/git-annex_does_not_protect_files_on_NTFS-Fuse.mdwn view
@@ -0,0 +1,8 @@+I've read that git-annex probes the host filesystem to determine whether it has the necessary features for an indirect annex. Indirect annexes are supposed to protect annexed files from accidental editing:++    # echo oops > my_cool_big_file+    bash: my_cool_big_file: Permission denied++I have an NTFS drive to share files between my Windows and Linux systems (dual boot). On Linux fuse sets the file permissions to rwx for the user and nothing for the rest, and this cannot be changed. Files in the annex can be modified as in the above example.++If git-annex detects whether a fs can handle indirect annexes or not, I suggest checking for this case if possible.
+ doc/forum/git-annex_fails_on_Windows.mdwn view
@@ -0,0 +1,56 @@+Not sure if this is a bug or user error. I'm trying to use git-annex on Windows 2008 R2, but it isn't working for me. Works fine on Linux. I have a local git repo and then added some binary files to annex. Then I used git annex sync --content to push ennex'd files up to git server. Then I can clone that repo and sync again to pull all the files down. On windows I just get error messages when I try to clone the repo and use annex to init or sync.++git version: 1.8.0.msysgit.0+git-annex version:+git-annex version: 5.20150710-g8fd7052+build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV DNS Feeds Quvi TDFA TorrentP+arser+key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E MD5E SHA256 SHA1 SHA51+2 SHA224 SHA384 SKEIN256 SKEIN512 MD5 WORM URL+remote types: git gcrypt S3 bup directory rsync web bittorrent webdav tahoe glacier ddar hook extern+al+local repository version: unknown+supported repository version: 5+upgrade supported from repository versions: 2 3 4++If I try to init the cloned repo:++$ git-annex init+init  Unknown option: --literal-pathspecs+usage: git [--version] [--exec-path[=<path>]] [--html-path] [--man-path] [--info-path]+           [-p|--paginate|--no-pager] [--no-replace-objects] [--bare]+           [--git-dir=<path>] [--work-tree=<path>] [--namespace=<name>]+           [-c name=value] [--help]+           <command> [<args>]+Unknown option: --literal-pathspecs+usage: git [--version] [--exec-path[=<path>]] [--html-path] [--man-path] [--info-path]+           [-p|--paginate|--no-pager] [--no-replace-objects] [--bare]+           [--git-dir=<path>] [--work-tree=<path>] [--namespace=<name>]+           [-c name=value] [--help]+           <command> [<args>]+Unknown option: --literal-pathspecs+usage: git [--version] [--exec-path[=<path>]] [--html-path] [--man-path] [--info-path]+           [-p|--paginate|--no-pager] [--no-replace-objects] [--bare]+           [--git-dir=<path>] [--work-tree=<path>] [--namespace=<name>]+           [-c name=value] [--help]+           <command> [<args>]+Unknown option: --literal-pathspecs+usage: git [--version] [--exec-path[=<path>]] [--html-path] [--man-path] [--info-path]+           [-p|--paginate|--no-pager] [--no-replace-objects] [--bare]+           [--git-dir=<path>] [--work-tree=<path>] [--namespace=<name>]+           [-c name=value] [--help]+           <command> [<args>]+git-annex.exe: git [Param "config",Param "user.name",Param "user"] failed++If I try to sync:++$ git annex sync --content+Unknown option: --literal-pathspecs+usage: git [--version] [--exec-path[=<path>]] [--html-path] [--man-path] [--info-path]+           [-p|--paginate|--no-pager] [--no-replace-objects] [--bare]+           [--git-dir=<path>] [--work-tree=<path>] [--namespace=<name>]+           [-c name=value] [--help]+           <command> [<args>]+git-annex: First run: git-annex init++What am I missing? I love the idea of annex and really need it for an urgent project I'm working on, but unfortunately I need to use it with Windows...in addition to Linux.
+ doc/forum/importfeed_does_not_work_with_youtube_anymore.mdwn view
@@ -0,0 +1,1 @@+Did youtube change their api? My youtube feeds doesn't work anymore. No problems with other sites.
doc/git-annex-addurl.mdwn view
@@ -48,12 +48,21 @@  * `--pathdepth=N` -  This causes a shorter filename to be used. For example,-   `--pathdepth=1` will use "dir/subdir/bigfile",-   while `--pathdepth=3` will use "bigfile". +  Rather than basing the filename on the whole url, this causes a path to+  be constructed, starting at the specified depth within the path of the+  url. +  For example, adding the url http://www.example.com/dir/subdir/bigfile+  with `--pathdepth=1` will use "dir/subdir/bigfile",+  while `--pathdepth=3` will use "bigfile". +   It can also be negative; `--pathdepth=-2` will use the last   two parts of the url.++* `--prefix=foo` `--suffix=bar`++  Use to adjust the filenames that are created by addurl. For example,+  `--suffix=.mp3` can be used to add an extension to the file.  # SEE ALSO
doc/git-annex-drop.mdwn view
@@ -1,6 +1,6 @@ # NAME -git-annex drop - indicate content of files not currently wanted+git-annex drop - remove content of files from repository  # SYNOPSIS
doc/git-annex-fsck.mdwn view
@@ -1,6 +1,6 @@ # NAME -git-annex fsck - check for problems+git-annex fsck - find and fix problems  # SYNOPSIS
doc/git-annex-importfeed.mdwn view
@@ -15,7 +15,7 @@  When quvi is installed, links in the feed are tested to see if they are on a video hosting site, and the video is downloaded. This allows-importing e.g., youtube playlists.+importing e.g., YouTube playlists.  To make the import process add metadata to the imported files from the feed, `git config annex.genmetadata true`@@ -34,7 +34,7 @@      Other available variables for templates: feedauthor, itemauthor, itemsummary, itemdescription, itemrights, itemid, itempubdate, title, author -* `--relaxed`, `--fast`, `--raw`, `--template`+* `--relaxed`, `--fast`, `--raw`    These options behave the same as when using [[git-annex-addurl]](1).
doc/git-annex-view.mdwn view
@@ -19,7 +19,8 @@    Once within such a view, you can make additional directories, and copy or move files into them. When you commit, the metadata will-be updated to correspond to your changes.+be updated to correspond to your changes. Deleting files and committing+also updates the metadata.    There are fields corresponding to the path to the file. So a file "foo/bar/baz/file" has fields "/=foo", "foo/=bar", and "foo/bar/=baz".
doc/git-annex.mdwn view
@@ -1059,7 +1059,7 @@ * `remote.<name>.annex-rsync-options`    Options to use when using rsync-  to or from this remote. For example, to force ipv6, and limit+  to or from this remote. For example, to force IPv6, and limit   the bandwidth to 100Kbyte/s, set it to `-6 --bwlimit 100`  * `remote.<name>.annex-rsync-upload-options`@@ -1110,7 +1110,7 @@ * `annex.web-options`    Options to pass when running wget or curl.-  For example, to force ipv4 only, set it to "-4"+  For example, to force IPv4 only, set it to "-4"  * `annex.quvi-options`
doc/install/ArchLinux.mdwn view
@@ -1,12 +1,10 @@-There are four non non-official packages for git-annex in the Arch Linux User Repository. Any of these may be installed manually per [AUR guidelines](https://wiki.archlinux.org/index.php/AUR_User_Guidelines#Installing_packages) or using a wrapper such as [`yaourt`](https://wiki.archlinux.org/index.php/yaourt) shown below.+There are at least four non non-official packages for git-annex in the Arch Linux User Repository. Any of these may be installed manually per [AUR guidelines](https://wiki.archlinux.org/index.php/AUR_User_Guidelines#Installing_packages) or using a wrapper such as [`yaourt`](https://wiki.archlinux.org/index.php/yaourt) shown below.  1. The simplest method is to use the [git-annex-bin](https://aur.archlinux.org/packages/git-annex-bin/) package based on the [prebuilt Linux tarballs](http://downloads.kitenet.net/git-annex/linux/current/). This package includes many of the binary shims from the pre-built package. Although common Linux system utilities have been stripped in favor of normal dependencies, the pre-configured Haskell libraries included out of the box make this an easy install. The disadvantage is the resulting installation is a bit on the heavy side at nearly 100M.         $ yaourt -Sy git-annex-bin -2. A more traditional source package is available at [git-annex](https://aur.archlinux.org/packages/git-annex/). This depends on a large number of Haskell packages available from a third party repository or through Cabal. You must either enable a 3rd party repo that has the dependencies or have a working Cabal installation. Unless you know what you are doing this is a bit problematic and some intervention may be required to get this option to work. The state of available dependency versions also varies so this may not work at all times.--       $ yaourt -Sy git-annex+2. A git-annex package is available in the haskell-core AUR <https://wiki.archlinux.org/index.php/ArchHaskell>  3. A development package is available at [git-annex-git](https://aur.archlinux.org/packages/git-annex-git/) that functions similarly to the source package but builds directly from the HEAD of the git repository rather that the last official release.
+ doc/install/ArchLinux/comment_7_97d611f1ae6d4fbe91f84f9fe739f368._comment view
@@ -0,0 +1,13 @@+[[!comment format=mdwn+ username="dropped"+ subject="Correct way to install git-annex directly through cabal."+ date="2015-07-27T12:01:34Z"+ content="""+The effective way to install git-annex and resolve dependencies:++    $ sudo pacman -S gsasl git rsync curl wget gnupg openssh cabal-install+    $ cabal update+    $ cabal install c2hs+    $ cabal install git-annex --bindir=$HOME/bin+    $ sudo cp ~/bin/git-annex /usr/lib/git-core+"""]]
doc/install/ScientificLinux5.mdwn view
@@ -31,32 +31,7 @@      $ export PATH=/usr/hs/bin:$PATH -Once the packages are installed and are in your execution path, using-cabal to configure and build git-annex just makes life easier, it-should install all the needed dependancies.--    $ cabal update-    $ git clone git://git.kitenet.net/git-annex-    $ cd git-annex-    $ make git-annex.1-    $ cabal configure-    $ cabal build-    $ cabal install--Or if you want to install it globallly for everyone (otherwise it will-get installed into $HOME/.cabal/bin)--    $ cabal install --global--The above will take a while to compile and install the needed-dependancies. I would suggest any user who does should run the tests-that comes with git-annex to make sure everything is functioning as-expected.--I haven't had a chance or need to install git-annex on a SL6 based-system yet, but I would assume something similar to the above steps-would be required to do so.--The above is almost a cut and paste of <http://jcftang.github.com/2012/06/15/installing-git-annex-on-sl5/>, the above could probably be refined, it was what worked for me on SL5. Please feel free to re-edit and chop out or add useless bits of text in the above!--Note: from the minor testing, it appears the compiled binaries from SL5 will work on SL6.+Once the GHC packages are installed and are in your execution path, using+cabal to build git-annex just makes life easier, it+should install all the needed dependancies. See "minimal build with cabal+and stackage" in [[fromsource]] for instructions.
+ doc/install/Ubuntu/Phone.mdwn view
@@ -0,0 +1,20 @@+Ubuntu is available on multiple phones, and as they are running Ubuntu, git-annex can be installed.++## Installation++Use phablet-config writable-image to make the image writable.++Then install git-annex using apt (apt install git-annex).++## Issues++The Debian package does not include the webapp:+git-annex version: 5.20141125+build flags: Assistant Pairing Testsuite S3 Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash+key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL+remote types: git gcrypt S3 bup directory rsync web tahoe glacier ddar hook external++### Application Compatibility++I have had difficulties getting the Music app to play music in a git-annex repository.+
doc/install/fromsource.mdwn view
@@ -48,8 +48,8 @@  Inside the source tree, run: -	cabal configure -f"-assistant -webapp -webdav -pairing -xmpp -dns" 	cabal install -j -f"-assistant -webapp -webdav -pairing -xmpp -dns" --only-dependencies+	cabal configure -f"-assistant -webapp -webdav -pairing -xmpp -dns" 	cabal build -j 	PATH=$HOME/bin:$PATH 	cabal install --bindir=$HOME/bin@@ -65,8 +65,8 @@  Once the C libraries are installed, run inside the source tree: -	cabal configure 	cabal install -j --only-dependencies+	cabal configure 	cabal build -j 	PATH=$HOME/bin:$PATH 	cabal install --bindir=$HOME/bin
+ doc/install/fromsource/comment_50_c1ce6084ba1e96afa30e18f0f6433aa4._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="joey"+ subject="""comment 50"""+ date="2015-07-15T15:54:15Z"+ content="""+Yes, Debian has a by now very outdated version of git-annex.++You can clone git-annex's git repo and build a debian package from there;+it's been updated for these changes.+"""]]
doc/install/verifying_downloads.mdwn view
@@ -16,7 +16,7 @@ with it.  	$ wget https://downloads.kitenet.net/git-annex/gpg-pubkey.asc-	$ gpg --import gpg-pubey.asc+	$ gpg --import gpg-pubkey.asc 	$ gpg --verify git-annex-standalone-*.tar.gz.sig  (The git-annex assistant can automatically upgrade git-annex, and when it
− doc/news/version_5.20150522.mdwn 
@@ -1,30 +0,0 @@-git-annex 5.20150522 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * import: Refuse to import files that are within the work tree, as that-     does not make sense and could cause data loss.-   * drop: Now supports --all, --unused, and --key.-   * drop: Now defaults to --all when run in a bare repository.-     (Previously, did nothing when run in a bare repository.)-   * get, move, copy, mirror: Concurrent transfers are now supported!-     For example: git-annex get -J10-     However, progress bars are not yet displayed for concurrent transfers,-     pending an updated version of the ascii-progress library.-   * --quiet now makes progress output by rsync, wget, etc be quiet too.-   * Take space that will be used by other running downloads into account when-     checking annex.diskreserve.-   * Avoid accumulating transfer failure log files unless the assistant is-     being used.-   * Fix an unlikely race that could result in two transfers of the same key-     running at once.-   * Stale transfer lock and info files will be cleaned up automatically-     when get/unused/info commands are run.-   * unused: Add --used-refspec option and annex.used-refspec, which can-     specify a set of refs to consider used, rather than the default of-     considering all refs used.-   * webapp: Fix zombie xdg-open process left when opening file browser.-     Closes: #[785498](http://bugs.debian.org/785498)-   * Safer posix fctnl locking implementation, using lock pools and STM.-   * Build documentation with TZ=UTC for reproducible builds. See #785736.-   * OSX: Corrected the location of trustedkeys.gpg, so the built-in-     upgrade code will find it. Fixes OSX upgrade going forward, but-     older versions won't upgrade themselves due to this problem."""]]
+ doc/news/version_5.20150727.mdwn view
@@ -0,0 +1,35 @@+git-annex 5.20150727 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * Fix bug that prevented uploads to remotes using new-style chunking+     from resuming after the last successfully uploaded chunk.+   * Switched option parsing to use optparse-applicative. This was a very large+     and invasive change, and may have caused some minor behavior changes to+     edge cases of option parsing. (For example, the metadata command no+     longer accepts the combination of --get and --set, which never actually+     worked.)+   * Bash completion file is now included in the git-annex source tree,+     and installed into Debian package (and any other packages built using make+     install). This bash completion is generated by the option parser, so it+     covers all commands, all options, and will never go out of date!+   * As well as tab completing "git-annex" commands, "git annex" will also tab+     complete. However, git's bash completion script needs a patch,+     which I've submitted, for this to work prefectly.+   * version --raw now works when run outside a git repository.+   * assistant --startdelay now works when run outside a git repository.+   * dead now accepts multiple --key options.+   * addurl now accepts --prefix and --suffix options to adjust the+     filenames used.+   * sync --content: Fix bug that caused files to be uploaded to eg,+     more archive remotes than wanted copies, only to later be dropped+     to satisfy the preferred content settings.+   * importfeed: Improve detection of known items whose url has changed,+     and avoid adding redundant files. Where before this only looked at+     permalinks in rss feeds, it now also looks at guids.+   * importfeed: Look at not only permalinks, but now also guids+     to identify previously downloaded files.+   * Webapp: Now features easy setup of git-annex repositories on gitlab.com.+   * Adjust debian build deps: The webapp can now build on arm64, s390x+     and hurd-i386. WebDAV support is also available on those architectures.+   * Debian package now maintained by Richard Hartmann.+   * Support building without persistent database on for systems that+     lack TH. This removes support for incremental fsck."""]]
doc/preferred_content.mdwn view
@@ -98,7 +98,7 @@   copies, on remotes in the specified group. For example,   `copies=archive:2` -  Preferred content expressions have no equivilant to the `--in`+  Preferred content expressions have no equivalent to the `--in`   option, but groups can accomplish similar things. You can add   repositories to groups, and match against the groups in a   preferred content expression. So rather than `--in=usbdrive`,
doc/publicrepos.mdwn view
@@ -30,8 +30,8 @@  * [ccc-media-annex](https://github.com/ntnn/ccc-media-annex)     `git clone https://github.com/ntnn/ccc-media-annex`  -  git-annex repository using [the CDN](http://media.ccc.de/) of the german [CCC](http://www.ccc.de/).  -  Contains a lot of talks (mostly in german) held on events from the CCC as well as other stuff.+  git-annex repository using [the CDN](http://media.ccc.de/) of the German [CCC](http://www.ccc.de/).  +  Contains a lot of talks (mostly in German) held on events from the CCC as well as other stuff.  This is a wiki -- add your own public repository to the list! See [[tips/centralized_git_repository_tutorial]].
doc/tips/centralized_git_repository_tutorial.mdwn view
@@ -1,142 +1,18 @@ The [[walkthrough]] builds up a decentralized git repository setup, but-git-annex can also be used with a centralized bare repository, just like-git can. This tutorial shows how to set up a centralized repository hosted on-GitHub on GitLab or your own git server.--## set up the repository, and make a checkout--I've created a repository for technical talk videos, which you can-[fork on Github](https://github.com/joeyh/techtalks).-Or make your own repository on GitHub (or GitLab elsewhere) now.--On your laptop, [[install]] git-annex, and clone the repository:--	# git clone git@github.com:joeyh/techtalks.git-	# cd techtalks--Tell git-annex to use the repository, and describe where this clone is-located:--	# git annex init 'my laptop'-	init my laptop ok--Let's tell git-annex that GitHub doesn't support running git-annex-shell there.--	# git config remote.origin.annex-ignore true--This means you can't store annexed file *contents* on GitHub; it would-really be better to host the bare repository on your own server, which-would not have this limitation. (If you want to do that, check out-[[using_gitolite_with_git-annex]].) Or, you could use GitLab, which-*does* [support git-annex on their servers](https://about.gitlab.com/2015/02/17/gitlab-annex-solves-the-problem-of-versioning-large-binaries-with-git/).--## add files to the repository--Add some files, obtained however.--	# youtube-dl -t 'http://www.youtube.com/watch?v=b9FagOVqxmI'-	# git annex add *.mp4-	add Haskell_Amuse_Bouche-b9FagOVqxmI.mp4 (checksum) ok-	(Recording state in git...)-	# git commit -m "added a video. I have not watched it yet but it sounds interesting"--This file is available directly from the web; so git-annex can download it:--	# git annex addurl http://kitenet.net/~joey/screencasts/git-annex_coding_in_haskell.ogg-	addurl kitenet.net_~joey_screencasts_git-annex_coding_in_haskell.ogg-	(downloading http://kitenet.net/~joey/screencasts/git-annex_coding_in_haskell.ogg ...)-	(checksum...) ok-	(Recording state in git...)-	# git commit -a -m 'added a screencast I made'--Feel free to rename the files, etc, using normal git commands:--	# git mv Haskell_Amuse_Bouche-b9FagOVqxmI.mp4 Haskell_Amuse_Bouche.mp4-	# git mv kitenet.net_~joey_screencasts_git-annex_coding_in_haskell.ogg git-annex_coding_in_haskell.ogg-	# git commit -m 'better filenames'--Now push your changes back to the central repository. As well as pushing-the master branch, remember to push the git-annex branch, which is used to-track the file contents.--	# git push origin master git-annex-	To git@github.com:joeyh/techtalks.git-	 * [new branch]      master -> master-	 * [new branch]      git-annex -> git-annex--That push went fast, because it didn't upload large videos to GitHub.-To check this, you can ask git-annex where the contents of the videos are:--	# git annex whereis-	whereis Haskell_Amuse_Bouche.mp4 (1 copy) -	  	767e8558-0955-11e1-be83-cbbeaab7fff8 -- here-	ok-	whereis git-annex_coding_in_haskell.ogg (2 copies) -	  	00000000-0000-0000-0000-000000000001 -- web-	   	767e8558-0955-11e1-be83-cbbeaab7fff8 -- here-	ok--## make more checkouts--So far you have a central repository, and a checkout on a laptop.-Let's make another checkout that's used as a backup. You can put it anywhere-you like, just make it be somewhere your laptop can access. A few options:--* Put it on a USB drive that you can plug into the laptop.-* Put it on a desktop.-* Put it on some server in the local network.-* Put it on a remote VPS.--I'll use the VPS option, but these instructions should work for-any of the above.--	# ssh server-	server# sudo apt-get install git-annex--Clone the central repository as before. (If the clone fails, you need-to add your server's ssh public key to github -- see-[this page](http://help.github.com/ssh-issues/).)--	server# git clone git@github.com:joeyh/techtalks.git-	server# cd techtalks-	server# git config remote.origin.annex-ignore true-	server# git annex init 'backup'-	init backup (merging origin/git-annex into git-annex...) ok--Notice that the server does not have the contents of any of the files yet.-If you run `ls`, you'll see broken symlinks. We want to populate this-backup with the file contents, by copying them from your laptop.--Back on your laptop, you need to configure a git remote for the backup.-Adjust the ssh url as needed to point to wherever the backup is. (If it-was on a local USB drive, you'd use the path to the repository instead.)--	# git remote add backup ssh://server/~/techtalks--Now git-annex on your laptop knows how to reach the backup repository,-and can do things like copy files to it:--	# git annex copy --to backup git-annex_coding_in_haskell.ogg-	copy git-annex_coding_in_haskell.ogg (checking backup...)-	12877824   2%  255.11kB/s    00:00-	ok--You can also `git annex move` files to it, to free up space on your laptop.-And then you can `git annex get` files back to your laptop later on, as-desired.--After you use git-annex to move files around, remember to push, -which will broadcast its updated location information.+git-annex can also be used with a centralized git repository.  -	# git push origin master git-annex+We have separate tutorials depending on where the centralized git+repository is hosted. -## take it farther+* [[centralized_git_repository_tutorial/On_GitHub]] --+  However, GitHub does not currently let git-annex+  store the contents of large files there. So, things get a little more+  complicated when using it. -Of course you can create as many checkouts as you desire. If you have a-desktop machine too, you can make a checkout there, and use `git remote-add` to also let your desktop access the backup repository. +* [[centralized_git_repository_tutorial/On_GitLab]] -- +  This service is similar to GitHub, but supports+  git-annex. -You can add remotes for each direct connection between machines you find you-need -- so make the laptop have the desktop as a remote, and the desktop-have the laptop as a remote, and then on either machine git-annex can-access files stored on the other.+* [[centralized_git_repository_tutorial/On_your_own_server]] --+  use any unix system with ssh and git and git-annex installed.+  A VPS, a home server, etc.
+ doc/tips/centralized_git_repository_tutorial/on_GitHub.mdwn view
@@ -0,0 +1,129 @@+This tutorial shows how to set up a centralized repository hosted on+GitHub.++GitHub does not currently let git-annex store the contents of large files+there. This doesn't prevent using git-annex with GitHub, it just means you+have to set up some other centralized location for the large files.++## set up the repository, and make a checkout++I've created a repository for technical talk videos, which you can+[fork on Github](https://github.com/joeyh/techtalks).+Or make your own repository on GitHub now.++On your laptop, [[install]] git-annex, and clone the repository:++	# git clone git@github.com:joeyh/techtalks.git+	# cd techtalks++Tell git-annex to use the repository, and describe where this clone is+located:++	# git annex init 'my laptop'+	init my laptop ok++## add files to the repository++Add some files, obtained however.++	# git annex add *.mp4+	add Haskell_Amuse_Bouche-b9OVqxmI.mp4 (checksum) ok+	(Recording state in git...)+	# git commit -m "added a video. I have not watched it yet but it sounds interesting"++This file is available on the web; so git-annex can download it:++	# git annex addurl http://kitenet.net/~joey/screencasts/git-annex_coding_in_haskell.ogg+	addurl kitenet.net_~joey_screencasts_git-annex_coding_in_haskell.ogg+	(downloading http://kitenet.net/~joey/screencasts/git-annex_coding_in_haskell.ogg ...)+	(checksum...) ok+	(Recording state in git...)+	# git commit -a -m 'added a screencast I made'++Feel free to rename the files, etc, using normal git commands:++	# git mv Haskell_Amuse_Bouche-b9OVqxmI.mp4 Haskell_Amuse_Bouche.mp4+	# git mv kitenet.net_~joey_screencasts_git-annex_coding_in_haskell.ogg git-annex_coding_in_haskell.ogg+	# git commit -m 'better filenames'++Now push your changes back to the central repository on GitHub. As well as +pushing the master branch, remember to push the git-annex branch, which is+used to track the file contents. You can do this push manually as shown+below, or you can just run `git annex sync` to do the same thing.++	# git push origin master git-annex+	To git@github.com:joeyh/techtalks.git+	 * [new branch]      master -> master+	 * [new branch]      git-annex -> git-annex++That push went fast, because it didn't upload large videos to GitHub.+To check this, you can ask git-annex where the contents of the videos are:++	# git annex whereis+	whereis Haskell_Amuse_Bouche.mp4 (1 copy) +	  	767e8558-0955-11e1-be83-cbbeaab7fff8 -- here+	ok+	whereis git-annex_coding_in_haskell.ogg (2 copies) +	  	00000000-0000-0000-0000-000000000001 -- web+	   	767e8558-0955-11e1-be83-cbbeaab7fff8 -- here+	ok++## make more checkouts++So far you have a central repository, and a checkout on a laptop.+You, or anyone you allow to can clone the central repository, and+use git-annex with it.++But, since GitHub doesn't currently support storing large files there+with git-annex, other checkouts of your repository won't be able to+access the files you added to the repository on your laptop.++	# git clone git@github.com:myrepo/techtalks.git+	# git annex get Haskell_Amuse_Bouche-b9OVqxmI.mp4+	get Haskell_Amuse_Bouche-b9OVqxmI.mp4++	  Try making some of these repositories available:+		767e8558-0955-11e1-be83-cbbeaab7fff8 -- my laptop+	failed++## add a special remote++So, to complete your setup, you need to set up a repository where git-annex+can store the contents of large files. This is often done by setting up+a [[special_remote|special_remotes]]. One free option is explained in+[[using_box.com_as_a_special_remote]]. Another useful approach is+explained in [[public_Amazon_S3_remote]].++Once you have the special remote set up on your laptop, you can+send files to it:++	# git annex copy --to myspecialremote Haskell_Amuse_Bouche-b9OVqxmI.mp4+	copy Haskell_Amuse_Bouche-b9OVqxmI.mp4 (to myspecialremote...)+	100% 255.11kB/s+	ok++You can also `git annex move` files to it, to free up space on your laptop.+And then you can `git annex get` files back to your laptop later on, as+desired.++After you use git-annex to move files around, remember to sync,+which will broadcast its updated location information.++	# git annex sync++After setting up the special remote and storing some files on it,+you can download them on other clones. You'll first need to enable the same+special remote on the clones.++	# git annex sync+	# git annex enableremote myspecialremote+	# git annex get git-annex_coding_in_haskell.ogg+	100% 255.11kB/s+	ok++## take it farther++You can add remotes for each direct connection between machines you find you+need -- so make the laptop have the desktop as a remote, and the desktop+have the laptop as a remote, and then on either machine git-annex can+access files stored on the other.
+ doc/tips/centralized_git_repository_tutorial/on_GitLab.mdwn view
@@ -0,0 +1,76 @@+This tutorial shows how to set up a centralized repository hosted on+GitLab. ++Since GitLab has [added support for git-annex on their servers](https://about.gitlab.com/2015/02/17/gitlab-annex-solves-the-problem-of-versioning-large-binaries-with-git/),+you can store your large files on GitLab, quite easily.++Note that as I'm writing this, GitLab is providing this service for free,+and I don't know how much data they're willing to host for free.++## create the repository++Go to <https://gitlab.com/> and sign up for an account, and create the+repository there. Take note of the SSH clone url for the repository, which+will be something like `git@gitlab.com:yourlogin/annex.git`. ++We want to clone this locally, on your laptop. (If the clone fails, you+need to generate a ssh key and add it to GitLab.)++	# git clone git@gitlab.com:yourlogin/annex.git+	# cd annex++Tell git-annex to use the repository, and describe where this clone is+located:++	# git annex init 'my laptop'+	init my laptop ok++Add some files, obtained however.++	# git annex add *.mp4+	add Haskell_Amuse_Bouche-b9OVqxmI.mp4 (checksum) ok+	(Recording state in git...)+	# git commit -m "added a video. I have not watched it yet but it sounds interesting"++Feel free to rename the files, etc, using normal git commands:++	# git mv Haskell_Amuse_Bouche-b9OVqxmI.mp4 Haskell_Amuse_Bouche.mp4+	# git commit -m 'better filenames'++## push to GitLab++Now make a first push to the GitLab repository.+As well as pushing the master branch, remember to push the git-annex+branch, which is used to track the file contents.++	# git push origin master git-annex+	To git@gitlab.com:yourlogin/annex.git+	 * [new branch]      master -> master+	 * [new branch]      git-annex -> git-annex++That push went fast, because it didn't upload the large file contents yet.++So, to finish up, tell git-annex to sync all the data in the repository+to GitLab:++	# git annex sync --content+	...++## make more checkouts++So far you have a central repository on GitLab, and a checkout on a laptop.+Let's make another checkout elsewhere. Clone the central repository as before.+(If the clone fails, you need to generate a ssh key and add it to GitLab.)++	elsewhere# git clone git@gitlab.com:yourlogin/annex.git+	elsewhere# cd annex++Notice that your clone does not have the contents of any of the files yet.+If you run `ls`, you'll see broken symlinks. It's easy to download them from+GitLab either by running `git annex sync --content`, or by asking+git-annex to download individual files:++	# git annex get Haskell_Amuse_Bouche.mp4+	get Haskell_Amuse_Bouche.mp4 (from origin...)+	12877824   2%  255.11kB/s    00:00+	ok
+ doc/tips/centralized_git_repository_tutorial/on_your_own_server.mdwn view
@@ -0,0 +1,88 @@+This tutorial shows how to set up a centralized git repository+hosted on your own git server, which can be any unix system with+ssh and git and git-annex installed. A VPS, a home server, etc.++This sets up a very simple git server. More complex setups are possible.+See for example [[using_gitolite_with_git-annex]].++## set up the server++On the server, you'll want to [[install]] git, and git-annex, if you haven't+already.++	server# sudo apt-get install git git-annex++Decide where to put the repository on the server, and create a bare git repo+there. In your home directory is a simple choice:++	server# cd+	server# git init annex.git --bare --shared++That's the server setup done!++## make a checkout++Now on your laptop, clone the git repository from the server:++	laptop# git clone ssh://example.com/~/annex.git+	Cloning into 'annex'...+	warning: You appear to have cloned an empty repository.+	Checking connectivity... done.++	+Tell git-annex to use the repository, and describe where this clone is+located:+++	laptop# cd annex+	laptop# git annex init 'my laptop'+	init my laptop ok++## add files to the repository++Add some files, obtained however.++	# git annex add *.mp4+	add Haskell_Amuse_Bouche-b9OVqxmI.mp4 (checksum) ok+	(Recording state in git...)+	# git commit -m "added a video. I have not watched it yet but it sounds interesting"++Feel free to rename the files, etc, using normal git commands:++	# git mv Haskell_Amuse_Bouche-b9OVqxmI.mp4 Haskell_Amuse_Bouche.mp4+	# git commit -m 'better filenames'++Now push your changes back to the central repository on your server. As+well as pushing the master branch, remember to push the git-annex branch,+which is used to track the file contents.++	# git push origin master git-annex+	To git@github.com:joeyh/techtalks.git+	 * [new branch]      master -> master+	 * [new branch]      git-annex -> git-annex++That push went fast, because it didn't upload large videos to the server.++So, to finish up, tell git-annex to sync all the data in the repository+to your server:++	# git annex sync --content+	...++## make more checkouts++So far you have a central repository on your server, and a checkout on a laptop.+Let's make another checkout elsewhere. Clone the central repository as before.++	elsewhere# git clone ssh://example.com/~/annex.git+	elsewhere# cd annex++Notice that your clone does not have the contents of any of the files yet.+If you run `ls`, you'll see broken symlinks. It's easy to download them from+your server either by running `git annex sync --content`, or by asking+git-annex to download individual files:++	# git annex get Haskell_Amuse_Bouche.mp4+	get Haskell_Amuse_Bouche.mp4 (from origin...)+	12877824   2%  255.11kB/s    00:00+	ok
+ doc/tips/git-annex_on_NFS.mdwn view
@@ -0,0 +1,75 @@+There are multiple issues that have been reported that are related to using git-annex on networked file systems. We're generally talking about NFS, which we'll cover here, but this may also be the case on SMB filesystems.++Locking issues+==============++Here is the prior art here:++* [[devblog/day_27__locking_fun/]]+* [[devblog/day_286-287__rotten_locks/]]+* [[forum/Can__39__t_init_git_annex/]]+* [[bugs/git-annex_merge_stalls/]]++All of those issues but the first are related to locking on NFS filesystems, which is [notoriously bad](https://en.wikipedia.org/wiki/File_locking#Problems). However, the problems with it are not insurmountable and git-annex can actually be used, even if unreliably, on NFS filesystems.++The problem I mainly hit with NFS filesystems is with unreliable locking. If you have similar platforms (both running Linux for example, NFS locking doesn't work in BSD systems), locking *should* work, but sometimes fails without reason. This problem and the solution is well described in [this stackoverflow answer](http://serverfault.com/a/455080), taken from [this excellent blog](http://sophiedogg.com/lockd-and-statd-nfs-errors/). Basically, you need to restart a bunch of NFS daemon that get stuck on the server side and then locking works again. This generally fixed it for me:++<pre>+service nfs-kernel-server stop+service rpcbind stop+service nfs-common stop+service rpcbind start+service nfs-common start+service nfs-kernel-server start+</pre>++This needs to be run as root on the server side. Having a simple test script to see if locking works is also useful, i use the following:++<pre>+#! /usr/bin/perl -w++use Fcntl qw(LOCK_SH LOCK_EX LOCK_UN);++$child = fork();+open(TESTLCK, ">testlock");++if ($child == 0) { # in child+	print "locking exclusively\n";+	flock(TESTLCK, LOCK_EX) || die "failed to lock exclusively: $!";+	print "holding exclusively lock for 3 seconds\n";+	sleep 3;+	flock(TESTLCK, LOCK_UN) || die "failed to unlock exclusively: $!";+	print "done locking exclusively\n";+} else { # in parent+	print "locking shared\n";+	flock(TESTLCK, LOCK_SH) || die "failed to lock shared: $!";+	print "holding shared lock for 3 seconds\n";+	sleep 3;+	flock(TESTLCK, LOCK_UN) || die "failed to unlock shared: $!";+	print "done locking shared, waiting for child to finish\n";+	wait;+}+</pre>++Also note that the [NFS FAQ](http://nfs.sourceforge.net/) (currently offline, thanks to Sourceforge, see [this archive](https://archive.is/QMMO)) also has interesting snippets about NFS locking. In short: it's a mess, but it can be worked around! -- [[anarcat]]++Socket issues+=============++Another thing that may fail is the "ssh caching code". Examples:++* [[forum/git_annex_sync_dies___40__sometimes__41__/]]+* [[forum/NTFS_usb_on_linux_unable_to_connect_to_ssh_remote/]]+* [[todo/git-annex_ignores_GIT__95__SSH/]]+* [[bugs/git-annex-shell_doesn__39__t_work_as_expected/]]++As you can see, this affects way more than NFS, which often just works there. But it can be that the SSH client can't create a socket for the SSH multiplexing that git-annex uses. Normally, git-annex should detect that and fallback properly, but sometimes this fails, especially with older versions of git-annex. A workaround is to disable the feature:++    git config annex.sshcaching false++The tradeoff is that syncs are faster, but it works. -- [[anarcat]]++Stray files issue+=================++This is a completely different issue, but could be related to file locking: [[bugs/huge_multiple_copies_of___39__.nfs__42____39___and___39__.panfs__42____39___being_created/]]. Basically, tons of files are left behind by git-annex when it is ran on an NFS server. It is yet unclear how this problem happens and how to resolve it. But it has been reproduced and could affect you, so until it is resolved, it is still an open issue here... -- [[anarcat]]
+ doc/todo/Add___39__dir__39___option_to_addurl.mdwn view
@@ -0,0 +1,4 @@+Is it possible to add a '--dir' option to addurl (or some other mechanic) to make git annex create the symlinks in the specified directory?++> --prefix makes sense, and might as well also add --suffix. [[done]]+> --[[Joey]]
doc/todo/Add_gitlab.com_as_cloud_provider.mdwn view
@@ -5,3 +5,6 @@ Gitlab.com and Gitlab enterprise edition, but unfortunately not Gitlab community edition, now [provides git annex support](https://about.gitlab.com/2015/02/17/gitlab-annex-solves-the-problem-of-versioning-large-binaries-with-git/).  It works fairly based for the repos I have enabled it on.  At the moment it's free, but one may have to pay for repos larger than 5Gb [in the future](https://about.gitlab.com/2015/02/22/gitlab-7-8-released/#comment-1870271594).  Perhaps gitlab.com should be added to preconfigured cloud providers?++> [[done]] although there are a few known bugs in the webapp's+> implementation. --[[Joey]]
+ doc/todo/Metadata_changes_are_not_reflected_in_a_view.mdwn view
@@ -0,0 +1,31 @@+### Please describe the problem.+Changing metadata while being in an active view will not update the view.++### What steps will reproduce the problem?+(inside a repository)++1. Create a file++        $ uuidgen >file++2. switch into a view++       $ git annex view !blah+       $ ls+       file++3. changed the metadata the view is based upon++       $ git annex metadata -t blah file+       $ ls+       file++   It would be nice/expected that the view gets updated when the metadata changes, hiding 'file' now+  ++### What version of git-annex are you using? On what operating system?++git-annex version: 5.20141024~bpo70+1+on debian wheezy with backports++### Please provide any additional information below.
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20150710+Version: 5.20150727 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -105,14 +105,15 @@   Description: Get Network.URI from the network-uri package   Default: True -Flag new-time-  Description: Build with new version of time and without old-locale+Flag Database+  Description: Enable building with persistent for database use (disable to build on platforms not supporting TH)   Default: True  Executable git-annex   Main-Is: git-annex.hs   Build-Depends:    base (>= 4.5 && < 4.9),+   optparse-applicative (>= 0.10),     cryptohash (>= 0.11.0),    containers (>= 0.5.0.0),     exceptions (>= 0.6),@@ -126,7 +127,7 @@    monad-control, transformers,    bloomfilter, edit-distance,    resourcet, http-conduit, http-types,-   esqueleto, persistent-sqlite, persistent, persistent-template+   time, old-locale   CC-Options: -Wall   GHC-Options: -Wall -fno-warn-tabs   Extensions: PackageImports@@ -143,11 +144,6 @@   else     Build-Depends: network (< 2.6), network (>= 2.0) -  if flag(new-time)-    Build-Depends: time (>= 1.5)-  else-    Build-Depends: time, old-locale-   if flag(Production)     GHC-Options: -O2 @@ -164,7 +160,7 @@    if flag(TestSuite)     Build-Depends: tasty (>= 0.7), tasty-hunit, tasty-quickcheck, tasty-rerun,-     optparse-applicative (>= 0.10), crypto-api+     crypto-api     CPP-Options: -DWITH_TESTSUITE    if flag(TDFA)@@ -268,6 +264,10 @@   if flag(TorrentParser)     Build-Depends: torrent (>= 10000.0.0)     CPP-Options: -DWITH_TORRENTPARSER++  if flag(Database)+    Build-Depends: esqueleto, persistent-sqlite, persistent, persistent-template+    CPP-Options: -DWITH_DATABASE    if flag(AsciiProgress)     Build-Depends: ascii-progress (<= 0.2.1.2), terminal-size
git-annex.hs view
@@ -13,9 +13,7 @@  import qualified CmdLine.GitAnnex import qualified CmdLine.GitAnnexShell-#ifdef WITH_TESTSUITE import qualified Test-#endif  #ifdef mingw32_HOST_OS import Utility.UserInfo@@ -37,14 +35,7 @@ #else 			gitannex ps #endif-	gitannex ps = -#ifdef WITH_TESTSUITE-		case ps of-			("test":ps') -> Test.main ps'-			_ -> CmdLine.GitAnnex.run ps-#else-		CmdLine.GitAnnex.run ps-#endif+	gitannex = CmdLine.GitAnnex.run Test.optParser Test.runner 	isshell n = takeFileName n == "git-annex-shell"  #ifdef mingw32_HOST_OS
man/git-annex-addurl.1 view
@@ -41,12 +41,20 @@ from the specified url(s). .IP .IP "\fB\-\-pathdepth=N\fP"-This causes a shorter filename to be used. For example,-\fB\-\-pathdepth=1\fP will use "dir/subdir/bigfile",+Rather than basing the filename on the whole url, this causes a path to+be constructed, starting at the specified depth within the path of the+url.+.IP+For example, adding the url http://www.example.com/dir/subdir/bigfile+with \fB\-\-pathdepth=1\fP will use "dir/subdir/bigfile", while \fB\-\-pathdepth=3\fP will use "bigfile".  .IP It can also be negative; \fB\-\-pathdepth=\-2\fP will use the last two parts of the url.+.IP+.IP "\fB\-\-prefix=foo\fP \fB\-\-suffix=bar\fP"+Use to adjust the filenames that are created by addurl. For example,+\fB\-\-suffix=.mp3\fP can be used to add an extension to the file. .IP .SH SEE ALSO git-annex(1)
man/git-annex-drop.1 view
@@ -1,6 +1,6 @@ .TH git-annex-drop 1 .SH NAME-git-annex-drop \- indicate content of files not currently wanted+git-annex-drop \- remove content of files from repository .PP .SH SYNOPSIS git annex drop \fB[path ...]\fP
man/git-annex-fsck.1 view
@@ -1,6 +1,6 @@ .TH git-annex-fsck 1 .SH NAME-git-annex-fsck \- check for problems+git-annex-fsck \- find and fix problems .PP .SH SYNOPSIS git annex fsck \fB[path ...]\fP
man/git-annex-importfeed.1 view
@@ -13,7 +13,7 @@ .PP When quvi is installed, links in the feed are tested to see if they are on a video hosting site, and the video is downloaded. This allows-importing e.g., youtube playlists.+importing e.g., YouTube playlists. .PP To make the import process add metadata to the imported files from the feed, \fBgit config annex.genmetadata true\fP@@ -30,7 +30,7 @@ .IP Other available variables for templates: feedauthor, itemauthor, itemsummary, itemdescription, itemrights, itemid, itempubdate, title, author .IP-.IP "\fB\-\-relaxed\fP, \fB\-\-fast\fP, \fB\-\-raw\fP, \fB\-\-template\fP"+.IP "\fB\-\-relaxed\fP, \fB\-\-fast\fP, \fB\-\-raw\fP" These options behave the same as when using git-annex\-addurl(1). .IP .SH SEE ALSO
man/git-annex-view.1 view
@@ -17,7 +17,8 @@ .PP Once within such a view, you can make additional directories, and copy or move files into them. When you commit, the metadata will-be updated to correspond to your changes.+be updated to correspond to your changes. Deleting files and committing+also updates the metadata. .PP There are fields corresponding to the path to the file. So a file "foo/bar/baz/file" has fields "/=foo", "foo/=bar", and "foo/bar/=baz".
man/git-annex.1 view
@@ -1,6 +1,6 @@ .TH git-annex 1 .SH NAME-git-annex-\- manage files with git, without checking their contents in+git-annex \- manage files with git, without checking their contents in .PP .SH SYNOPSIS git annex command [params ...]@@ -909,7 +909,7 @@ .IP .IP "\fBremote.<name>.annex\-rsync\-options\fP" Options to use when using rsync-to or from this remote. For example, to force ipv6, and limit+to or from this remote. For example, to force IPv6, and limit the bandwidth to 100Kbyte/s, set it to \fB\-6 \-\-bwlimit 100\fP .IP .IP "\fBremote.<name>.annex\-rsync\-upload\-options\fP"@@ -954,7 +954,7 @@ .IP .IP "\fBannex.web\-options\fP" Options to pass when running wget or curl.-For example, to force ipv4 only, set it to "\-4"+For example, to force IPv4 only, set it to "\-4" .IP .IP "\fBannex.quvi\-options\fP" Options to pass to quvi when using it to find the url to download for a
templates/configurators/addrepository/cloud.hamlet view
@@ -1,16 +1,23 @@ <h3>+  <a href="@{AddGitLabR}">+    <span .glyphicon .glyphicon-plus-sign>+    \ Gitlab.com+<p>+  Hosts git-annex repositories for free.++<h3>   <a href="@{AddBoxComR}">     <span .glyphicon .glyphicon-plus-sign>     \ Box.com <p>-  Provides free cloud storage for small amounts of data.+  Provides free storage for small amounts of data.  <h3>   <a href="@{AddRsyncNetR}">     <span .glyphicon .glyphicon-plus-sign>     \ Rsync.net <p>-  Works very well with git-annex.+  Works very well with git-annex for data storage.   <br>   Offers a discounted rate for git-annex users.
templates/configurators/addrepository/misc.hamlet view
@@ -24,5 +24,3 @@     \ Add another repository <p>   Make another repository on your computer.--^{makeSshRepository}
+ templates/configurators/gitlab.com/add.hamlet view
@@ -0,0 +1,47 @@+<div .col-sm-9>+  <div .content-box>+    <h2>+      Adding a GitLab.com repository+    <p>+      <a href="http://gitlab.com/">+        GitLab.com #+      provides free public and private git repositories, and supports #+      git-annex.+    <p>+      $case status+        $of UnusableServer msg+          <div .alert .alert-danger>+            <span .glyphicon .glyphicon-warning-sign>+            \ #{msg}+        $of ServerNeedsPubKey pubkey+          <div .alert>+            <span .glyphicon .glyphicon-warning-sign>+            \ You need to configure GitLab to accept a SSH public key.+            <p>+              Open a tab to #+                <a href="https://gitlab.com/profile/keys/new" target="_blank">+                  https://gitlab.com/profile/keys/new+              and copy and paste this public key into it:+              <pre>+                #{pubkey}+            <p>+              Once you have added the key to GitLab, come back to this page #+              to finish setting up the repository.+        $of _+          <p>+            You can sign up for an account on #+            <a href="http://gitlab.com/">+              GitLab.com #+            and create a git repository that you want to use with git-annex, #+            or find an existing git-annex repository to share with.+          <p>+           Copy the GitLab repository's SSH clone url into the form below.+      <form method="post" .form-horizontal enctype=#{enctype}>+        <fieldset>+          ^{form}+          ^{webAppFormAuthToken}+          <div .form-group>+            <div .col-sm-10 .col-sm-offset-2>+              <button .btn .btn-primary type=submit onclick="$('#setupmodal').modal('show');">+                Use this gitlab.com repository+^{sshTestModal}
templates/configurators/ssh/confirm.hamlet view
@@ -35,19 +35,20 @@               Make an unencrypted git repository on the server           <p style="text-align: center">             -or--        <h3>-          Simple shared encryption-        <p>-          This allows everyone who has a clone of this repository to #-          decrypt the files stored on #{sshHostName sshdata}. That makes #-          it good for sharing. And it's easy to set up and use.-        <p>-          <a .btn .btn-default href="@{MakeSshRsyncR sshdata}" onclick="$('#setupmodal').modal('show');">-            <span .glyphicon .glyphicon-lock>-            \ Use shared encryption-        $if hasCapability sshdata GitCapable+        $if hasCapability sshdata RsyncCapable+          <h3>+            Simple shared encryption+          <p>+            This allows everyone who has a clone of this repository to #+            decrypt the files stored on #{sshHostName sshdata}. That makes #+            it good for sharing. And it's easy to set up and use.+          <p>+            <a .btn .btn-default href="@{MakeSshRsyncR sshdata}" onclick="$('#setupmodal').modal('show');">+              <span .glyphicon .glyphicon-lock>+              \ Use shared encryption           <p style="text-align: center">             -or-+        $if hasCapability sshdata GitCapable           <h3>             Encrypt with GnuPG key           <p>