Commit 08a3536e authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Make showSDoc and friends respect -dppr-cols

Previously they just used a fixed width of 100, ignoring
-dppr-cols.  I think this dates back to a time when
the flag didn't exist, or wasn't conveniently available.

Thanks to Andrew Gibiansky for pointing this out.
parent 17a3dacb
......@@ -1480,16 +1480,13 @@ defaultLogAction dflags severity srcSpan style msg
putStrSDoc = defaultLogActionHPutStrDoc dflags stdout
defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
defaultLogActionHPrintDoc dflags h d sty
= do let doc = runSDoc d (initSDocContext dflags sty)
Pretty.printDoc Pretty.PageMode (pprCols dflags) h doc
hFlush h
defaultLogActionHPrintDoc = defaultLogActionHPutStrDoc
defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
defaultLogActionHPutStrDoc dflags h d sty
= do let doc = runSDoc d (initSDocContext dflags sty)
hPutStr h (Pretty.render doc)
hFlush h
= Pretty.printDoc Pretty.PageMode (pprCols dflags) h doc
where
doc = runSDoc d (initSDocContext dflags sty)
newtype FlushOut = FlushOut (IO ())
......
......@@ -42,8 +42,7 @@ module Outputable (
pprCode, mkCodeStyle,
showSDoc, showSDocOneLine,
showSDocForUser, showSDocDebug, showSDocDump, showSDocDumpOneLine,
showPpr,
showSDocUnqual,
showSDocUnqual, showPpr,
renderWithStyle,
pprInfixVar, pprPrefixVar,
......@@ -366,44 +365,47 @@ mkCodeStyle = PprCode
-- However, Doc *is* an instance of Show
-- showSDoc just blasts it out as a string
showSDoc :: DynFlags -> SDoc -> String
showSDoc dflags d =
Pretty.showDocWith PageMode
(runSDoc d (initSDocContext dflags defaultUserStyle))
showSDoc dflags sdoc = renderWithStyle dflags sdoc defaultUserStyle
renderWithStyle :: DynFlags -> SDoc -> PprStyle -> String
renderWithStyle dflags sdoc sty =
Pretty.render (runSDoc sdoc (initSDocContext dflags sty))
renderWithStyle dflags sdoc sty
= Pretty.showDoc PageMode (pprCols dflags) $
runSDoc sdoc (initSDocContext dflags sty)
-- This shows an SDoc, but on one line only. It's cheaper than a full
-- showSDoc, designed for when we're getting results like "Foo.bar"
-- and "foo{uniq strictness}" so we don't want fancy layout anyway.
showSDocOneLine :: DynFlags -> SDoc -> String
showSDocOneLine dflags d
= Pretty.showDocWith PageMode
(runSDoc d (initSDocContext dflags defaultUserStyle))
= Pretty.showDoc OneLineMode (pprCols dflags) $
runSDoc d (initSDocContext dflags defaultUserStyle)
showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
showSDocForUser dflags unqual doc
= show (runSDoc doc (initSDocContext dflags (mkUserStyle unqual AllTheWay)))
= renderWithStyle dflags doc (mkUserStyle unqual AllTheWay)
showSDocUnqual :: DynFlags -> SDoc -> String
-- Only used in the gruesome isOperator
showSDocUnqual dflags d
= show (runSDoc d (initSDocContext dflags (mkUserStyle neverQualify AllTheWay)))
-- Only used by Haddock
showSDocUnqual dflags doc
= renderWithStyle dflags doc (mkUserStyle neverQualify AllTheWay)
showSDocDump :: DynFlags -> SDoc -> String
showSDocDump dflags d
= Pretty.showDocWith PageMode (runSDoc d (initSDocContext dflags defaultDumpStyle))
showSDocDump dflags d = renderWithStyle dflags d defaultDumpStyle
showSDocDebug :: DynFlags -> SDoc -> String
showSDocDebug dflags d = renderWithStyle dflags d PprDebug
showSDocDumpOneLine :: DynFlags -> SDoc -> String
showSDocDumpOneLine dflags d
= Pretty.showDocWith OneLineMode (runSDoc d (initSDocContext dflags PprDump))
showSDocDebug :: DynFlags -> SDoc -> String
showSDocDebug dflags d = show (runSDoc d (initSDocContext dflags PprDebug))
= Pretty.showDoc OneLineMode irrelevantNCols $
runSDoc d (initSDocContext dflags PprDump)
showPpr :: Outputable a => DynFlags -> a -> String
showPpr dflags = showSDoc dflags . ppr
showPpr dflags thing = showSDoc dflags (ppr thing)
irrelevantNCols :: Int
-- Used for OneLineMode and LeftMode when number of cols isn't used
irrelevantNCols = 1
\end{code}
\begin{code}
......
......@@ -173,8 +173,7 @@ module Pretty (
hang, punctuate,
-- renderStyle, -- Haskell 1.3 only
render, fullRender, printDoc, showDocWith,
fullRender, printDoc, showDoc,
bufLeftRender -- performance hack
) where
......@@ -270,9 +269,8 @@ Displaying @Doc@ values.
\begin{code}
instance Show Doc where
showsPrec _ doc cont = showDoc doc cont
showsPrec _ doc cont = showDocPlus PageMode 100 doc cont
render :: Doc -> String -- Uses default style
fullRender :: Mode
-> Int -- Line length
-> Float -- Ribbons per line
......@@ -281,21 +279,10 @@ fullRender :: Mode
-> Doc
-> a -- Result
{- When we start using 1.3
renderStyle :: Style -> Doc -> String
data Style = Style { lineLength :: Int, -- In chars
ribbonsPerLine :: Float, -- Ratio of ribbon length to line length
mode :: Mode
}
style :: Style -- The default style
style = Style { lineLength = 100, ribbonsPerLine = 2.5, mode = PageMode }
-}
data Mode = PageMode -- Normal
| ZigZagMode -- With zig-zag cuts
| LeftMode -- No indentation, infinitely long lines
| OneLineMode -- All on one line
\end{code}
......@@ -890,21 +877,11 @@ oneLiner _ = panic "oneLiner: Unhandled case"
\begin{code}
{-
renderStyle Style{mode, lineLength, ribbonsPerLine} doc
= fullRender mode lineLength ribbonsPerLine doc ""
-}
render doc = showDocWith PageMode doc
showDoc :: Doc -> String -> String
showDoc doc rest = showDocWithAppend PageMode doc rest
showDocWithAppend :: Mode -> Doc -> String -> String
showDocWithAppend mode doc rest = fullRender mode 100 1.5 string_txt rest doc
showDocPlus :: Mode -> Int -> Doc -> String -> String
showDocPlus mode cols doc rest = fullRender mode cols 1.5 string_txt rest doc
showDocWith :: Mode -> Doc -> String
showDocWith mode doc = showDocWithAppend mode doc ""
showDoc :: Mode -> Int -> Doc -> String
showDoc mode cols doc = showDocPlus mode cols doc ""
string_txt :: TextDetails -> String -> String
string_txt (Chr c) s = c:s
......
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