more lambda-case conversion

Annex/Link.hs

@@ -55,11 +55,10 @@ getAnnexLinkTarget' file coresymlinks = if coresymlinks
 		check probefilecontent $
 			return Nothing
   where
-	check getlinktarget fallback = do
+	check getlinktarget fallback = 
-		v <- liftIO $ catchMaybeIO $ getlinktarget file
+		liftIO (catchMaybeIO $ getlinktarget file) >>= \case
-		case v of
 			Just l
-				| isLinkToAnnex (fromInternalGitPath l) -> return v
+				| isLinkToAnnex (fromInternalGitPath l) -> return (Just l)
 				| otherwise -> return Nothing
 			Nothing -> fallback
 

Annex/NumCopies.hs

@@ -121,24 +121,21 @@ verifyEnoughCopiesToDrop
 verifyEnoughCopiesToDrop nolocmsg key removallock need skip preverified tocheck dropaction nodropaction = 
 	helper [] [] preverified (nub tocheck)
   where
-	helper bad missing have [] = do
+	helper bad missing have [] =
-		p <- liftIO $ mkSafeDropProof need have removallock
+		liftIO (mkSafeDropProof need have removallock) >>= \case
-		case p of
 			Right proof -> dropaction proof
 			Left stillhave -> do
 				notEnoughCopies key need stillhave (skip++missing) bad nolocmsg
 				nodropaction
 	helper bad missing have (c:cs)
-		| isSafeDrop need have removallock = do
+		| isSafeDrop need have removallock =
-			p <- liftIO $ mkSafeDropProof need have removallock
+			liftIO (mkSafeDropProof need have removallock) >>= \case
-			case p of
 				Right proof -> dropaction proof
 				Left stillhave -> helper bad missing stillhave (c:cs)
 		| otherwise = case c of
 			UnVerifiedHere -> lockContentShared key contverified
-			UnVerifiedRemote r -> checkremote r contverified $ do
+			UnVerifiedRemote r -> checkremote r contverified $
-				haskey <- Remote.hasKey r key
+				Remote.hasKey r key >>= \case
-				case haskey of
 					Right True  -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy r : have) cs
 					Left _      -> helper (r:bad) missing have cs
 					Right False -> helper bad (Remote.uuid r:missing) have cs

Annex/Perms.hs

@@ -111,9 +111,8 @@ isContentWritePermOk file = ifM crippledFileSystem
 	go GroupShared = want [ownerWriteMode, groupWriteMode]
 	go AllShared = want writeModes
 	go _ = return True
-	want wantmode = do
+	want wantmode =
-		mmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
+		liftIO (catchMaybeIO $ fileMode <$> getFileStatus file) >>= return . \case
-		return $ case mmode of
 			Nothing -> True
 			Just havemode -> havemode == combineModes (havemode:wantmode)
 

Annex/SpecialRemote.hs

@@ -81,8 +81,7 @@ autoEnable = do
 			(Just name, Right t) -> whenM (canenable u) $ do
 				showSideAction $ "Auto enabling special remote " ++ name
 				dummycfg <- liftIO dummyRemoteGitConfig
-				res <- tryNonAsync $ setup t (Enable c) (Just u) Nothing c dummycfg
+				tryNonAsync (setup t (Enable c) (Just u) Nothing c dummycfg) >>= \case
-				case res of
 					Left e -> warning (show e)
 					Right _ -> return ()
 			_ -> return ()

Annex/Ssh.hs

