From e3154828f5f44071536c19044ea14240efd9880c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 20 Jan 2014 13:31:03 -0400
Subject: much better command action handling for sync --content

---
 RunCommand.hs | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

(limited to 'RunCommand.hs')

diff --git a/RunCommand.hs b/RunCommand.hs
index 32a9c7d48..937686d97 100644
--- a/RunCommand.hs
+++ b/RunCommand.hs
@@ -15,6 +15,8 @@ import Types.Command
 import qualified Annex.Queue
 import Annex.Exception
 
+type CommandActionRunner = CommandStart -> CommandCleanup
+
 {- Runs a command, starting with the check stage, and then
  - the seek stage. Finishes by printing the number of commandActions that
  - failed. -}
@@ -34,25 +36,29 @@ performCommand Command { cmdseek = seek, cmdcheck = c, cmdname = name } params =
  - command).
  - 
  - This should only be run in the seek stage. -}
-commandAction :: CommandStart -> Annex ()
+commandAction :: CommandActionRunner
 commandAction a = handle =<< tryAnnexIO go
   where
 	go = do
 		Annex.Queue.flushWhenFull
 		callCommand a
-	handle (Right True) = noop
+	handle (Right True) = return True
 	handle (Right False) = incerr
 	handle (Left err) = do
 		showErr err
 		showEndFail
 		incerr
-	incerr = Annex.changeState $ \s -> 
-		let ! c = Annex.errcounter s + 1 
-		    ! s' = s { Annex.errcounter = c }
-		in s'
+	incerr = do
+		Annex.changeState $ \s -> 
+			let ! c = Annex.errcounter s + 1 
+			    ! s' = s { Annex.errcounter = c }
+			in s'
+		return False
 
-{- Runs a single command action through the start, perform and cleanup stages -}
-callCommand :: CommandStart -> CommandCleanup
+{- Runs a single command action through the start, perform and cleanup
+ - stages, without catching errors. Useful if one command wants to run
+ - part of another command. -}
+callCommand :: CommandActionRunner
 callCommand = start
   where
 	start   = stage $ maybe skip perform
-- 
cgit v1.2.3