Fix: Print errors to stderr, not stdout
parent
4b7f8681e7
commit
a4e3d155d6
|
@ -28,6 +28,8 @@ import UI.Butcher.Monadic.Types
|
||||||
import UI.Butcher.Monadic.Core
|
import UI.Butcher.Monadic.Core
|
||||||
import UI.Butcher.Monadic.Pretty
|
import UI.Butcher.Monadic.Pretty
|
||||||
|
|
||||||
|
import System.IO
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
mainFromCmdParser :: CmdParser Identity (IO ()) () -> IO ()
|
mainFromCmdParser :: CmdParser Identity (IO ()) () -> IO ()
|
||||||
|
@ -35,15 +37,15 @@ mainFromCmdParser cmd = do
|
||||||
progName <- System.Environment.getProgName
|
progName <- System.Environment.getProgName
|
||||||
case cmdCheckParser (Just progName) cmd of
|
case cmdCheckParser (Just progName) cmd of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
putStrLn $ progName ++ ": internal error: failed sanity check for butcher main command parser!"
|
putStrErrLn $ progName ++ ": internal error: failed sanity check for butcher main command parser!"
|
||||||
putStrLn $ "(" ++ e ++ ")"
|
putStrErrLn $ "(" ++ e ++ ")"
|
||||||
putStrLn $ "aborting."
|
putStrErrLn $ "aborting."
|
||||||
Right _ -> do
|
Right _ -> do
|
||||||
args <- System.Environment.getArgs
|
args <- System.Environment.getArgs
|
||||||
case cmdRunParser (Just progName) (InputArgs args) cmd of
|
case cmdRunParser (Just progName) (InputArgs args) cmd of
|
||||||
(desc, Left (ParsingError mess remaining)) -> do
|
(desc, Left (ParsingError mess remaining)) -> do
|
||||||
putStrLn $ progName ++ ": error parsing arguments: " ++ head mess
|
putStrErrLn $ progName ++ ": error parsing arguments: " ++ head mess
|
||||||
putStrLn $ case remaining of
|
putStrErrLn $ case remaining of
|
||||||
InputString "" -> "at the end of input."
|
InputString "" -> "at the end of input."
|
||||||
InputString str -> case show str of
|
InputString str -> case show str of
|
||||||
s | length s < 42 -> "at: " ++ s ++ "."
|
s | length s < 42 -> "at: " ++ s ++ "."
|
||||||
|
@ -52,12 +54,12 @@ mainFromCmdParser cmd = do
|
||||||
InputArgs xs -> case List.unwords $ show <$> xs of
|
InputArgs xs -> case List.unwords $ show <$> xs of
|
||||||
s | length s < 42 -> "at: " ++ s ++ "."
|
s | length s < 42 -> "at: " ++ s ++ "."
|
||||||
s -> "at: " ++ take 40 s ++ "..\"."
|
s -> "at: " ++ take 40 s ++ "..\"."
|
||||||
putStrLn $ "usage:"
|
putStrErrLn $ "usage:"
|
||||||
print $ ppUsage desc
|
printErr $ ppUsage desc
|
||||||
(desc, Right out) -> case _cmd_out out of
|
(desc, Right out) -> case _cmd_out out of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
putStrLn $ "usage:"
|
putStrErrLn $ "usage:"
|
||||||
print $ ppUsage desc
|
printErr $ ppUsage desc
|
||||||
Just a -> a
|
Just a -> a
|
||||||
|
|
||||||
addHelpCommand :: Applicative f => CmdParser f (IO ()) ()
|
addHelpCommand :: Applicative f => CmdParser f (IO ()) ()
|
||||||
|
@ -71,3 +73,9 @@ addButcherDebugCommand = addCmd "butcherdebug" $ do
|
||||||
desc <- peekCmdDesc
|
desc <- peekCmdDesc
|
||||||
addCmdImpl $ do
|
addCmdImpl $ do
|
||||||
print $ maybe undefined snd (_cmd_mParent desc)
|
print $ maybe undefined snd (_cmd_mParent desc)
|
||||||
|
|
||||||
|
putStrErrLn :: String -> IO ()
|
||||||
|
putStrErrLn s = hPutStrLn stderr s
|
||||||
|
|
||||||
|
printErr :: Show a => a -> IO ()
|
||||||
|
printErr = putStrErrLn . show
|
||||||
|
|
Loading…
Reference in New Issue