@@ -101,9 +101,8 @@ sshCachingInfo :: (SshHost, Maybe Integer) -> Annex (Maybe FilePath, [CommandPar
 sshCachingInfo (host, port) = go =<< sshCacheDir
   where
 	go Nothing = return (Nothing, [])
-	go (Just dir) = do
+	go (Just dir) =
-		r <- liftIO $ bestSocketPath $ dir </> hostport2socket host port
+		liftIO (bestSocketPath $ dir </> hostport2socket host port) >>= return . \case
-		return $ case r of
 			Nothing -> (Nothing, [])
 			Just socketfile -> (Just socketfile, sshConnectionCachingParams socketfile)
 
@@ -190,8 +189,7 @@ prepSocket socketfile gc sshhost sshparams = do
 	liftIO $ createDirectoryIfMissing True $ parentDir socketfile
 	let socketlock = socket2lock socketfile
 
-	c <- Annex.getState Annex.concurrency
+	Annex.getState Annex.concurrency >>= \case
-	case c of
 		Concurrent {}
 			| annexUUID (remoteGitConfig gc) /= NoUUID ->
 				makeconnection socketlock
@@ -267,8 +265,7 @@ sshCleanup = mapM_ cleanup =<< enumSocketFiles
 		let lockfile = socket2lock socketfile
 		unlockFile lockfile
 		mode <- annexFileMode
-		v <- noUmask mode $ tryLockExclusive (Just mode) lockfile
+		noUmask mode (tryLockExclusive (Just mode) lockfile) >>= \case
-		case v of
 			Nothing -> noop
 			Just lck -> do
 				forceStopSsh socketfile

Annex/Transfer.hs

@@ -92,8 +92,7 @@ runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t
 	prep tfile mode info = catchPermissionDenied (const prepfailed) $ do
 		let lck = transferLockFile tfile
 		createAnnexDirectory $ takeDirectory lck
-		r <- tryLockExclusive (Just mode) lck
+		tryLockExclusive (Just mode) lck >>= \case
-		case r of
 			Nothing -> return (Nothing, True)
 			Just lockhandle -> ifM (checkSaneLock lck lockhandle)
 				( do
@@ -108,8 +107,7 @@ runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t
 	prep tfile _mode info = catchPermissionDenied (const prepfailed) $ do
 		let lck = transferLockFile tfile
 		createAnnexDirectory $ takeDirectory lck
-		v <- catchMaybeIO $ liftIO $ lockExclusive lck
+		catchMaybeIO (liftIO $ lockExclusive lck) >>= \case
-		case v of
 			Nothing -> return (Nothing, False)
 			Just Nothing -> return (Nothing, True)
 			Just (Just lockhandle) -> do
@@ -135,17 +133,15 @@ runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t
 		dropLock lockhandle
 		void $ tryIO $ removeFile lck
 #endif
-	retry oldinfo metervar run = do
+	retry oldinfo metervar run = tryNonAsync run >>= \case
-		v <- tryNonAsync run
+		Right b -> return b
-		case v of
+		Left e -> do
-			Right b -> return b
+			warning (show e)
-			Left e -> do
+			b <- getbytescomplete metervar
-				warning (show e)
+			let newinfo = oldinfo { bytesComplete = Just b }
-				b <- getbytescomplete metervar
+			if shouldretry oldinfo newinfo
-				let newinfo = oldinfo { bytesComplete = Just b }
+				then retry newinfo metervar run
-				if shouldretry oldinfo newinfo
+				else return observeFailure
-					then retry newinfo metervar run
-					else return observeFailure
 	getbytescomplete metervar
 		| transferDirection t == Upload =
 			liftIO $ readMVar metervar

Annex/Url.hs

@@ -31,11 +31,9 @@ getUrlOptions = mkUrlOptions
 	<*> headers
 	<*> options
   where
-	headers = do
+	headers = annexHttpHeadersCommand <$> Annex.getGitConfig >>= \case
-		v <- annexHttpHeadersCommand <$> Annex.getGitConfig
+		Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
-		case v of
+		Nothing -> annexHttpHeaders <$> Annex.getGitConfig
-			Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
-			Nothing -> annexHttpHeaders <$> Annex.getGitConfig
 	options = map Param . annexWebOptions <$> Annex.getGitConfig
 
 withUrlOptions :: (U.UrlOptions -> IO a) -> Annex a

Annex/WorkTree.hs

@@ -30,17 +30,15 @@ import qualified Database.Keys.SQL
  - looking for a pointer to a key in git.
  -}
 lookupFile :: FilePath -> Annex (Maybe Key)
-lookupFile file = do
+lookupFile file = isAnnexLink file >>= \case
-	mkey <- isAnnexLink file
+	Just key -> makeret key
-	case mkey of
+	Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect)
-		Just key -> makeret key
+		( ifM (liftIO $ doesFileExist file)
-		Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect)
+			( maybe (return Nothing) makeret =<< catKeyFile file
-			( ifM (liftIO $ doesFileExist file)
+			, return Nothing
-				( maybe (return Nothing) makeret =<< catKeyFile file
-				, return Nothing
-				)
-			, return Nothing 
 			)
+		, return Nothing 
+		)
   where
 	makeret = return . Just
 
@@ -84,9 +82,8 @@ scanUnlockedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ do
 		whenM (inAnnex k) $ do
 			f <- fromRepo $ fromTopFilePath tf
 			destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f
-			replaceFile f $ \tmp -> do
+			replaceFile f $ \tmp ->
-				r <- linkFromAnnex k tmp destmode
+				linkFromAnnex k tmp destmode >>= \case
-				case r of
 					LinkAnnexOk -> return ()
 					LinkAnnexNoop -> return ()
 					LinkAnnexFailed -> liftIO $

Annex/YoutubeDl.hs

@@ -30,23 +30,20 @@ import Logs.Transfer
 youtubeDl :: URLString -> FilePath -> Annex (Either String (Maybe FilePath))
 youtubeDl url workdir = ifM (liftIO $ inPath "youtube-dl")
 	( runcmd >>= \case
-		Right True -> do
+		Right True -> workdirfiles >>= \case
-			fs <- liftIO $ filterM (doesFileExist) =<< dirContents workdir
+			(f:[]) -> return (Right (Just f))
-			case fs of
+			[] -> return nofiles
-				(f:[]) -> return (Right (Just f))
+			fs -> return (toomanyfiles fs)
-				[] -> return nofiles
+		Right False -> workdirfiles >>= \case
-				_ -> return (toomanyfiles fs)
+			[] -> return (Right Nothing)
-		Right False -> do
+			_ -> return (Left "youtube-dl download is incomplete. Run the command again to resume.")
-			fs <- liftIO $ filterM (doesFileExist) =<< dirContents workdir
-			if null fs
-				then return (Right Nothing)
-				else return (Left "youtube-dl download is incomplete. Run the command again to resume.")
 		Left msg -> return (Left msg)
 	, return (Right Nothing)
 	)
   where
 	nofiles = Left "youtube-dl did not put any media in its work directory, perhaps it's been configured to store files somewhere else?"
 	toomanyfiles fs = Left $ "youtube-dl downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs
+	workdirfiles = liftIO $ filterM (doesFileExist) =<< dirContents workdir
 	runcmd = youtubeDlMaxSize workdir >>= \case
 		Left msg -> return (Left msg)
 		Right maxsize -> do
@@ -96,9 +93,8 @@ youtubeDlMaxSize workdir = ifM (Annex.getState Annex.force)
 -- Download a media file to a destination, 
 youtubeDlTo :: Key -> URLString -> FilePath -> Annex Bool
 youtubeDlTo key url dest = do
-	res <- withTmpWorkDir key $ \workdir -> do
+	res <- withTmpWorkDir key $ \workdir ->
-		dl <- youtubeDl url workdir
+		youtubeDl url workdir >>= \case
-		case dl of
 			Right (Just mediafile) -> do
 				liftIO $ renameFile mediafile dest
 				return (Just True)

Assistant/MakeRemote.hs

@@ -79,17 +79,15 @@ initSpecialRemote name remotetype mcreds config = go 0
 	go :: Int -> Annex RemoteName
 	go n = do
 		let fullname = if n == 0  then name else name ++ show n
-		r <- Annex.SpecialRemote.findExisting fullname
+		Annex.SpecialRemote.findExisting fullname >>= \case
-		case r of
 			Nothing -> setupSpecialRemote fullname remotetype config mcreds
 				(Nothing, R.Init, Annex.SpecialRemote.newConfig fullname)
 			Just _ -> go (n + 1)
 
 {- Enables an existing special remote. -}
 enableSpecialRemote :: SpecialRemoteMaker
-enableSpecialRemote name remotetype mcreds config = do
+enableSpecialRemote name remotetype mcreds config =
-	r <- Annex.SpecialRemote.findExisting name
+	Annex.SpecialRemote.findExisting name >>= \case
-	case r of
 		Nothing -> error $ "Cannot find a special remote named " ++ name
 		Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c)
 

