Commit 4bdbdfab authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Wrap the output of the logging functions

So we'll not have to keep adjusting newline breaks.
parent 7dec8d23
......@@ -70,7 +70,7 @@ import Distribution.Simple.Command
import Distribution.Simple.Compiler
( CompilerFlavor(..), defaultCompilerFlavor, PackageDB(..)
, OptimisationLevel(..), flagToOptimisationLevel )
import Distribution.Simple.Utils (wrapText)
import Distribution.Simple.Utils (wrapLine)
import Distribution.Simple.Program (Program(..), ProgramConfiguration,
knownPrograms)
import Distribution.Simple.InstallDirs
......@@ -1099,7 +1099,7 @@ programFlagsDescription :: ProgramConfiguration -> String
programFlagsDescription progConf =
"The flags --with-PROG and --PROG-option(s) can be used with"
++ " the following programs:"
++ (concatMap ("\n "++) . wrapText 77 . sort)
++ (concatMap (\line -> "\n " ++ unwords line) . wrapLine 77 . sort)
[ programName prog | (prog, _) <- knownPrograms progConf ]
++ "\n"
......
......@@ -99,6 +99,8 @@ module Distribution.Simple.Utils (
intercalate,
lowercase,
wrapText,
wrapText',
wrapLine,
) where
import Control.Monad
......@@ -125,7 +127,7 @@ import System.Directory
( copyFile, createDirectoryIfMissing, renameFile )
import System.IO
( Handle, openBinaryFile, IOMode(ReadMode), hSetBinaryMode, hGetContents
, stderr, stdout, hPutStrLn, hPutStr, hFlush, hClose )
, stderr, stdout, hPutStr, hFlush, hClose )
import System.IO.Error as IO.Error
( try )
import qualified Control.Exception as Exception
......@@ -170,7 +172,7 @@ die :: String -> IO a
die msg = do
hFlush stdout
pname <- getProgName
hPutStrLn stderr (pname ++ ": " ++ msg)
hPutStr stderr (wrapText (pname ++ ": " ++ msg))
exitWith (ExitFailure 1)
-- | Non fatal conditions that may be indicative of an error or problem.
......@@ -181,7 +183,7 @@ warn :: Verbosity -> String -> IO ()
warn verbosity msg =
when (verbosity >= normal) $ do
hFlush stdout
hPutStrLn stderr ("Warning: " ++ msg)
hPutStr stderr (wrapText ("Warning: " ++ msg))
-- | Useful status messages.
--
......@@ -193,7 +195,7 @@ warn verbosity msg =
notice :: Verbosity -> String -> IO ()
notice verbosity msg =
when (verbosity >= normal) $
putStrLn msg
putStr (wrapText msg)
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()
setupMessage verbosity msg pkgid =
......@@ -206,7 +208,7 @@ setupMessage verbosity msg pkgid =
info :: Verbosity -> String -> IO ()
info verbosity msg =
when (verbosity >= verbose) $
putStrLn msg
putStr (wrapText msg)
-- | Detailed internal debugging information
--
......@@ -215,7 +217,7 @@ info verbosity msg =
debug :: Verbosity -> String -> IO ()
debug verbosity msg =
when (verbosity >= deafening) $
putStrLn msg
putStr (wrapText msg)
-- | Perform an IO action, catching any IO exceptions and printing an error
-- if one occurs.
......@@ -237,9 +239,21 @@ breaks f xs = case span f xs of
(v, xs'') ->
v : breaks f xs''
-- Wraps a list of words text to a list of lines of a particular width.
wrapText :: Int -> [String] -> [String]
wrapText width = map unwords . wrap 0 []
-- | Wraps text to the default line width. Existing newlines are preserved.
wrapText :: String -> String
wrapText = wrapText' 79
-- | Wraps text to the given line width. Existing newlines are preserved.
wrapText' :: Int -> String -> String
wrapText' width = unlines
. concatMap (map unwords
. wrapLine width
. words)
. lines
-- | Wraps a list of words to a list of lines of words of a particular width.
wrapLine :: Int -> [String] -> [[String]]
wrapLine width = wrap 0 []
where wrap :: Int -> [String] -> [String] -> [[String]]
wrap 0 [] (w:ws)
| length w + 1 > width
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment