refactor some boilerplate

Command.hs

@@ -65,12 +65,22 @@ data Command = Command {
 	cmdusesrepo :: Bool
 }
 
+{- Most commands operate on files in a git repo. -}
 repoCommand :: String -> String -> [CommandSeek] -> String -> Command
 repoCommand n p s d = Command n p s d True
 
+{- Others can run anywhere. -}
 standaloneCommand :: String -> String -> [CommandSeek] -> String -> Command
 standaloneCommand n p s d = Command n p s d False
 
+{- For start and perform stages to indicate what step to run next. -}
+next :: a -> Annex (Maybe a)
+next a = return $ Just a
+
+{- Or to indicate nothing needs to be done. -}
+stop :: Annex (Maybe a)
+stop = return Nothing
+
 {- Prepares a list of actions to run to perform a command, based on
  - the parameters passed to it. -}
 prepCommand :: Command -> [String] -> Annex [Annex Bool]

Command/Add.hs

@@ -34,19 +34,19 @@ start :: CommandStartBackendFile
 start pair@(file, _) = notAnnexed file $ do
 	s <- liftIO $ getSymbolicLinkStatus file
 	if (isSymbolicLink s) || (not $ isRegularFile s)
-		then return Nothing
+		then stop
 		else do
 			showStart "add" file
-			return $ Just $ perform pair
+			next $ perform pair
 
 perform :: BackendFile -> CommandPerform
 perform (file, backend) = do
 	stored <- Backend.storeFileKey file backend
 	case stored of
-		Nothing -> return Nothing
+		Nothing -> stop
 		Just (key, _) -> do
 			moveAnnex key file
-			return $ Just $ cleanup file key
+			next $ cleanup file key
 
 cleanup :: FilePath -> Key -> CommandCleanup
 cleanup file key = do

Command/ConfigList.hs

@@ -25,4 +25,4 @@ start = do
 	g <- Annex.gitRepo
 	u <- getUUID g
 	liftIO $ putStrLn $ "annex.uuid=" ++ u
-	return Nothing
+	stop

Command/Describe.hs

@@ -29,9 +29,9 @@ start params = notBareRepo $ do
 	
 	showStart "describe" name
 	u <- Remote.nameToUUID name
-	return $ Just $ perform u description
+	next $ perform u description
 
 perform :: UUID -> String -> CommandPerform
 perform u description = do
 	describeUUID u description
-	return $ Just $ Command.Init.cleanup
+	next $ Command.Init.cleanup

Command/Drop.hs

@@ -29,11 +29,11 @@ seek = [withAttrFilesInGit "annex.numcopies" start]
 start :: CommandStartAttrFile
 start (file, attr) = isAnnexed file $ \(key, backend) -> do
 	inbackend <- Backend.hasKey key
-	if not inbackend
+	if inbackend
-		then return Nothing
+		then do
-		else do
 			showStart "drop" file
-			return $ Just $ perform key backend numcopies
+			next $ perform key backend numcopies
+		else stop
 	where
 		numcopies = readMaybe attr :: Maybe Int
 
@@ -41,8 +41,8 @@ perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform
 perform key backend numcopies = do
 	success <- Backend.removeKey backend key numcopies
 	if success
-		then return $ Just $ cleanup key
+		then next $ cleanup key
-		else return Nothing
+		else stop
 
 cleanup :: Key -> CommandCleanup
 cleanup key = do

Command/DropKey.hs

@@ -26,20 +26,19 @@ start key = do
 	present <- inAnnex key
 	force <- Annex.getState Annex.force
 	if not present
-		then return Nothing
+		then stop
 		else if not force
 			then error "dropkey is can cause data loss; use --force if you're sure you want to do this"
 			else do
 				showStart "dropkey" (show key)
-				return $ Just $ perform key
+				next $ perform key
 
 perform :: Key -> CommandPerform
 perform key = do
 	removeAnnex key
-	return $ Just $ cleanup key
+	next $ cleanup key
 
 cleanup :: Key -> CommandCleanup
 cleanup key = do
 	logStatus key ValueMissing
 	return True
-

Command/DropUnused.hs

@@ -49,13 +49,13 @@ start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
 	, (unusedtmp, performOther gitAnnexTmpLocation)
 	]
 	where