Assistant/NamedThread.hs

@@ -35,9 +35,8 @@ import qualified Data.Text as T
  - Named threads are run by a management thread, so if they crash
  - an alert is displayed, allowing the thread to be restarted. -}
 startNamedThread :: UrlRenderer -> NamedThread -> Assistant ()
-startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do
+startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) =
-	m <- startedThreads <$> getDaemonStatus
+	M.lookup name . startedThreads <$> getDaemonStatus >>= \case
-	case M.lookup name m of
 		Nothing -> start
 		Just (aid, _) -> do
 			r <- liftIO (E.try (poll aid) :: IO (Either E.SomeException (Maybe (Either E.SomeException ()))))
@@ -65,24 +64,22 @@ startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do
 			a
 		void $ forkIO $ manager d aid
 		return aid
-	manager d aid = do
+	manager d aid = (E.try (wait aid) :: IO (Either E.SomeException ())) >>= \case
-		r <- E.try (wait aid) :: IO (Either E.SomeException ())
+		Right _ -> noop
-		case r of
+		Left e -> do
-			Right _ -> noop
+			let msg = unwords
-			Left e -> do
+				[ fromThreadName $ threadName d
-				let msg = unwords
+				, "crashed:", show e
-					[ fromThreadName $ threadName d
+				]
-					, "crashed:", show e
+			hPutStrLn stderr msg
-					]
-				hPutStrLn stderr msg
 #ifdef WITH_WEBAPP
