1 files changed, 70 insertions, 0 deletions
diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
new file mode 100644
index 000000000..247c658bc
--- /dev/null
+++ b/CmdLine/Action.hs
@@ -0,0 +1,70 @@
+{- git-annex command-line actions
+ -
+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE BangPatterns #-}
+
+module CmdLine.Action where
+
+import Common.Annex
+import qualified Annex
+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. -}
+performCommandAction :: Command -> CmdParams -> Annex ()
+performCommandAction Command { cmdseek = seek, cmdcheck = c, cmdname = name } params = do
+	mapM_ runCheck c
+	Annex.changeState $ \s -> s { Annex.errcounter = 0 }
+	seek params
+	showerrcount =<< Annex.getState Annex.errcounter
+  where
+	showerrcount 0 = noop
+	showerrcount cnt = error $ name ++ ": " ++ show cnt ++ " failed"
+
+{- Runs one of the actions needed to perform a command.
+ - Individual actions can fail without stopping the whole command,
+ - including by throwing IO errors (but other errors terminate the whole
+ - command).
+ - 
+ - This should only be run in the seek stage. -}
+commandAction :: CommandActionRunner
+commandAction a = handle =<< tryAnnexIO go
+  where
+	go = do
+		Annex.Queue.flushWhenFull
+		callCommandAction a
+	handle (Right True) = return True
+	handle (Right False) = incerr
+	handle (Left err) = do
+		showErr err
+		showEndFail
+		incerr
+	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, without catching errors. Useful if one command wants to run
+ - part of another command. -}
+callCommandAction :: CommandActionRunner
+callCommandAction = start
+  where
+	start   = stage $ maybe skip perform
+	perform = stage $ maybe failure cleanup
+	cleanup = stage $ status
+	stage = (=<<)
+	skip = return True
+	failure = showEndFail >> return False
+	status r = showEndResult r >> return r