Fix: Print errors to stderr, not stdout

pull/5/head
Lennart Spitzner 2016-09-04 00:50:03 +02:00
parent 4b7f8681e7
commit a4e3d155d6
1 changed files with 17 additions and 9 deletions

View File

@ -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