diff options
| -rw-r--r-- | Commands.hs | 26 | ||||
| -rw-r--r-- | Core.hs | 7 | ||||
| -rw-r--r-- | doc/bugs/error_propigation.mdwn | 2 | ||||
| -rw-r--r-- | git-annex.hs | 5 |
4 files changed, 27 insertions, 13 deletions
diff --git a/Commands.hs b/Commands.hs index 78e1ab32c..729eae124 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 @@ -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 0a0b38f5e..25998907e 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 602f672c5..d7b26cd96 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" |