From e87287c11b81ea6f339628bcbebfb239d0ccadd0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 25 Oct 2010 19:17:11 -0400
Subject: [PATCH] fix failure propigation

---
 Commands.hs                     | 26 ++++++++++++++++++--------
 Core.hs                         |  7 +++++--
 doc/bugs/error_propigation.mdwn |  2 +-
 git-annex.hs                    |  5 +++--
 4 files changed, 27 insertions(+), 13 deletions(-)

diff --git a/Commands.hs b/Commands.hs
index 78e1ab32cf..729eae1240 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -42,21 +42,27 @@ type SubCmdPerform = Annex (Maybe SubCmdCleanup)
 type SubCmdCleanup = Annex Bool
 
 {- Runs a subcommand through its three stages. -}
-doSubCmd :: String -> SubCmdStart -> String -> Annex ()
+doSubCmd :: String -> SubCmdStart -> String -> Annex Bool
 doSubCmd cmdname start param = do
 	res <- start param :: Annex (Maybe SubCmdPerform)
 	case (res) of
-		Nothing -> return ()
+		Nothing -> return True
 		Just perform -> do
 			showStart cmdname param
 			res <- perform :: Annex (Maybe SubCmdCleanup)
 			case (res) of
-				Nothing -> showEndFail
+				Nothing -> do
+					showEndFail
+					return False
 				Just cleanup -> do
 					res <- cleanup
 					if (res)
-						then showEndOk
-						else showEndFail
+						then do
+							showEndOk
+							return True
+						else do
+							showEndFail
+							return False
 
 
 {- A subcommand can broadly want one of several kinds of input parameters.
@@ -159,7 +165,7 @@ findWanted Keys params _ = return params
  - run in the Annex monad. The first actions configure it
  - according to command line options, while the second actions
  - handle subcommands. -}
-parseCmd :: [String] -> AnnexState -> IO ([Annex ()], [Annex ()])
+parseCmd :: [String] -> AnnexState -> IO ([Annex Bool], [Annex Bool])
 parseCmd argv state = do
 	(flags, params) <- getopt
 	if (null params)
@@ -169,8 +175,12 @@ parseCmd argv state = do
 			[Command name action want _] -> do
 				f <- findWanted want (drop 1 params)
 					(TypeInternals.repo state)
-				return (flags, map (doSubCmd name action) $
-					filter notstate f)
+				let actions = map (doSubCmd name action) $
+					filter notstate f
+				let configactions = map (\f -> do
+					f
+					return True) flags
+				return (configactions, actions)
 	where
 		-- never include files from the state directory
 		notstate f = stateLoc /= take (length stateLoc) f
diff --git a/Core.hs b/Core.hs
index 8717aee818..0d95e382b0 100644
--- a/Core.hs
+++ b/Core.hs
@@ -18,14 +18,15 @@ import qualified Annex
 import Utility
 			
 {- Sets up a git repo for git-annex. -}
-startup :: Annex ()
+startup :: Annex Bool
 startup = do
 	g <- Annex.gitRepo
 	liftIO $ gitAttributes g
 	prepUUID
+	return True
 
 {- When git-annex is done, it runs this. -}
-shutdown :: Annex ()
+shutdown :: Annex Bool
 shutdown = do
 	g <- Annex.gitRepo
 
@@ -38,6 +39,8 @@ shutdown = do
 		then liftIO $ removeDirectoryRecursive $ tmp
 		else return ()
 
+	return True
+
 {- configure git to use union merge driver on state files, if it is not
  - already -}
 gitAttributes :: Git.Repo -> IO ()
diff --git a/doc/bugs/error_propigation.mdwn b/doc/bugs/error_propigation.mdwn
index 0a0b38f5ee..25998907e8 100644
--- a/doc/bugs/error_propigation.mdwn
+++ b/doc/bugs/error_propigation.mdwn
@@ -1,3 +1,3 @@
 If a subcommand fails w/o throwing an error, no error is propigated to the
 git-annex exit code. With --quiet, this makes it look like the command
-succeeded.
+succeeded. [[done]]
diff --git a/git-annex.hs b/git-annex.hs
index 602f672c5b..d7b26cd968 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -27,7 +27,7 @@ main = do
  - or more likely I missed an easy way to do it. So, I have to laboriously
  - thread AnnexState through this function.
  -}
-tryRun :: AnnexState -> [Annex ()] -> IO ()
+tryRun :: AnnexState -> [Annex Bool] -> IO ()
 tryRun state actions = tryRun' state 0 actions
 tryRun' state errnum (a:as) = do
 	result <- try $ Annex.run state a
@@ -35,7 +35,8 @@ tryRun' state errnum (a:as) = do
 		Left err -> do
 			showErr err
 			tryRun' state (errnum + 1) as
-		Right (_,state') -> tryRun' state' errnum as
+		Right (True,state') -> tryRun' state' errnum as
+		Right (False,state') -> tryRun' state' (errnum + 1) as
 tryRun' state errnum [] = do
 	if (errnum > 0)
 		then error $ (show errnum) ++ " failed"