-				button <- runAssistant d $ mkAlertButton True
+			button <- runAssistant d $ mkAlertButton True
-					(T.pack "Restart Thread")
+				(T.pack "Restart Thread")
-					urlrenderer 
+				urlrenderer 
-					(RestartThreadR name)
+				(RestartThreadR name)
-				runAssistant d $ void $ addAlert $
+			runAssistant d $ void $ addAlert $
-					(warningAlert (fromThreadName name) msg)
+				(warningAlert (fromThreadName name) msg)
-						{ alertButtons = [button] }
+					{ alertButtons = [button] }
 #endif
 
 namedThreadId :: NamedThread -> Assistant (Maybe ThreadId)

Backend.hs

@@ -52,8 +52,7 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend
 genKey :: KeySource -> Maybe Backend -> Annex (Maybe (Key, Backend))
 genKey source preferredbackend = do
 	b <- maybe defaultBackend return preferredbackend
-	r <- B.getKey b source
+	B.getKey b source >>= return . \case
-	return $ case r of
 		Nothing -> Nothing
 		Just k -> Just (makesane k, b)
   where

Backend/Hash.hs

@@ -176,9 +176,8 @@ hashFile hash file filesize = go hash
 	
 	usehasher hashsize@(HashSize sz) = case shaHasher hashsize filesize of
 		Left sha -> use sha
-		Right (external, internal) -> do
+		Right (external, internal) ->
-			v <- liftIO $ externalSHA external sz file
+			liftIO (externalSHA external sz file) >>= \case
-			case v of
 				Right r -> return r
 				Left e -> do
 					warning e

CmdLine/Action.hs

@@ -186,13 +186,11 @@ allowConcurrentOutput = id
 onlyActionOn :: Key -> CommandStart -> CommandStart
 onlyActionOn k a = onlyActionOn' k run
   where
-	run = do
+	-- Run whole action, not just start stage, so other threads
-		-- Run whole action, not just start stage, so other threads
+	-- block until it's done.
-		-- block until it's done.
+	run = callCommandAction' a >>= \case
-		r <- callCommandAction' a
+		Nothing -> return Nothing
-		case r of
+		Just r' -> return $ Just $ return $ Just $ return r'
-			Nothing -> return Nothing
-			Just r' -> return $ Just $ return $ Just $ return r'
 
 onlyActionOn' :: Key -> Annex a -> Annex a
 onlyActionOn' k a = go =<< Annex.getState Annex.concurrency

CmdLine/GitAnnexShell/Checks.hs

@@ -21,12 +21,10 @@ checkNotReadOnly :: IO ()
 checkNotReadOnly = checkEnv "GIT_ANNEX_SHELL_READONLY"
 
 checkEnv :: String -> IO ()
-checkEnv var = do
+checkEnv var = getEnv var >>= \case
-	v <- getEnv var
+	Nothing -> noop
-	case v of
+	Just "" -> noop
-		Nothing -> noop
+	Just _ -> giveup $ "Action blocked by " ++ var
-		Just "" -> noop
-		Just _ -> giveup $ "Action blocked by " ++ var
 
 checkDirectory :: Maybe FilePath -> IO ()
 checkDirectory mdir = do

CmdLine/GitRemoteTorAnnex.hs

@@ -19,14 +19,12 @@ import P2P.Address
 import P2P.Auth
 
 run :: [String] -> IO ()
-run (_remotename:address:[]) = forever $ do
+run (_remotename:address:[]) = forever $
-	-- gitremote-helpers protocol
+	getLine >>= \case
-	l <- getLine
-	case l of
 		"capabilities" -> putStrLn "connect" >> ready
 		"connect git-upload-pack" -> go UploadPack
 		"connect git-receive-pack" -> go ReceivePack
-		_ -> error $ "git-remote-helpers protocol error at " ++ show l
+		l -> error $ "git-remote-helpers protocol error at " ++ show l
   where
 	(onionaddress, onionport)
 		| '/' `elem` address = parseAddressPort $
@@ -59,8 +57,6 @@ connectService address port service = do
 		myuuid <- getUUID
 		g <- Annex.gitRepo
 		conn <- liftIO $ connectPeer g (TorAnnex address port)
-		liftIO $ runNetProto conn $ do
+		liftIO $ runNetProto conn $ auth myuuid authtoken >>= \case
-			v <- auth myuuid authtoken
+			Just _theiruuid -> connect service stdin stdout
-			case v of
+			Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv
-				Just _theiruuid -> connect service stdin stdout
-				Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv

CmdLine/Seek.hs

@@ -84,8 +84,7 @@ withFilesInRefs a = mapM_ go
 		(l, cleanup) <- inRepo $ LsTree.lsTree r
 		forM_ l $ \i -> do
 			let f = getTopFilePath $ LsTree.file i
-			v <- catKey (LsTree.sha i)
+			catKey (LsTree.sha i) >>= \case
-			case v of
 				Nothing -> noop
 				Just k -> whenM (matcher $ MatchingKey k) $
 					commandAction $ a f k

Command.hs

@@ -68,8 +68,7 @@ noMessages c = c { cmdnomessages = True }
 {- Undoes noMessages -}
 allowMessages :: Annex ()
 allowMessages = do
-	curr <- Annex.getState Annex.output
+	outputType <$> Annex.getState Annex.output >>= \case
-	case outputType curr of
 		QuietOutput -> Annex.setOutput NormalOutput
 		_ -> noop
 	Annex.changeState $ \s -> s

Command/Add.hs

@@ -98,31 +98,25 @@ start file = do
 		)
   where
 	go = ifAnnexed file addpresent add
-	add = do
+	add = liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
-		ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
+		Nothing -> stop
-		case ms of
+		Just s 
-			Nothing -> stop
+			| not (isRegularFile s) && not (isSymbolicLink s) -> stop
-			Just s 
+			| otherwise -> do
-				| not (isRegularFile s) && not (isSymbolicLink s) -> stop
+				showStart "add" file
-				| otherwise -> do
+				next $ if isSymbolicLink s
-					showStart "add" file
+					then next $ addFile file
-					next $ if isSymbolicLink s
+					else perform file
-						then next $ addFile file
-						else perform file
 	addpresent key = ifM versionSupportsUnlockedPointers
