add command name to some output

This commit is contained in:
Joey Hess 2011-10-30 16:38:48 -04:00
parent 4e9be0d1f8
commit ee71564754
2 changed files with 21 additions and 15 deletions

View file

@ -26,22 +26,25 @@ dispatch :: [String] -> [Command] -> [Option] -> String -> Git.Repo -> IO ()
dispatch args cmds options header gitrepo = do dispatch args cmds options header gitrepo = do
setupConsole setupConsole
state <- Annex.new gitrepo state <- Annex.new gitrepo
(actions, state') <- Annex.run state $ parseCmd args header cmds options ((cmd, actions), state') <- Annex.run state $ parseCmd args header cmds options
tryRun state' $ [startup] ++ actions ++ [shutdown] tryRun state' cmd $ [startup] ++ actions ++ [shutdown]
{- Parses command line, stores configure flags, and returns a {- Parses command line, stores configure flags, and returns a
- list of actions to be run in the Annex monad. -} - list of actions to be run in the Annex monad and the Command
parseCmd :: [String] -> String -> [Command] -> [Option] -> Annex [Annex Bool] - being run. -}
parseCmd :: [String] -> String -> [Command] -> [Option] -> Annex (Command, [Annex Bool])
parseCmd argv header cmds options = do parseCmd argv header cmds options = do
(flags, params) <- liftIO getopt (flags, params) <- liftIO getopt
when (null params) $ error $ "missing command" ++ usagemsg when (null params) $ error $ "missing command" ++ usagemsg
case lookupCmd (head params) of let (c:rest) = params
[] -> error $ "unknown command" ++ usagemsg case lookupCmd c of
[] -> error $ "unknown command " ++ c ++ " " ++ usagemsg
[cmd] -> do [cmd] -> do
_ <- sequence flags _ <- sequence flags
checkCommand cmd checkCommand cmd
prepCommand cmd (drop 1 params) as <- prepCommand cmd rest
_ -> error "internal error: multiple matching commands" return (cmd, as)
_ -> error $ "internal error: multiple matching commands for " ++ c
where where
getopt = case getOpt Permute options argv of getopt = case getOpt Permute options argv of
(flags, params, []) -> (flags, params, []) ->
@ -70,10 +73,10 @@ usage header cmds options =
{- Runs a list of Annex actions. Catches IO errors and continues {- Runs a list of Annex actions. Catches IO errors and continues
- (but explicitly thrown errors terminate the whole command). - (but explicitly thrown errors terminate the whole command).
-} -}
tryRun :: Annex.AnnexState -> [Annex Bool] -> IO () tryRun :: Annex.AnnexState -> Command -> [Annex Bool] -> IO ()
tryRun = tryRun' 0 tryRun = tryRun' 0
tryRun' :: Integer -> Annex.AnnexState -> [Annex Bool] -> IO () tryRun' :: Integer -> Annex.AnnexState -> Command -> [Annex Bool] -> IO ()
tryRun' errnum state (a:as) = do tryRun' errnum state cmd (a:as) = do
result <- try $ Annex.run state $ do result <- try $ Annex.run state $ do
Annex.Queue.flushWhenFull Annex.Queue.flushWhenFull
a a
@ -82,10 +85,11 @@ tryRun' errnum state (a:as) = do
Annex.eval state $ do Annex.eval state $ do
showErr err showErr err
showEndFail showEndFail
tryRun' (errnum + 1) state as tryRun' (errnum + 1) state cmd as
Right (True,state') -> tryRun' errnum state' as Right (True,state') -> tryRun' errnum state' cmd as
Right (False,state') -> tryRun' (errnum + 1) state' as Right (False,state') -> tryRun' (errnum + 1) state' cmd as
tryRun' errnum _ [] = when (errnum > 0) $ error $ show errnum ++ " failed" tryRun' errnum _ cmd [] = when (errnum > 0) $
error $ cmdname cmd ++ ": " ++ show errnum ++ " failed"
{- Actions to perform each time ran. -} {- Actions to perform each time ran. -}
startup :: Annex Bool startup :: Annex Bool

View file

@ -22,3 +22,5 @@ Better:
etc pp. etc pp.
> [[done]] --[[Joey]]