module Distribution.Pretty
  ( Pretty (..)
  , prettyShow
  , defaultStyle
  , flatStyle

    -- * Utilities
  , showFilePath
  , showToken
  , showTokenStr
  , showFreeText
  , showFreeTextV3
  , commaSpaceSep
  , commaSep

    -- * Deprecated
  , 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 CabalSpecVersion
_ = a -> Doc
forall a. Pretty a => a -> Doc
pretty

-- | @since 3.4.0.0
instance Pretty PP.Doc where
  pretty :: Doc -> Doc
pretty = Doc -> Doc
forall a. a -> a
id

instance Pretty Bool where
  pretty :: Bool -> Doc
pretty = [Char] -> Doc
PP.text ([Char] -> Doc) -> (Bool -> [Char]) -> Bool -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char]
forall a. Show a => a -> [Char]
show

instance Pretty Int where
  pretty :: Int -> Doc
pretty = [Char] -> Doc
PP.text ([Char] -> Doc) -> (Int -> [Char]) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show

instance Pretty a => Pretty (Identity a) where
  pretty :: Identity a -> Doc
pretty = a -> Doc
forall a. Pretty a => a -> Doc
pretty (a -> Doc) -> (Identity a -> a) -> Identity a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity

prettyShow :: Pretty a => a -> String
prettyShow :: forall a. Pretty a => a -> [Char]
prettyShow = Style -> Doc -> [Char]
PP.renderStyle Style
defaultStyle (Doc -> [Char]) -> (a -> Doc) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
pretty

-- | The default rendering style used in Cabal for console
-- output. It has a fixed page width and adds line breaks
-- automatically.
defaultStyle :: PP.Style
defaultStyle :: Style
defaultStyle =
  PP.Style
    { mode :: Mode
PP.mode = Mode
PP.PageMode
    , lineLength :: Int
PP.lineLength = Int
79
    , ribbonsPerLine :: Float
PP.ribbonsPerLine = Float
1.0
    }

-- | A style for rendering all on one line.
flatStyle :: PP.Style
flatStyle :: Style
flatStyle =
  PP.Style
    { mode :: Mode
PP.mode = Mode
PP.LeftMode
    , lineLength :: Int
PP.lineLength = [Char] -> Int
forall {a}. [Char] -> a
err [Char]
"lineLength"
    , ribbonsPerLine :: Float
PP.ribbonsPerLine = [Char] -> Float
forall {a}. [Char] -> a
err [Char]
"ribbonsPerLine"
    }
  where
    err :: [Char] -> a
err [Char]
x =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error
        ( [Char]
"flatStyle: tried to access "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in LeftMode. "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"This should never happen and indicates a bug in Cabal."
        )

-------------------------------------------------------------------------------
-- Utilities
-------------------------------------------------------------------------------

-- TODO: remove when ReadP parser is gone.
type Separator = [PP.Doc] -> PP.Doc

showFilePath :: FilePath -> PP.Doc
showFilePath :: [Char] -> Doc
showFilePath = [Char] -> Doc
showToken

showToken :: String -> PP.Doc
showToken :: [Char] -> Doc
showToken = [Char] -> Doc
PP.text ([Char] -> Doc) -> ([Char] -> [Char]) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
showTokenStr

showTokenStr :: String -> String
showTokenStr :: [Char] -> [Char]
showTokenStr [Char]
str
  -- if token looks like a comment (starts with --), print it in quotes
  | [Char]
"--" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
str = [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
str
  -- also if token ends with a colon (e.g. executable name), print it in quotes
  | [Char]
":" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
str = [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
str
  | Bool -> Bool
not ((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
dodgy [Char]
str) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
str) = [Char]
str
  | Bool
otherwise = [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
str
  where
    dodgy :: Char -> Bool
dodgy Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
','

-- | Pretty-print free-format text, ensuring that it is vertically aligned,
-- and with blank lines replaced by dots for correct re-parsing.
showFreeText :: String -> PP.Doc
showFreeText :: [Char] -> Doc
showFreeText [Char]
"" = Doc
forall a. Monoid a => a
mempty
showFreeText [Char]
s = [Doc] -> Doc
PP.vcat [[Char] -> Doc
PP.text (if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
l then [Char]
"." else [Char]
l) | [Char]
l <- [Char] -> [[Char]]
lines_ [Char]
s]

-- | Pretty-print free-format text.
-- Since @cabal-version: 3.0@ we don't replace blank lines with dots.
--
-- @since 3.0.0.0
showFreeTextV3 :: String -> PP.Doc
showFreeTextV3 :: [Char] -> Doc
showFreeTextV3 [Char]
"" = Doc
forall a. Monoid a => a
mempty
showFreeTextV3 [Char]
s = [Doc] -> Doc
PP.vcat [[Char] -> Doc
PP.text [Char]
l | [Char]
l <- [Char] -> [[Char]]
lines_ [Char]
s]

-- | 'lines_' breaks a string up into a list of strings at newline
-- characters.  The resulting strings do not contain newlines.
lines_ :: String -> [String]
lines_ :: [Char] -> [[Char]]
lines_ [] = [[Char]
""]
lines_ [Char]
s =
  let ([Char]
l, [Char]
s') = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') [Char]
s
   in [Char]
l [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: case [Char]
s' of
        [] -> []
        (Char
_ : [Char]
s'') -> [Char] -> [[Char]]
lines_ [Char]
s''

-- | Separate a list of documents by commas and spaces.
commaSpaceSep :: Pretty a => [a] -> PP.Doc
commaSpaceSep :: forall a. Pretty a => [a] -> Doc
commaSpaceSep = [Doc] -> Doc
PP.hsep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty

-- | Separate a list of documents by commas.
commaSep :: Pretty a => [a] -> PP.Doc
commaSep :: forall a. Pretty a => [a] -> Doc
commaSep = [Doc] -> Doc
PP.hcat ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty