From 3e15a8a791d15c166557fa18f240639891a8754f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 15 May 2011 12:25:58 -0400
Subject: [PATCH] Maybe reduction pass 2

---
 Command.hs            | 20 ++++++--------------
 GitRepo.hs            | 29 ++++++++++++-----------------
 Messages.hs           |  4 ++++
 Remote/Encryptable.hs | 31 +++++++++++--------------------
 4 files changed, 33 insertions(+), 51 deletions(-)

diff --git a/Command.hs b/Command.hs
index c6c1fe5c55..4f835a3adc 100644
--- a/Command.hs
+++ b/Command.hs
@@ -91,20 +91,12 @@ prepCommand Command { cmdseek = seek } params = do
 
 {- Runs a command through the start, perform and cleanup stages -}
 doCommand :: CommandStart -> CommandCleanup
-doCommand start = do
-	s <- start
-	case s of
-		Nothing -> return True
-		Just perform -> do
-			p <- perform
-			case p of
-				Nothing -> do
-					showEndFail
-					return False
-				Just cleanup -> do
-					c <- cleanup
-					if c then showEndOk else showEndFail
-					return c
+doCommand = start
+	where
+		start   = stage $ maybe (return True) perform
+		perform = stage $ maybe (showEndFail >> return False) cleanup
+		cleanup = stage $ \r -> showEndResult r >> return r
+		stage a b = b >>= a
 
 notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
 notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
diff --git a/GitRepo.hs b/GitRepo.hs
index b20ff7db3a..3c5a1e129e 100644
--- a/GitRepo.hs
+++ b/GitRepo.hs
@@ -210,9 +210,9 @@ assertUrl repo action =
 				" not supported"
 
 configBare :: Repo -> Bool
-configBare repo = case Map.lookup "core.bare" $ config repo of
-	Just v -> configTrue v
-	Nothing -> error $ "it is not known if git repo " ++
+configBare repo = maybe unknown configTrue $ Map.lookup "core.bare" $ config repo
+	where
+		unknown = error $ "it is not known if git repo " ++
 			repoDescribe repo ++
 			" is a bare repository; config not read"
 
@@ -260,11 +260,10 @@ workTreeFile repo@(Repo { location = Dir d }) file = do
 	where
 		-- normalize both repo and file, so that repo
 		-- will be substring of file
-		absrepo = case (absNormPath "/" d) of
-			Just f -> addTrailingPathSeparator f
-			Nothing -> error $ "bad repo" ++ repoDescribe repo
+		absrepo = maybe bad addTrailingPathSeparator $ absNormPath "/" d
 		absfile c = maybe file id $ secureAbsNormPath c file
 		inrepo f = absrepo `isPrefixOf` f
+		bad = error $ "bad repo" ++ repoDescribe repo
 workTreeFile repo _ = assertLocal repo $ error "internal"
 
 {- Path of an URL repo. -}
@@ -627,23 +626,19 @@ expandTilde = expandt True
 
 {- Finds the current git repository, which may be in a parent directory. -}
 repoFromCwd :: IO Repo
-repoFromCwd = do
-	cwd <- getCurrentDirectory
-	top <- seekUp cwd isRepoTop
-	case top of
-		-- repoFromAbsPath is not used to avoid looking for
-		-- "dir.git" directories.
-		(Just dir) -> return $ newFrom $ Dir dir
-		Nothing -> error "Not in a git repository."
+repoFromCwd = getCurrentDirectory >>= seekUp isRepoTop >>= maybe norepo makerepo
+	where
+		makerepo = return . newFrom . Dir
+		norepo = error "Not in a git repository."
 
-seekUp :: FilePath -> (FilePath -> IO Bool) -> IO (Maybe FilePath)
-seekUp dir want = do
+seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
+seekUp want dir = do
 	ok <- want dir
 	if ok
 		then return (Just dir)
 		else case (parentDir dir) of
 			"" -> return Nothing
-			d -> seekUp d want
+			d -> seekUp want d
 
 isRepoTop :: FilePath -> IO Bool
 isRepoTop dir = do
diff --git a/Messages.hs b/Messages.hs
index 733638ce12..c44e44eea1 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -45,6 +45,10 @@ showEndOk = verbose $ liftIO $ putStrLn "ok"
 showEndFail :: Annex ()
 showEndFail = verbose $ liftIO $ putStrLn "\nfailed"
 
+showEndResult :: Bool -> Annex ()
+showEndResult True = showEndOk
+showEndResult False = showEndFail
+
 showErr :: (Show a) => a -> Annex ()
 showErr e = warning $ "git-annex: " ++ show e
 
diff --git a/Remote/Encryptable.hs b/Remote/Encryptable.hs
index f9b388c8ae..68ecfd01e6 100644
--- a/Remote/Encryptable.hs
+++ b/Remote/Encryptable.hs
@@ -54,21 +54,14 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
 		cost = cost r + encryptedRemoteCostAdj
 	}
 	where
-		store k = do
-			v <- cipherKey c k
-			case v of
-				Nothing -> (storeKey r) k
-				Just x -> storeKeyEncrypted x k
-		retrieve k f = do
-			v <- cipherKey c k
-			case v of
-				Nothing -> (retrieveKeyFile r) k f
-				Just x -> retrieveKeyFileEncrypted x f
-		withkey a k = do
-			v <- cipherKey c k
-			case v of
-				Nothing -> a k
-				Just (_, k') -> a k'
+		store k = cip k >>= maybe
+			(storeKey r k)
+			(\x -> storeKeyEncrypted x k)
+		retrieve k f = cip k >>= maybe
+			(retrieveKeyFile r k f)
+			(\x -> retrieveKeyFileEncrypted x f)
+		withkey a k = cip k >>= maybe (a k) (a . snd)
+		cip = cipherKey c
 
 {- Gets encryption Cipher. The decrypted Cipher is cached in the Annex
  - state. -}
@@ -87,10 +80,8 @@ remoteCipher c = maybe expensive cached =<< Annex.getState Annex.cipher
 {- Gets encryption Cipher, and encrypted version of Key. -}
 cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
 cipherKey Nothing _ = return Nothing
-cipherKey (Just c) k = do
-	cipher <- remoteCipher c
-	case cipher of	
-		Just ciphertext -> do
+cipherKey (Just c) k = remoteCipher c >>= maybe (return Nothing) encrypt
+	where
+		encrypt ciphertext = do
 			k' <- liftIO $ encryptKey ciphertext k
 			return $ Just (ciphertext, k')
-		Nothing -> return Nothing