-		search [] = return Nothing
+		search [] = stop
 		search ((m, a):rest) = do
 			case M.lookup s m of
 				Nothing -> search rest
 				Just key -> do
 					showStart "dropunused" s
-					return $ Just $ a key
+					next $ a key
 
 perform :: Key -> CommandPerform
 perform key = do
@@ -64,7 +64,7 @@ perform key = do
 		Just name -> do
 			r <- Remote.byName name
 			showNote $ "from " ++ Remote.name r ++ "..."
-			return $ Just $ Command.Move.fromCleanup r True key
+			next $ Command.Move.fromCleanup r True key
 		_ -> do
 			backend <- keyBackend key
 			Command.Drop.perform key backend (Just 0) -- force drop
@@ -75,7 +75,7 @@ performOther filespec key = do
 	let f = filespec g key
 	e <- liftIO $ doesFileExist f
 	when e $ liftIO $ removeFile f
-	return $ Just $ return True
+	next $ return True
 
 readUnusedLog :: FilePath -> Annex UnusedMap
 readUnusedLog prefix = do

Command/Find.hs

@@ -25,4 +25,4 @@ start :: CommandStartString
 start file = isAnnexed file $ \(key, _) -> do
 	exists <- inAnnex key
 	when exists $ liftIO $ putStrLn file
-	return Nothing
+	stop

Command/Fix.hs

@@ -30,17 +30,17 @@ start file = isAnnexed file $ \(key, _) -> do
 	link <- calcGitLink file key
 	l <- liftIO $ readSymbolicLink file
 	if link == l
-		then return Nothing
+		then stop
 		else do
 			showStart "fix" file
-			return $ Just $ perform file link
+			next $ perform file link
 
 perform :: FilePath -> FilePath -> CommandPerform
 perform file link = do
 	liftIO $ createDirectoryIfMissing True (parentDir file)
 	liftIO $ removeFile file
 	liftIO $ createSymbolicLink link file
-	return $ Just $ cleanup file
+	next $ cleanup file
 
 cleanup :: FilePath -> CommandCleanup
 cleanup file = do

Command/FromKey.hs

@@ -34,7 +34,7 @@ start file = notBareRepo $ do
 	unless inbackend $ error $
 		"key ("++keyName key++") is not present in backend"
 	showStart "fromkey" file
-	return $ Just $ perform file
+	next $ perform file
 
 perform :: FilePath -> CommandPerform
 perform file = do
@@ -42,7 +42,7 @@ perform file = do
 	link <- calcGitLink file key
 	liftIO $ createDirectoryIfMissing True (parentDir file)
 	liftIO $ createSymbolicLink link file
-	return $ Just $ cleanup file
+	next $ cleanup file
 
 cleanup :: FilePath -> CommandCleanup
 cleanup file = do

Command/Fsck.hs

@@ -31,7 +31,7 @@ seek = [withAttrFilesInGit "annex.numcopies" start]
 start :: CommandStartAttrFile
 start (file, attr) = notBareRepo $ isAnnexed file $ \(key, backend) -> do
 	showStart "fsck" file
-	return $ Just $ perform key file backend numcopies
+	next $ perform key file backend numcopies
 	where
 		numcopies = readMaybe attr :: Maybe Int
 
@@ -42,8 +42,8 @@ perform key file backend numcopies = do
 	locationlogok <- verifyLocationLog key file
 	backendok <- Backend.fsckKey backend key (Just file) numcopies
 	if locationlogok && backendok
-		then return $ Just $ return True
+		then next $ return True
-		else return Nothing
+		else stop
 
 {- Checks that the location log reflects the current status of the key,
    in this repository only. -}

Command/Get.hs

@@ -25,15 +25,14 @@ start :: CommandStartString
 start file = isAnnexed file $ \(key, backend) -> do
 	inannex <- inAnnex key
 	if inannex
-		then return Nothing
+		then stop
 		else do
 			showStart "get" file
-			return $ Just $ perform key backend
+			next $ perform key backend
 
 perform :: Key -> Backend Annex -> CommandPerform
 perform key backend = do
 	ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
 	if ok
-		then return $ Just $ return True -- no cleanup needed
+		then next $ return True -- no cleanup needed
-		else return Nothing
+		else stop
-

