factor out a stopUnless

code melt for lunch

Command.hs

@@ -10,6 +10,7 @@ module Command (
 	noRepo,
 	next,
 	stop,
+	stopUnless,
 	prepCommand,
 	doCommand,
 	whenAnnexed,
@@ -49,6 +50,12 @@ next a = return $ Just a
 stop :: Annex (Maybe a)
 stop = return Nothing
 
+{- Stops unless a condition is met. -}
+stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
+stopUnless c a = do
+	ok <- c
+	if ok then a else stop
+
 {- Prepares to run a command via the check and seek stages, returning a
  - list of actions to perform to run the command. -}
 prepCommand :: Command -> [String] -> Annex [CommandCleanup]

Command/AddUrl.hs

@@ -45,18 +45,15 @@ download url file = do
 	let dummykey = Backend.URL.fromUrl url
 	tmp <- fromRepo $ gitAnnexTmpLocation dummykey
 	liftIO $ createDirectoryIfMissing True (parentDir tmp)
-	ok <- liftIO $ Url.download url tmp
-	if ok
-		then do
-			[(backend, _)] <- Backend.chooseBackends [file]
-			k <- Backend.genKey tmp backend
-			case k of
-				Nothing -> stop
-				Just (key, _) -> do
-					moveAnnex key tmp
-					setUrlPresent key url
-					next $ Command.Add.cleanup file key True
-		else stop
+	stopUnless (liftIO $ Url.download url tmp) $ do
+		[(backend, _)] <- Backend.chooseBackends [file]
+		k <- Backend.genKey tmp backend
+		case k of
+			Nothing -> stop
+			Just (key, _) -> do
+				moveAnnex key tmp
+				setUrlPresent key url
+				next $ Command.Add.cleanup file key True
 
 nodownload :: String -> FilePath -> CommandPerform
 nodownload url file = do

Command/Drop.hs

@@ -37,13 +37,9 @@ start numcopies file (key, _) = autoCopies key (>) numcopies $ do
 				else startRemote file numcopies key remote
 
 startLocal :: FilePath -> Maybe Int -> Key -> CommandStart
-startLocal file numcopies key = do
-	present <- inAnnex key
-	if present
-		then do
-			showStart "drop" file
-			next $ performLocal key numcopies
-		else stop
+startLocal file numcopies key = stopUnless (inAnnex key) $ do
+	showStart "drop" file
+	next $ performLocal key numcopies
 
 startRemote :: FilePath -> Maybe Int -> Key -> Remote.Remote Annex -> CommandStart
 startRemote file numcopies key remote = do
@@ -55,12 +51,9 @@ performLocal key numcopies = lockContent key $ do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
-	success <- canDropKey key numcopies trusteduuids tocheck []
-	if success
-		then do
-			whenM (inAnnex key) $ removeAnnex key
-			next $ cleanupLocal key
-		else stop
+	stopUnless (canDropKey key numcopies trusteduuids tocheck []) $ do
+		whenM (inAnnex key) $ removeAnnex key
+		next $ cleanupLocal key
 
 performRemote :: Key -> Maybe Int -> Remote.Remote Annex -> CommandPerform
 performRemote key numcopies remote = lockContent key $ do
@@ -75,12 +68,9 @@ performRemote key numcopies remote = lockContent key $ do
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = filter (/= remote) $
 		Remote.remotesWithoutUUID remotes (have++untrusteduuids)
-	success <- canDropKey key numcopies have tocheck [uuid]
-	if success
-		then do
-			ok <- Remote.removeKey remote key
-			next $ cleanupRemote key remote ok
-		else stop
+	stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do
+		ok <- Remote.removeKey remote key
+		next $ cleanupRemote key remote ok
 	where
 		uuid = Remote.uuid remote
 

Command/DropKey.hs

@@ -21,18 +21,11 @@ seek :: [CommandSeek]
 seek = [withKeys start]
 
 start :: Key -> CommandStart
-start key = do
-	present <- inAnnex key
-	if not present
-		then stop
-		else do
-			checkforced
-			showStart "dropkey" (show key)
-			next $ perform key
-	where
-		checkforced = 
-			unlessM (Annex.getState Annex.force) $
-				error "dropkey can cause data loss; use --force if you're sure you want to do this"
+start key = stopUnless (not <$> inAnnex key) $ do
+	unlessM (Annex.getState Annex.force) $
+		error "dropkey can cause data loss; use --force if you're sure you want to do this"
+	showStart "dropkey" (show key)
+	next $ perform key
 
 perform :: Key -> CommandPerform
 perform key = lockContent key $ do

Command/Fix.hs

@@ -23,12 +23,9 @@ seek = [withFilesInGit $ whenAnnexed start]
 start :: FilePath -> (Key, Backend Annex) -> CommandStart
 start file (key, _) = do
 	link <- calcGitLink file key
-	l <- liftIO $ readSymbolicLink file
-	if link == l
-		then stop
-		else do
-			showStart "fix" file
-			next $ perform file link
+	stopUnless ((/=) link <$> liftIO (readSymbolicLink file)) $ do
+		showStart "fix" file
+		next $ perform file link
 
 perform :: FilePath -> FilePath -> CommandPerform
 perform file link = do

Command/Get.hs

@@ -22,32 +22,24 @@ seek :: [CommandSeek]
 seek = [withNumCopies $ \n -> whenAnnexed $ start n]
 
 start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
-start numcopies file (key, _) = do
-	inannex <- inAnnex key
-	if inannex
-		then stop
-		else autoCopies key (<) numcopies $ do
-			from <- Annex.getState Annex.fromremote
-			case from of
-				Nothing -> go $ perform key
-				Just name -> do
-					-- get --from = copy --from
-					src <- Remote.byName name
-					ok <- Command.Move.fromOk src key
-					if ok
-						then go $ Command.Move.fromPerform src False key
-						else stop
+start numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
+	autoCopies key (<) numcopies $ do
+		from <- Annex.getState Annex.fromremote
+		case from of
+			Nothing -> go $ perform key
+			Just name -> do
+				-- get --from = copy --from
+				src <- Remote.byName name
+				stopUnless (Command.Move.fromOk src key) $
+					go $ Command.Move.fromPerform src False key
 	where
 		go a = do
 			showStart "get" file
 			next a	
 
 perform :: Key -> CommandPerform
-perform key = do
-	ok <- getViaTmp key (getKeyFile key)
-	if ok
-		then next $ return True -- no cleanup needed
-		else stop
+perform key = stopUnless (getViaTmp key $ getKeyFile key) $ do
+	next $ return True -- no cleanup needed
 
 {- Try to find a copy of the file in one of the remotes,
  - and copy it to here. -}

Command/Migrate.hs

@@ -58,22 +58,18 @@ perform file oldkey newbackend = do
 	cleantmp tmpfile
 	case k of
 		Nothing -> stop
-		Just (newkey, _) -> do
-			ok <- link src newkey
-			if ok
-				then do
-					-- Update symlink to use the new key.
-					liftIO $ removeFile file
+		Just (newkey, _) -> stopUnless (link src newkey) $ do
+			-- Update symlink to use the new key.
+			liftIO $ removeFile file
 
-					-- If the old key had some
-					-- associated urls, record them for
-					-- the new key as well.
-					urls <- getUrls oldkey
-					unless (null urls) $
-						mapM_ (setUrlPresent newkey) urls
+			-- If the old key had some
+			-- associated urls, record them for
+			-- the new key as well.
+			urls <- getUrls oldkey
+			unless (null urls) $
+				mapM_ (setUrlPresent newkey) urls
 
-					next $ Command.Add.cleanup file newkey True
-				else stop
+			next $ Command.Add.cleanup file newkey True
 	where
 		cleantmp t = liftIO $ whenM (doesFileExist t) $ removeFile t
 		link src newkey = getViaTmpUnchecked newkey $ \t -> do

Command/Move.hs

@@ -108,17 +108,11 @@ toPerform dest move key = moveLock move key $ do
 fromStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart
 fromStart src move file key
 	| move = go
-	| otherwise = do
-		ishere <- inAnnex key
-		if ishere then stop else go
+	| otherwise = stopUnless (inAnnex key) go
 	where
-		go = do
-			ok <- fromOk src key
-			if ok
-				then do
-					showMoveAction move file
-					next $ fromPerform src move key
-				else stop
+		go = stopUnless (fromOk src key) $ do
+			showMoveAction move file
+			next $ fromPerform src move key
 fromOk :: Remote.Remote Annex -> Key -> Annex Bool
 fromOk src key = do
 	u <- getUUID

Command/Unannex.hs

@@ -25,21 +25,17 @@ seek = [withFilesInGit $ whenAnnexed start]
 
 {- The unannex subcommand undoes an add. -}
 start :: FilePath -> (Key, Backend Annex) -> CommandStart
-start file (key, _) = do
-	ishere <- inAnnex key
-	if ishere
-		then do
-			force <- Annex.getState Annex.force
-			unless force $ do
-				top <- fromRepo Git.workTree
-				staged <- inRepo $ LsFiles.staged [top]
-				unless (null staged) $
-					error "This command cannot be run when there are already files staged for commit."
-				Annex.changeState $ \s -> s { Annex.force = True }
+start file (key, _) = stopUnless (inAnnex key) $ do
+	force <- Annex.getState Annex.force
+	unless force $ do
+		top <- fromRepo Git.workTree
+		staged <- inRepo $ LsFiles.staged [top]
+		unless (null staged) $
+			error "This command cannot be run when there are already files staged for commit."
+		Annex.changeState $ \s -> s { Annex.force = True }
 
-			showStart "unannex" file
-			next $ perform file key
-		else stop
+	showStart "unannex" file
+	next $ perform file key
 
 perform :: FilePath -> Key -> CommandPerform
 perform file key = next $ cleanup file key