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
-		v <- liftIO $ catchMaybeIO $ getlinktarget file
-		case v of
+	check getlinktarget fallback = 
+		liftIO (catchMaybeIO $ getlinktarget file) >>= \case
 			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
-		p <- liftIO $ mkSafeDropProof need have removallock
-		case p of
+	helper bad missing have [] =
+		liftIO (mkSafeDropProof need have removallock) >>= \case
 			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
-			p <- liftIO $ mkSafeDropProof need have removallock
-			case p of
+		| isSafeDrop need have removallock =
+			liftIO (mkSafeDropProof need have removallock) >>= \case
 				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
-				haskey <- Remote.hasKey r key
-				case haskey of
+			UnVerifiedRemote r -> checkremote r contverified $
+				Remote.hasKey r key >>= \case
 					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
-		mmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
-		return $ case mmode of
+	want wantmode =
+		liftIO (catchMaybeIO $ fileMode <$> getFileStatus file) >>= return . \case
 			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
-				case res of
+				tryNonAsync (setup t (Enable c) (Just u) Nothing c dummycfg) >>= \case
 					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
-		r <- liftIO $ bestSocketPath $ dir </> hostport2socket host port
-		return $ case r of
+	go (Just dir) =
+		liftIO (bestSocketPath $ dir </> hostport2socket host port) >>= return . \case
 			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
-	case c of
+	Annex.getState Annex.concurrency >>= \case
 		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
-		case v of
+		noUmask mode (tryLockExclusive (Just mode) lockfile) >>= \case
 			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
-		case r of
+		tryLockExclusive (Just mode) lck >>= \case
 			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
-		case v of
+		catchMaybeIO (liftIO $ lockExclusive lck) >>= \case
 			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
-		v <- tryNonAsync run
-		case v of
-			Right b -> return b
-			Left e -> do
-				warning (show e)
-				b <- getbytescomplete metervar
-				let newinfo = oldinfo { bytesComplete = Just b }
-				if shouldretry oldinfo newinfo
-					then retry newinfo metervar run
-					else return observeFailure
+	retry oldinfo metervar run = tryNonAsync run >>= \case
+		Right b -> return b
+		Left e -> do
+			warning (show e)
+			b <- getbytescomplete metervar
+			let newinfo = oldinfo { bytesComplete = Just b }
+			if shouldretry oldinfo newinfo
+				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
-		v <- annexHttpHeadersCommand <$> Annex.getGitConfig
-		case v of
-			Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
-			Nothing -> annexHttpHeaders <$> Annex.getGitConfig
+	headers = annexHttpHeadersCommand <$> Annex.getGitConfig >>= \case
+		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
-	mkey <- isAnnexLink file
-	case mkey of
-		Just key -> makeret key
-		Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect)
-			( ifM (liftIO $ doesFileExist file)
-				( maybe (return Nothing) makeret =<< catKeyFile file
-				, return Nothing
-				)
-			, return Nothing 
+lookupFile file = isAnnexLink file >>= \case
+	Just key -> makeret key
+	Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect)
+		( ifM (liftIO $ doesFileExist file)
+			( maybe (return Nothing) makeret =<< catKeyFile file
+			, 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
-				r <- linkFromAnnex k tmp destmode
-				case r of
+			replaceFile f $ \tmp ->
+				linkFromAnnex k tmp destmode >>= \case
 					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
-			fs <- liftIO $ filterM (doesFileExist) =<< dirContents workdir
-			case fs of
-				(f:[]) -> return (Right (Just f))
-				[] -> return nofiles
-				_ -> return (toomanyfiles fs)
-		Right False -> do
-			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.")
+		Right True -> workdirfiles >>= \case
+			(f:[]) -> return (Right (Just f))
+			[] -> return nofiles
+			fs -> return (toomanyfiles fs)
+		Right False -> workdirfiles >>= \case
+			[] -> return (Right Nothing)
+			_ -> 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
-		dl <- youtubeDl url workdir
-		case dl of
+	res <- withTmpWorkDir key $ \workdir ->
+		youtubeDl url workdir >>= \case
 			Right (Just mediafile) -> do
 				liftIO $ renameFile mediafile dest
 				return (Just True)