Cabal-syntax/src/Distribution/Pretty.hs

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