1module Distribution.Pretty (
2    Pretty (..),
3    prettyShow,
4    defaultStyle,
5    flatStyle,
6    -- * Utilities
7    showFilePath,
8    showToken,
9    showFreeText,
10    showFreeTextV3,
11    -- * Deprecated
12    Separator,
13    ) where
14
15import Distribution.CabalSpecVersion
16import Distribution.Compat.Prelude
17import Prelude ()
18
19import qualified Text.PrettyPrint as PP
20
21class Pretty a where
22    pretty :: a -> PP.Doc
23
24    prettyVersioned :: CabalSpecVersion -> a -> PP.Doc
25    prettyVersioned _ = pretty
26
27instance Pretty Bool where
28    pretty = PP.text . show
29
30instance Pretty Int where
31    pretty = PP.text . show
32
33instance Pretty a => Pretty (Identity a) where
34    pretty = pretty . runIdentity
35
36prettyShow :: Pretty a => a -> String
37prettyShow = PP.renderStyle defaultStyle . pretty
38
39-- | The default rendering style used in Cabal for console
40-- output. It has a fixed page width and adds line breaks
41-- automatically.
42defaultStyle :: PP.Style
43defaultStyle = PP.Style { PP.mode           = PP.PageMode
44                          , PP.lineLength     = 79
45                          , PP.ribbonsPerLine = 1.0
46                          }
47
48-- | A style for rendering all on one line.
49flatStyle :: PP.Style
50flatStyle = PP.Style { PP.mode = PP.LeftMode
51                       , PP.lineLength = err "lineLength"
52                       , PP.ribbonsPerLine = err "ribbonsPerLine"
53                       }
54  where
55    err x = error ("flatStyle: tried to access " ++ x ++ " in LeftMode. " ++
56                   "This should never happen and indicates a bug in Cabal.")
57
58-------------------------------------------------------------------------------
59-- Utilities
60-------------------------------------------------------------------------------
61
62-- TODO: remove when ReadP parser is gone.
63type Separator = [PP.Doc] -> PP.Doc
64
65showFilePath :: FilePath -> PP.Doc
66showFilePath = showToken
67
68showToken :: String -> PP.Doc
69showToken str
70    -- if token looks like a comment (starts with --), print it in quotes
71    | "--" `isPrefixOf` str                 = PP.text (show str)
72    -- also if token ends with a colon (e.g. executable name), print it in quotes
73    | ":" `isSuffixOf` str                  = PP.text (show str)
74    | not (any dodgy str) && not (null str) = PP.text str
75    | otherwise                             = PP.text (show str)
76  where
77    dodgy c = isSpace c || c == ','
78
79
80-- | Pretty-print free-format text, ensuring that it is vertically aligned,
81-- and with blank lines replaced by dots for correct re-parsing.
82showFreeText :: String -> PP.Doc
83showFreeText "" = mempty
84showFreeText s  = PP.vcat [ PP.text (if null l then "." else l) | l <- lines_ s ]
85
86-- | Pretty-print free-format text.
87-- Since @cabal-version: 3.0@ we don't replace blank lines with dots.
88--
89-- @since 3.0.0.0
90showFreeTextV3 :: String -> PP.Doc
91showFreeTextV3 "" = mempty
92showFreeTextV3 s  = PP.vcat [ PP.text l | l <- lines_ s ]
93
94-- | 'lines_' breaks a string up into a list of strings at newline
95-- characters.  The resulting strings do not contain newlines.
96lines_                   :: String -> [String]
97lines_ [] = [""]
98lines_ s  =
99    let (l, s') = break (== '\n') s
100    in  l : case s' of
101        []      -> []
102        (_:s'') -> lines_ s''
103