more lambda-case conversion

4 files changed, 16 insertions, 25 deletions

diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
index b8d0e3a40..2e0bc2ba2 100644
--- a/CmdLine/Action.hs
+++ b/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
-		-- block until it's done.
-		r <- callCommandAction' a
-		case r of
-			Nothing -> return Nothing
-			Just r' -> return $ Just $ return $ Just $ return r'
+	-- Run whole action, not just start stage, so other threads
+	-- block until it's done.
+	run = callCommandAction' a >>= \case
+		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
diff --git a/CmdLine/GitAnnexShell/Checks.hs b/CmdLine/GitAnnexShell/Checks.hs
index 47bc11a76..fcbf14b24 100644
--- a/CmdLine/GitAnnexShell/Checks.hs
+++ b/CmdLine/GitAnnexShell/Checks.hs
@@ -21,12 +21,10 @@ checkNotReadOnly :: IO ()
 checkNotReadOnly = checkEnv "GIT_ANNEX_SHELL_READONLY"
 
 checkEnv :: String -> IO ()
-checkEnv var = do
-	v <- getEnv var
-	case v of
-		Nothing -> noop
-		Just "" -> noop
-		Just _ -> giveup $ "Action blocked by " ++ var
+checkEnv var = getEnv var >>= \case
+	Nothing -> noop
+	Just "" -> noop
+	Just _ -> giveup $ "Action blocked by " ++ var
 
 checkDirectory :: Maybe FilePath -> IO ()
 checkDirectory mdir = do
diff --git a/CmdLine/GitRemoteTorAnnex.hs b/CmdLine/GitRemoteTorAnnex.hs
index 5208a47ca..8a8779755 100644
--- a/CmdLine/GitRemoteTorAnnex.hs
+++ b/CmdLine/GitRemoteTorAnnex.hs
@@ -19,14 +19,12 @@ import P2P.Address
 import P2P.Auth
 
 run :: [String] -> IO ()
-run (_remotename:address:[]) = forever $ do
-	-- gitremote-helpers protocol
-	l <- getLine
-	case l of
+run (_remotename:address:[]) = forever $
+	getLine >>= \case
 		"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
-			v <- auth myuuid authtoken
-			case v of
-				Just _theiruuid -> connect service stdin stdout
-				Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv
+		liftIO $ runNetProto conn $ auth myuuid authtoken >>= \case
+			Just _theiruuid -> connect service stdin stdout
+			Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 72f1303af..621f116a0 100644
--- a/CmdLine/Seek.hs
+++ b/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)
-			case v of
+			catKey (LsTree.sha i) >>= \case
 				Nothing -> noop
 				Just k -> whenM (matcher $ MatchingKey k) $
 					commandAction $ a f k