{-# LANGUAGE CPP #-}

module Text.PrettyPrint.Leijen {-# DEPRECATED "Compatibility module for users of wl-pprint - use \"Prettyprinter\" instead" #-} (

    Doc, putDoc, hPutDoc, empty, char, text, (<>), nest, line, linebreak, group,
    softline, softbreak, align, hang, indent, encloseSep, list, tupled,
    semiBraces, (<+>), (<$>), (</>), (<$$>), (<//>), hsep, vsep, fillSep, sep,
    hcat, vcat, fillCat, cat, punctuate, fill, fillBreak, enclose, squotes,
    dquotes, parens, angles, braces, brackets, lparen, rparen, langle, rangle,
    lbrace, rbrace, lbracket, rbracket, squote, dquote, semi, colon, comma,
    space, dot, backslash, equals, string, int, integer, float, double,
    rational, Pretty(..), SimpleDoc, renderPretty, renderCompact, displayS,
    displayIO, bool, column, nesting, width

) where



#if MIN_VERSION_base(4,8,0)
import Prelude hiding ((<$>))
#else
import Prelude
#endif

import qualified Data.Text.Lazy as TL
import           System.IO

import           Prettyprinter             (Pretty (..))
import qualified Prettyprinter             as New
import qualified Prettyprinter.Render.Text as NewT

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif


type Doc = New.Doc ()
type SimpleDoc = New.SimpleDocStream ()



putDoc :: Doc -> IO ()
putDoc :: Doc -> IO ()
putDoc = Doc -> IO ()
forall ann. Doc ann -> IO ()
NewT.putDoc

hPutDoc :: Handle -> Doc -> IO ()
hPutDoc :: Handle -> Doc -> IO ()
hPutDoc = Handle -> Doc -> IO ()
forall ann. Handle -> Doc ann -> IO ()
NewT.hPutDoc

empty :: Doc
empty :: Doc
empty = Doc
forall ann. Doc ann
New.emptyDoc

char :: Char -> Doc
char :: Char -> Doc
char = Char -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty

text :: String -> Doc
text :: String -> Doc
text = String -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty

nest :: Int -> Doc -> Doc
nest :: Int -> Doc -> Doc
nest  = Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
New.nest

line :: Doc
line :: Doc
line = Doc
forall ann. Doc ann
New.line

linebreak :: Doc
linebreak :: Doc
linebreak = Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
New.flatAlt Doc
forall ann. Doc ann
New.line Doc
forall a. Monoid a => a
mempty

group :: Doc -> Doc
group :: Doc -> Doc
group = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.group

softline :: Doc
softline :: Doc
softline = Doc
forall ann. Doc ann
New.softline

softbreak :: Doc
softbreak :: Doc
softbreak = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.group Doc
linebreak

align :: Doc -> Doc
align :: Doc -> Doc
align = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.align

hang :: Int -> Doc -> Doc
hang :: Int -> Doc -> Doc
hang = Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
New.hang

indent :: Int -> Doc -> Doc
indent :: Int -> Doc -> Doc
indent = Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
New.indent

encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep = Doc -> Doc -> Doc -> [Doc] -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
New.encloseSep

list :: [Doc] -> Doc
list :: [Doc] -> Doc
list = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.list

tupled :: [Doc] -> Doc
tupled :: [Doc] -> Doc
tupled = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.tupled

semiBraces :: [Doc] -> Doc
semiBraces :: [Doc] -> Doc
semiBraces = Doc -> Doc -> Doc -> [Doc] -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
New.encloseSep Doc
forall ann. Doc ann
New.lbrace Doc
forall ann. Doc ann
New.rbrace Doc
forall ann. Doc ann
New.semi

(<+>), (<$>), (</>), (<$$>), (<//>) :: Doc -> Doc -> Doc
<+> :: Doc -> Doc -> Doc
(<+>) = Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
(New.<+>)
<$> :: Doc -> Doc -> Doc
(<$>) = \Doc
x Doc
y -> Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
New.line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y
</> :: Doc -> Doc -> Doc
(</>) = \Doc
x Doc
y -> Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y
<$$> :: Doc -> Doc -> Doc
(<$$>) = \Doc
x Doc
y -> Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
linebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y
<//> :: Doc -> Doc -> Doc
(<//>) = \Doc
x Doc
y -> Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softbreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y

hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat :: [Doc] -> Doc
hsep :: [Doc] -> Doc
hsep = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.hsep
vsep :: [Doc] -> Doc
vsep = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.vsep
fillSep :: [Doc] -> Doc
fillSep = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.fillSep
sep :: [Doc] -> Doc
sep = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.sep
hcat :: [Doc] -> Doc
hcat = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.hcat
vcat :: [Doc] -> Doc
vcat = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.vcat
fillCat :: [Doc] -> Doc
fillCat = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.fillCat
cat :: [Doc] -> Doc
cat = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
New.cat

punctuate :: Doc -> [Doc] -> [Doc]
punctuate :: Doc -> [Doc] -> [Doc]
punctuate = Doc -> [Doc] -> [Doc]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
New.punctuate

fill :: Int -> Doc -> Doc
fill :: Int -> Doc -> Doc
fill = Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
New.fill

fillBreak :: Int -> Doc -> Doc
fillBreak :: Int -> Doc -> Doc
fillBreak = Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
New.fillBreak

enclose :: Doc -> Doc -> Doc -> Doc
enclose :: Doc -> Doc -> Doc -> Doc
enclose = Doc -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
New.enclose

squotes, dquotes, parens, angles, braces, brackets :: Doc -> Doc
squotes :: Doc -> Doc
squotes = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.squotes
dquotes :: Doc -> Doc
dquotes = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.dquotes
parens :: Doc -> Doc
parens = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.parens
angles :: Doc -> Doc
angles = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.angles
braces :: Doc -> Doc
braces = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.braces
brackets :: Doc -> Doc
brackets = Doc -> Doc
forall ann. Doc ann -> Doc ann
New.brackets

lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote,
    dquote, semi, colon, comma, space, dot, backslash, equals :: Doc
lparen :: Doc
lparen = Doc
forall ann. Doc ann
New.lparen
rparen :: Doc
rparen = Doc
forall ann. Doc ann
New.rparen
langle :: Doc
langle = Doc
forall ann. Doc ann
New.langle
rangle :: Doc
rangle = Doc
forall ann. Doc ann
New.rangle
lbrace :: Doc
lbrace = Doc
forall ann. Doc ann
New.lbrace
rbrace :: Doc
rbrace = Doc
forall ann. Doc ann
New.rbrace
lbracket :: Doc
lbracket = Doc
forall ann. Doc ann
New.lbracket
rbracket :: Doc
rbracket = Doc
forall ann. Doc ann
New.rbracket
squote :: Doc
squote = Doc
forall ann. Doc ann
New.squote
dquote :: Doc
dquote = Doc
forall ann. Doc ann
New.dquote
semi :: Doc
semi = Doc
forall ann. Doc ann
New.semi
colon :: Doc
colon = Doc
forall ann. Doc ann
New.colon
comma :: Doc
comma = Doc
forall ann. Doc ann
New.comma
space :: Doc
space = Doc
forall ann. Doc ann
New.space
dot :: Doc
dot = Doc
forall ann. Doc ann
New.dot
backslash :: Doc
backslash = Doc
forall ann. Doc ann
New.backslash
equals :: Doc
equals = Doc
forall ann. Doc ann
New.equals

string :: String -> Doc
string :: String -> Doc
string = String -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty

int :: Int -> Doc
int :: Int -> Doc
int = Int -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty

integer :: Integer -> Doc
integer :: Integer -> Doc
integer = Integer -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty

float :: Float -> Doc
float :: Float -> Doc
float = Float -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty

double :: Double -> Doc
double :: Double -> Doc
double = Double -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty

rational :: Rational -> Doc
rational :: Rational -> Doc
rational = String -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty (String -> Doc) -> (Rational -> String) -> Rational -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> String
forall a. Show a => a -> String
show

renderPretty :: Float -> Int -> Doc -> SimpleDoc
renderPretty :: Float -> Int -> Doc -> SimpleDoc
renderPretty Float
ribbonFraction Int
pageWidth
    = LayoutOptions -> Doc -> SimpleDoc
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
New.layoutPretty LayoutOptions :: PageWidth -> LayoutOptions
New.LayoutOptions
        { layoutPageWidth :: PageWidth
New.layoutPageWidth = Int -> Double -> PageWidth
New.AvailablePerLine Int
pageWidth (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
ribbonFraction) }

renderCompact :: Doc -> SimpleDoc
renderCompact :: Doc -> SimpleDoc
renderCompact = Doc -> SimpleDoc
forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
New.layoutCompact

displayS :: SimpleDoc -> ShowS
displayS :: SimpleDoc -> ShowS
displayS SimpleDoc
sdoc =
    let rendered :: Text
rendered = SimpleDoc -> Text
forall ann. SimpleDocStream ann -> Text
NewT.renderLazy SimpleDoc
sdoc
    in (Text -> String
TL.unpack Text
rendered String -> ShowS
forall a. [a] -> [a] -> [a]
++)

displayIO :: Handle -> SimpleDoc -> IO ()
displayIO :: Handle -> SimpleDoc -> IO ()
displayIO = Handle -> SimpleDoc -> IO ()
forall ann. Handle -> SimpleDocStream ann -> IO ()
NewT.renderIO

bool :: Bool -> Doc
bool :: Bool -> Doc
bool = Bool -> Doc
forall a ann. Pretty a => a -> Doc ann
New.pretty

column :: (Int -> Doc) -> Doc
column :: (Int -> Doc) -> Doc
column = (Int -> Doc) -> Doc
forall ann. (Int -> Doc ann) -> Doc ann
New.column

nesting :: (Int -> Doc) -> Doc
nesting :: (Int -> Doc) -> Doc
nesting = (Int -> Doc) -> Doc
forall ann. (Int -> Doc ann) -> Doc ann
New.nesting

width :: Doc -> (Int -> Doc) -> Doc
width :: Doc -> (Int -> Doc) -> Doc
width = Doc -> (Int -> Doc) -> Doc
forall ann. Doc ann -> (Int -> Doc ann) -> Doc ann
New.width