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

    -- * Utilities
  , showFilePath
  , showToken
  , showTokenStr
  , 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 :: forall a. Pretty a => 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 =
  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 = 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 -> Doc
PP.text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
showTokenStr

showTokenStr :: String -> String
showTokenStr :: String -> String
showTokenStr 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 -> 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 -> 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str) = String
str
  | Bool
otherwise = 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 a. [a] -> 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''