module Distribution.Pretty (
Pretty (..),
prettyShow,
defaultStyle,
flatStyle,
showFilePath,
showToken,
showTokenStr,
showFreeText,
showFreeTextV3,
Separator,
) where
import Distribution.CabalSpecVersion
import Distribution.Compat.Prelude
import Prelude ()
import qualified Text.PrettyPrint as PP
class Pretty a where
pretty :: a -> PP.Doc
prettyVersioned :: CabalSpecVersion -> a -> PP.Doc
prettyVersioned _ = pretty
instance Pretty PP.Doc where
pretty = id
instance Pretty Bool where
pretty = PP.text . show
instance Pretty Int where
pretty = PP.text . show
instance Pretty a => Pretty (Identity a) where
pretty = pretty . runIdentity
prettyShow :: Pretty a => a -> String
prettyShow = PP.renderStyle defaultStyle . pretty
defaultStyle :: PP.Style
defaultStyle = PP.Style { PP.mode = PP.PageMode
, PP.lineLength = 79
, PP.ribbonsPerLine = 1.0
}
flatStyle :: PP.Style
flatStyle = PP.Style { PP.mode = PP.LeftMode
, PP.lineLength = err "lineLength"
, PP.ribbonsPerLine = err "ribbonsPerLine"
}
where
err x = error ("flatStyle: tried to access " ++ x ++ " in LeftMode. " ++
"This should never happen and indicates a bug in Cabal.")
type Separator = [PP.Doc] -> PP.Doc
showFilePath :: FilePath -> PP.Doc
showFilePath = showToken
showToken :: String -> PP.Doc
showToken = PP.text . showTokenStr
showTokenStr :: String -> String
showTokenStr str
| "--" `isPrefixOf` str = show str
| ":" `isSuffixOf` str = show str
| not (any dodgy str) && not (null str) = str
| otherwise = show str
where
dodgy c = isSpace c || c == ','
showFreeText :: String -> PP.Doc
showFreeText "" = mempty
showFreeText s = PP.vcat [ PP.text (if null l then "." else l) | l <- lines_ s ]
showFreeTextV3 :: String -> PP.Doc
showFreeTextV3 "" = mempty
showFreeTextV3 s = PP.vcat [ PP.text l | l <- lines_ s ]
lines_ :: String -> [String]
lines_ [] = [""]
lines_ s =
let (l, s') = break (== '\n') s
in l : case s' of
[] -> []
(_:s'') -> lines_ s''