module Distribution.Pretty (
    Pretty (..),
    prettyShow,
    defaultStyle,
    flatStyle,
    -- * Utilities
    showFilePath,
    showToken,
    showFreeText,
    showFreeTextV3,
    -- * 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 = String -> Doc
PP.text (String -> Doc) -> (Bool -> String) -> Bool -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show

instance Pretty Int where
    pretty :: Int -> Doc
pretty = String -> Doc
PP.text (String -> Doc) -> (Int -> String) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
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 :: a -> String
prettyShow = Style -> Doc -> String
PP.renderStyle Style
defaultStyle (Doc -> String) -> (a -> Doc) -> a -> String
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 = Style :: Mode -> Int -> Float -> Style
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 = Style :: Mode -> Int -> Float -> Style
PP.Style { mode :: Mode
PP.mode = Mode
PP.LeftMode
                       , lineLength :: Int
PP.lineLength = String -> Int
forall a. String -> a
err String
"lineLength"
                       , ribbonsPerLine :: Float
PP.ribbonsPerLine = String -> Float
forall a. String -> a
err String
"ribbonsPerLine"
                       }
  where
    err :: String -> a
err String
x = String -> a
forall a. HasCallStack => String -> a
error (String
"flatStyle: tried to access " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in LeftMode. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                   String
"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 :: String -> Doc
showFilePath = String -> Doc
showToken

showToken :: String -> PP.Doc
showToken :: String -> Doc
showToken String
str
    -- if token looks like a comment (starts with --), print it in quotes
    | String
"--" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str                 = String -> Doc
PP.text (String -> String
forall a. Show a => a -> String
show String
str)
    -- also if token ends with a colon (e.g. executable name), print it in quotes
    | String
":" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
str                  = String -> Doc
PP.text (String -> String
forall a. Show a => a -> String
show String
str)
    | Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
dodgy String
str) Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str) = String -> Doc
PP.text String
str
    | Bool
otherwise                             = String -> Doc
PP.text (String -> String
forall a. Show a => a -> String
show String
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 :: String -> Doc
showFreeText String
"" = Doc
forall a. Monoid a => a
mempty
showFreeText String
s  = [Doc] -> Doc
PP.vcat [ String -> Doc
PP.text (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l then String
"." else String
l) | String
l <- String -> [String]
lines_ String
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 :: String -> Doc
showFreeTextV3 String
"" = Doc
forall a. Monoid a => a
mempty
showFreeTextV3 String
s  = [Doc] -> Doc
PP.vcat [ String -> Doc
PP.text String
l | String
l <- String -> [String]
lines_ String
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_ :: String -> [String]
lines_ [] = [String
""]
lines_ String
s  =
    let (String
l, String
s') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') String
s
    in  String
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: case String
s' of
        []      -> []
        (Char
_:String
s'') -> String -> [String]
lines_ String
s''