-		( do
+		( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
-			ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
+			Just s | isSymbolicLink s -> fixuplink key
-			case ms of
+			_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)
-				Just s | isSymbolicLink s -> fixuplink key
+				( stop, add )
-				_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)
-						( stop, add )
 		, ifM isDirect
-			( do
+			( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
-				ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
+				Just s | isSymbolicLink s -> fixuplink key
-				case ms of
+				_ -> ifM (goodContent key file)
-					Just s | isSymbolicLink s -> fixuplink key
+					( stop , add )
-					_ -> ifM (goodContent key file)
-						( stop , add )
 			, fixuplink key
 			)
 		)

Command/AddUrl.hs

@@ -274,9 +274,8 @@ downloadWeb o url urlinfo file =
 		finishDownloadWith tmp webUUID url file
 	tryyoutubedl tmp = withTmpWorkDir mediakey $ \workdir ->
 		Transfer.notifyTransfer Transfer.Download url $
-			Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \_p -> do
+			Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \_p ->
-				dl <- youtubeDl url workdir
+				youtubeDl url workdir >>= \case
-				case dl of
 					Right (Just mediafile) -> do
 						pruneTmpWorkDirBefore tmp (liftIO . nukeFile)
 						let dest = if isJust (fileOption o)
@@ -338,8 +337,7 @@ finishDownloadWith tmp u url file = do
 		, contentLocation = tmp
 		, inodeCache = Nothing
 		}
-	k <- genKey source backend
+	genKey source backend >>= \case
-	case k of
 		Nothing -> return Nothing
 		Just (key, _) -> do
 			addWorkTree u url file key (Just tmp)

Command/CalcKey.hs

@@ -19,10 +19,8 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
 		(batchable run (pure ()))
 
 run :: () -> String -> Annex Bool
-run _ file = do
+run _ file = genKey (KeySource file file Nothing) Nothing >>= \case
-	mkb <- genKey (KeySource file file Nothing) Nothing
+	Just (k, _) -> do
-	case mkb of
+		liftIO $ putStrLn $ key2file k
-		Just (k, _) -> do
+		return True
-			liftIO $ putStrLn $ key2file k
+	Nothing -> return False
-			return True
-		Nothing -> return False

Command/CheckPresentKey.hs

@@ -52,12 +52,10 @@ check ks mr = case mr of
 	k = toKey ks
 	go Nothing [] = return NotPresent
 	go (Just e) [] = return $ CheckFailure e
-	go olderr (r:rs) = do
+	go olderr (r:rs) = Remote.hasKey r k >>= \case
-		v <- Remote.hasKey r k
+		Right True -> return Present
-		case v of
+		Right False -> go olderr rs
-			Right True -> return Present
+		Left e -> go (Just e) rs
-			Right False -> go olderr rs
-			Left e -> go (Just e) rs
 
 exitResult :: Result -> Annex a
 exitResult Present = liftIO exitSuccess

Command/Config.hs

@@ -62,9 +62,8 @@ seek (UnsetConfig name) = commandAction $ do
 		unsetGlobalConfig name
 		unsetConfig (ConfigKey name)
 		return True
-seek (GetConfig name) = commandAction $ do
+seek (GetConfig name) = commandAction $
-	mv <- getGlobalConfig name
+	getGlobalConfig name >>= \case
-	case mv of
 		Nothing -> stop
 		Just v -> do
 			liftIO $ putStrLn v

Command/Dead.hs

@@ -34,8 +34,7 @@ seek (DeadKeys ks) = seekActions $ pure $ map startKey ks
 startKey :: Key -> CommandStart
 startKey key = do
 	showStart' "dead" (Just $ key2file key)
-	ls <- keyLocations key
+	keyLocations key >>= \case
-	case ls of
 		[] -> next $ performKey key
 		_ -> giveup "This key is still known to be present in some locations; not marking as dead."
 		

Command/Direct.hs

@@ -47,13 +47,11 @@ perform = do
 	next cleanup
   where
 	go = whenAnnexed $ \f k -> do
-		r <- toDirectGen k f
+		toDirectGen k f >>= \case
-		case r of
 			Nothing -> noop
 			Just a -> do
 				showStart "direct" f
-				r' <- tryNonAsync a
+				tryNonAsync a >>= \case
-				case r' of
 					Left e -> warnlocked e
 					Right _ -> showEndOk
 		return Nothing

Command/EnableRemote.hs

@@ -68,8 +68,7 @@ startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remo
 startSpecialRemote name config Nothing = do
 	m <- Annex.SpecialRemote.specialRemoteMap
 	confm <- Logs.Remote.readRemoteLog
-	v <- Remote.nameToUUID' name
+	Remote.nameToUUID' name >>= \case
-	case v of
 		Right u | u `M.member` m ->
 			startSpecialRemote name config $
 				Just (u, fromMaybe M.empty (M.lookup u confm))
@@ -91,8 +90,7 @@ performSpecialRemote t u oldc c gc = do
 cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup
 cleanupSpecialRemote u c = do
 	Logs.Remote.configSet u c
-	mr <- Remote.byUUID u
+	Remote.byUUID u >>= \case
-	case mr of
 		Nothing -> noop
 		Just r -> setRemoteIgnore (R.repo r) False
 	return True

Command/EnableTor.hs

@@ -91,8 +91,7 @@ checkHiddenService = bracket setup cleanup go
 		g <- Annex.gitRepo
 		-- Connect but don't bother trying to auth,
 		-- we just want to know if the tor circuit works.
-		cv <- liftIO $ tryNonAsync $ connectPeer g addr
+		liftIO (tryNonAsync $ connectPeer g addr) >>= \case
-		case cv of
 			Left e -> do
 				warning $ "Unable to connect to hidden service. It may not yet have propigated to the Tor network. (" ++ show e ++ ") Will retry.."
 				liftIO $ threadDelaySeconds (Seconds 2)

Command/Fix.hs

@@ -82,8 +82,7 @@ makeHardLink :: FilePath -> Key -> CommandPerform
 makeHardLink file key = do
 	replaceFile file $ \tmp -> do
 		mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
-		r <- linkFromAnnex key tmp mode
+		linkFromAnnex key tmp mode >>= \case
-		case r of
 			LinkAnnexFailed -> error "unable to make hard link"
 			_ -> noop
 	next $ return True

Command/Fsck.hs

@@ -103,15 +103,13 @@ checkDeadRepo u =
 		earlyWarning "Warning: Fscking a repository that is currently marked as dead."
 
 start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
-start from inc file key = do
+start from inc file key = Backend.getBackend file key >>= \case
-	v <- Backend.getBackend file key
+	Nothing -> stop
-	case v of
+	Just backend -> do
-		Nothing -> stop
+		numcopies <- getFileNumCopies file
-		Just backend -> do
+		case from of
-			numcopies <- getFileNumCopies file
+			Nothing -> go $ perform key file backend numcopies
-			case from of
+			Just r -> go $ performRemote key afile backend numcopies r
-				Nothing -> go $ perform key file backend numcopies
-				Just r -> go $ performRemote key afile backend numcopies r
   where
 	go = runFsck inc (mkActionItem afile) key
 	afile = AssociatedFile (Just file)
@@ -142,9 +140,8 @@ performRemote key afile backend numcopies remote =
 	dispatch (Left err) = do
 		showNote err
 		return False
-	dispatch (Right True) = withtmp $ \tmpfile -> do
+	dispatch (Right True) = withtmp $ \tmpfile ->
-		r <- getfile tmpfile
+		getfile tmpfile >>= \case
-		case r of
 			Nothing -> go True Nothing
 			Just True -> go True (Just tmpfile)
 			Just False -> do