Command/InAnnex.hs

@@ -24,5 +24,5 @@ start :: CommandStartKey
 start key = do
 	present <- inAnnex key
 	if present
-		then return Nothing
+		then stop
 		else liftIO $ exitFailure

Command/Init.hs

@@ -35,7 +35,7 @@ start description = do
 	when (null description) $
 		error "please specify a description of this repository\n"
 	showStart "init" description
-	return $ Just $ perform description
+	next $ perform description
 
 perform :: String -> CommandPerform
 perform description = do
@@ -48,12 +48,12 @@ perform description = do
 				"This is a bare repository, so its description cannot be committed.\n" ++
 				"To record the description, run this command in a clone of this repository:\n" ++
 				"   git annex describe " ++ show u ++ " " ++ show description ++ "\n\n"
-			return $ Just $ return True
+			next $ return True
 		else do
 			describeUUID u description
 			liftIO $ gitAttributesWrite g
 			gitPreCommitHookWrite g
-			return $ Just cleanup
+			next cleanup
 
 cleanup :: CommandCleanup
 cleanup = do

Command/InitRemote.hs

@@ -39,7 +39,7 @@ start params = notBareRepo $ do
 	t <- findType fullconfig
 	
 	showStart "initremote" name
-	return $ Just $ perform t u $ M.union config c
+	next $ perform t u $ M.union config c
 
 	where
 		ws = words params
@@ -49,7 +49,7 @@ start params = notBareRepo $ do
 perform :: RemoteClass.RemoteType Annex -> UUID -> RemoteClass.RemoteConfig -> CommandPerform
 perform t u c = do
 	c' <- RemoteClass.setup t u c
-	return $ Just $ cleanup u c'
+	next $ cleanup u c'
 
 cleanup :: UUID -> RemoteClass.RemoteConfig -> CommandCleanup
 cleanup u c = do

Command/Lock.hs

@@ -26,7 +26,7 @@ seek = [withFilesUnlocked start]
 start :: CommandStartBackendFile
 start (file, _) = do
 	showStart "lock" file
-	return $ Just $ perform file
+	next $ perform file
 
 perform :: FilePath -> CommandPerform
 perform file = do
@@ -36,4 +36,4 @@ perform file = do
 	liftIO $ Git.run g "reset" [Params "-q --", File file]
 	-- checkout the symlink
 	liftIO $ Git.run g "checkout" [Param "--", File file]
-	return $ Just $ return True -- no cleanup needed
+	next $ return True -- no cleanup needed

Command/Map.hs

@@ -45,7 +45,7 @@ start = do
 	showLongNote $ "running: dot -Tx11 " ++ file
 	showProgress
 	r <- liftIO $ boolSystem "dot" [Param "-Tx11", File file]
-	return $ Just $ return $ Just $ return r
+	next $ next $ return r
 	where
 		file = "map.dot"
 

Command/Migrate.hs

@@ -35,9 +35,8 @@ start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
 	if (newbackend /= oldbackend || upgradable) && exists
 		then do
 			showStart "migrate" file
-			return $ Just $ perform file key newbackend
+			next $ perform file key newbackend
-		else
+		else stop
-			return Nothing
 	where
 		choosebackend Nothing = do
 			backends <- Backend.list
@@ -55,7 +54,7 @@ perform file oldkey newbackend = do
 	let src = gitAnnexLocation g oldkey
 	stored <- Backend.storeFileKey src $ Just newbackend
 	case stored of
-		Nothing -> return Nothing
+		Nothing -> stop
 		Just (newkey, _) -> do
 			ok <- getViaTmpUnchecked newkey $ \t -> do
 				-- Make a hard link to the old backend's
@@ -68,5 +67,5 @@ perform file oldkey newbackend = do
 				then do
 					-- Update symlink to use the new key.
 					liftIO $ removeFile file
-					return $ Just $ Command.Add.cleanup file newkey
+					next $ Command.Add.cleanup file newkey
-				else return Nothing
+				else stop

Command/Move.hs

@@ -73,10 +73,10 @@ toStart dest move file = isAnnexed file $ \(key, _) -> do
 	u <- getUUID g
 	ishere <- inAnnex key
 	if not ishere || u == Remote.uuid dest
-		then return Nothing -- not here, so nothing to do
+		then stop -- not here, so nothing to do
 		else do
 			showAction move file
-			return $ Just $ toPerform dest move key
+			next $ toPerform dest move key
 toPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
 toPerform dest move key = do
 	-- Checking the remote is expensive, so not done in the start step.
@@ -92,14 +92,14 @@ toPerform dest move key = do
 	case isthere of
 		Left err -> do
 			showNote $ show err
-			return Nothing
+			stop
 		Right False -> do
 			showNote $ "to " ++ Remote.name dest ++ "..."
 			ok <- Remote.storeKey dest key
 			if ok
-				then return $ Just $ toCleanup dest move key
+				then next $ toCleanup dest move key
-				else return Nothing -- failed
+				else stop -- failed
-		Right True -> return $ Just $ toCleanup dest move key
+		Right True -> next $ toCleanup dest move key
 toCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup
 toCleanup dest move key = do
 	remoteHasKey dest key True
@@ -119,21 +119,21 @@ fromStart src move file = isAnnexed file $ \(key, _) -> do
 	u <- getUUID g
 	(remotes, _) <- Remote.keyPossibilities key
 	if (u == Remote.uuid src) || (null $ filter (== src) remotes)
-		then return Nothing
+		then stop
 		else do
 			showAction move file
-			return $ Just $ fromPerform src move key
+			next $ fromPerform src move key
 fromPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
 fromPerform src move key = do
 	ishere <- inAnnex key
 	if ishere
-		then return $ Just $ fromCleanup src move key
+		then next $ fromCleanup src move key
 		else do
 			showNote $ "from " ++ Remote.name src ++ "..."
 			ok <- getViaTmp key $ Remote.retrieveKeyFile src key
 			if ok
-				then return $ Just $ fromCleanup src move key
+				then next $ fromCleanup src move key
-				else return Nothing -- fail
+				else stop -- fail
 fromCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup
 fromCleanup src True key = do
 	ok <- Remote.removeKey src key

Command/PreCommit.hs

@@ -27,13 +27,13 @@ seek = [withFilesToBeCommitted Command.Fix.start,
 	withFilesUnlockedToBeCommitted start]
 
 start :: CommandStartBackendFile
-start pair = return $ Just $ perform pair
+start pair = next $ perform pair
 
 perform :: BackendFile -> CommandPerform
 perform pair@(file, _) = do
 	ok <- doCommand $ Command.Add.start pair
 	if ok
-		then return $ Just $ cleanup file
+		then next $ cleanup file
 		else error $ "failed to add " ++ file ++ "; canceling commit"
 
 cleanup :: FilePath -> CommandCleanup

Command/Semitrust.hs

@@ -24,9 +24,9 @@ start :: CommandStartString
 start name = notBareRepo $ do
 	showStart "semitrust" name
 	u <- Remote.nameToUUID name
-	return $ Just $ perform u
+	next $ perform u
 
 perform :: UUID -> CommandPerform
 perform uuid = do
 	trustSet uuid SemiTrusted
-	return $ Just $ return True
+	next $ return True

Command/SetKey.hs

@@ -26,7 +26,7 @@ seek = [withTempFile start]
 start :: CommandStartString
 start file = do
 	showStart "setkey" file
-	return $ Just $ perform file
+	next $ perform file
 
 perform :: FilePath -> CommandPerform
 perform file = do
@@ -40,7 +40,7 @@ perform file = do
 				boolSystem "mv" [File file, File dest]
 			else return True
 	if ok
-		then return $ Just $ cleanup
+		then next cleanup
 		else error "mv failed!"
 
 cleanup :: CommandCleanup

Command/Trust.hs

@@ -24,9 +24,9 @@ start :: CommandStartString
 start name = notBareRepo $ do
 	showStart "trust" name
 	u <- Remote.nameToUUID name
-	return $ Just $ perform u
+	next $ perform u
 
 perform :: UUID -> CommandPerform
 perform uuid = do
 	trustSet uuid Trusted
-	return $ Just $ return True
+	next $ return True

Command/Unannex.hs

@@ -43,16 +43,16 @@ start file = isAnnexed file $ \(key, backend) -> do
 				Annex.changeState $ \s -> s { Annex.force = True }
 
 			showStart "unannex" file
-			return $ Just $ perform file key backend
+			next $ perform file key backend
-		else return Nothing
+		else stop
 
 perform :: FilePath -> Key -> Backend Annex -> CommandPerform
 perform file key backend = do
 	-- force backend to always remove
 	ok <- Backend.removeKey backend key (Just 0)
 	if ok
-		then return $ Just $ cleanup file key
+		then next $ cleanup file key
-		else return Nothing
+		else stop
 
 cleanup :: FilePath -> Key -> CommandCleanup
 cleanup file key = do

Command/Uninit.hs

@@ -30,7 +30,7 @@ seek = [withFilesInGit Command.Unannex.start, withNothing start]
 start :: CommandStartNothing
 start = do
 	showStart "uninit" ""
-	return $ Just $ perform
+	next perform
 
 perform :: CommandPerform
 perform = do
@@ -39,7 +39,7 @@ perform = do
 	gitPreCommitHookUnWrite g
 	liftIO $ gitAttributesUnWrite g
 
-	return $ Just $ return True
+	next $ return True
 
 gitPreCommitHookUnWrite :: Git.Repo -> Annex ()
 gitPreCommitHookUnWrite repo = do

Command/Unlock.hs

@@ -34,7 +34,7 @@ seek = [withFilesInGit start]
 start :: CommandStartString
 start file = isAnnexed file $ \(key, _) -> do
 	showStart "unlock" file
-	return $ Just $ perform file key
+	next $ perform file key
 
 perform :: FilePath -> Key -> CommandPerform
 perform dest key = do
@@ -52,5 +52,5 @@ perform dest key = do
         if ok
                 then do
 			liftIO $ allowWrite dest
-			return $ Just $ return True
+			next $ return True
                 else error "copy failed!"

Command/Untrust.hs

@@ -24,9 +24,9 @@ start :: CommandStartString
 start name = notBareRepo $ do
 	showStart "untrust" name
 	u <- Remote.nameToUUID name
-	return $ Just $ perform u
+	next $ perform u
 
 perform :: UUID -> CommandPerform
 perform uuid = do
 	trustSet uuid UnTrusted
-	return $ Just $ return True
+	next $ return True

Command/Unused.hs

@@ -37,7 +37,7 @@ seek = [withNothing start]
 start :: CommandStartNothing
 start = notBareRepo $ do
 	showStart "unused" ""
-	return $ Just perform
+	next perform
 
 perform :: CommandPerform
 perform = do
@@ -47,7 +47,7 @@ perform = do
 			r <- Remote.byName name
 			checkRemoteUnused r
 		_ -> checkUnused
-	return $ Just $ return True
+	next $ return True
 
 checkUnused :: Annex ()
 checkUnused = do

Command/Upgrade.hs

@@ -24,4 +24,4 @@ start = do
 	showStart "upgrade" ""
 	r <- upgrade
 	checkVersion
-	return $ Just $ return $ Just $ return r
+	next $ next $ return r

Command/Version.hs

@@ -28,6 +28,6 @@ start = do
 	liftIO $ putStrLn $ "default repository version: " ++ defaultVersion
 	liftIO $ putStrLn $ "supported repository versions: " ++ vs supportedVersions
 	liftIO $ putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions
-	return Nothing
+	stop
 	where
 		vs l = join " " l

Command/Whereis.hs

@@ -26,7 +26,7 @@ seek = [withFilesInGit start]
 start :: CommandStartString
 start file = isAnnexed file $ \(key, _) -> do
 	showStart "whereis" file
-	return $ Just $ perform key
+	next $ perform key
 
 perform :: Key -> CommandPerform
 perform key = do
@@ -35,12 +35,12 @@ perform key = do
 	let num = length uuids
 	showNote $ show num ++ " " ++ copiesplural num
 	if null $ uuids
-		then return Nothing
+		then stop
 		else do
 			pp <- prettyPrintUUIDs uuids
 			showLongNote $ pp
 			showProgress	
-			return $ Just $ return True
+			next $ return True
 	where
 		copiesplural 1 = "copy"
 		copiesplural _ = "copies"