add command name to some output
This commit is contained in:
parent
4e9be0d1f8
commit
ee71564754
2 changed files with 21 additions and 15 deletions
34
CmdLine.hs
34
CmdLine.hs
|
@ -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
|
||||||
|
|
|
@ -22,3 +22,5 @@ Better:
|
||||||
|
|
||||||
|
|
||||||
etc pp.
|
etc pp.
|
||||||
|
|
||||||
|
> [[done]] --[[Joey]]
|
||||||
|
|
Loading…
Reference in a new issue