{-# LANGUAGE CPP #-}

#include "version-compatibility-macros.h"

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

    Doc, SimpleDoc, SpanList, 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, pipe, string,
    int, integer, float, double, rational, bool, annotate, noAnnotate,
    renderPretty, renderCompact, displayDecorated, displayDecoratedA, display,
    displayS, displayIO, displaySpans, column, nesting, width

) where

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

#if !(MONOID_IN_PRELUDE)
import Data.Monoid hiding ((<>))
#endif

import           Control.Applicative hiding (empty, (<$>))
import qualified Data.Text           as T
import qualified Data.Text.IO        as T
import           System.IO

import           Prettyprinter
import qualified Prettyprinter.Render.String     as New
import qualified Prettyprinter.Render.Text       as New
import           Prettyprinter.Render.Util.Panic



type SimpleDoc = SimpleDocStream

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

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

displayS :: SimpleDoc ann -> ShowS
displayS :: SimpleDoc ann -> ShowS
displayS = SimpleDoc ann -> ShowS
forall ann. SimpleDocStream ann -> ShowS
New.renderShowS

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

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

display :: SimpleDoc ann -> String
display :: SimpleDoc ann -> String
display = (SimpleDoc ann -> ShowS) -> String -> SimpleDoc ann -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip SimpleDoc ann -> ShowS
forall ann. SimpleDocStream ann -> ShowS
displayS String
""

noAnnotate :: Doc ann -> Doc xxx
noAnnotate :: Doc ann -> Doc xxx
noAnnotate = Doc ann -> Doc xxx
forall ann xxx. Doc ann -> Doc xxx
unAnnotate

linebreak :: Doc ann
linebreak :: Doc ann
linebreak = Doc ann
forall ann. Doc ann
line'

softbreak :: Doc ann
softbreak :: Doc ann
softbreak = Doc ann
forall ann. Doc ann
softline'

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

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

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

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

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

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

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

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

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

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

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

displayDecorated :: (a -> String -> String) -> SimpleDoc a -> String
displayDecorated :: (a -> ShowS) -> SimpleDoc a -> String
displayDecorated a -> ShowS
decor SimpleDoc a
sd = ShowS -> ShowS -> [(ShowS, ShowS)] -> SimpleDoc a -> ShowS
go ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id [] SimpleDoc a
sd String
""
  where
    go :: ShowS -> ShowS -> [(ShowS, ShowS)] -> SimpleDoc a -> ShowS
go ShowS
s ShowS
d []              SimpleDoc a
SEmpty           = ShowS
d ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
    go ShowS
s ShowS
d [(ShowS, ShowS)]
stk             (SChar Char
c SimpleDoc a
x)      = ShowS -> ShowS -> [(ShowS, ShowS)] -> SimpleDoc a -> ShowS
go (ShowS
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
c) ShowS
d [(ShowS, ShowS)]
stk SimpleDoc a
x
    go ShowS
s ShowS
d [(ShowS, ShowS)]
stk             (SText Int
_ Text
str SimpleDoc a
x)  = ShowS -> ShowS -> [(ShowS, ShowS)] -> SimpleDoc a -> ShowS
go (ShowS
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (Text -> String
T.unpack Text
str)) ShowS
d [(ShowS, ShowS)]
stk SimpleDoc a
x
    go ShowS
s ShowS
d [(ShowS, ShowS)]
stk             (SLine Int
ind SimpleDoc a
x)    = ShowS -> ShowS -> [(ShowS, ShowS)] -> SimpleDoc a -> ShowS
go (ShowS
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
ind Char
' ')) ShowS
d [(ShowS, ShowS)]
stk SimpleDoc a
x
    go ShowS
s ShowS
d [(ShowS, ShowS)]
stk             (SAnnPush a
ann SimpleDoc a
x) = ShowS -> ShowS -> [(ShowS, ShowS)] -> SimpleDoc a -> ShowS
go ShowS
forall a. a -> a
id (a -> ShowS
decor a
ann) ((ShowS
s, ShowS
d)(ShowS, ShowS) -> [(ShowS, ShowS)] -> [(ShowS, ShowS)]
forall a. a -> [a] -> [a]
:[(ShowS, ShowS)]
stk) SimpleDoc a
x
    go ShowS
s ShowS
d ((ShowS
sf', ShowS
d'):[(ShowS, ShowS)]
stk) (SAnnPop SimpleDoc a
x)      = let formatted :: String
formatted = ShowS
d (ShowS
s String
"")
                                              in ShowS -> ShowS -> [(ShowS, ShowS)] -> SimpleDoc a -> ShowS
go (ShowS
sf' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
formatted) ShowS
d' [(ShowS, ShowS)]
stk SimpleDoc a
x
    go ShowS
_ ShowS
_ [] (SAnnPop SimpleDoc a
_) = String -> ShowS
forall a. HasCallStack => String -> a
error String
"stack underflow"
    go ShowS
_ ShowS
_ [(ShowS, ShowS)]
_ SimpleDoc a
SEmpty       = String -> ShowS
forall a. HasCallStack => String -> a
error String
"stack not consumed by rendering"
    go ShowS
_ ShowS
_ [(ShowS, ShowS)]
_ SimpleDoc a
SFail        = ShowS
forall void. void
panicUncaughtFail

displayDecoratedA :: (Applicative f, Monoid b)
                  => (String -> f b) -> (a -> f b) -> (a -> f b)
                  -> SimpleDoc a -> f b
displayDecoratedA :: (String -> f b) -> (a -> f b) -> (a -> f b) -> SimpleDoc a -> f b
displayDecoratedA String -> f b
str a -> f b
start a -> f b
end SimpleDoc a
sd = [a] -> SimpleDoc a -> f b
go [] SimpleDoc a
sd
  where
    go :: [a] -> SimpleDoc a -> f b
go []        SimpleDoc a
SEmpty           = b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty
    go [a]
stk       (SChar Char
c SimpleDoc a
x)      = String -> f b
str [Char
c] f b -> f b -> f b
<++> [a] -> SimpleDoc a -> f b
go [a]
stk SimpleDoc a
x
    go [a]
stk       (SText Int
_ Text
s SimpleDoc a
x)    = String -> f b
str (Text -> String
T.unpack Text
s) f b -> f b -> f b
<++> [a] -> SimpleDoc a -> f b
go [a]
stk SimpleDoc a
x
    go [a]
stk       (SLine Int
ind SimpleDoc a
x)    = String -> f b
str (Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
ind Char
' ') f b -> f b -> f b
<++> [a] -> SimpleDoc a -> f b
go [a]
stk SimpleDoc a
x
    go [a]
stk       (SAnnPush a
ann SimpleDoc a
x) = a -> f b
start a
ann f b -> f b -> f b
<++> [a] -> SimpleDoc a -> f b
go (a
anna -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
stk) SimpleDoc a
x
    go (a
ann:[a]
stk) (SAnnPop SimpleDoc a
x)      = a -> f b
end a
ann f b -> f b -> f b
<++> [a] -> SimpleDoc a -> f b
go [a]
stk SimpleDoc a
x

    -- malformed documents
    go [] (SAnnPop SimpleDoc a
_) = String -> f b
forall a. HasCallStack => String -> a
error String
"stack underflow"
    go [a]
_ SimpleDoc a
SEmpty       = String -> f b
forall a. HasCallStack => String -> a
error String
"stack not consumed by rendering"
    go [a]
_ SimpleDoc a
SFail        = f b
forall void. void
panicUncaughtFail

    <++> :: f b -> f b -> f b
(<++>) = (b -> b -> b) -> f b -> f b -> f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Monoid a => a -> a -> a
mappend

type SpanList a = [(Int, Int, a)]

displaySpans :: SimpleDoc a -> (String, SpanList a)
displaySpans :: SimpleDoc a -> (String, SpanList a)
displaySpans SimpleDoc a
sd = Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
go Int
0 [] SimpleDoc a
sd
  where
    go :: Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
    go :: Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
go Int
_ []                 SimpleDoc a
SEmpty           = (String
"", [])
    go Int
i [(Int, a)]
stk                (SChar Char
c SimpleDoc a
x)      = let (String
str, SpanList a
spans) = Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, a)]
stk SimpleDoc a
x
                                               in (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
str, SpanList a
spans)
    go Int
i [(Int, a)]
stk                (SText Int
l Text
s SimpleDoc a
x)    = ShowS -> (String, SpanList a) -> (String, SpanList a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst (Text -> String
T.unpack Text
s String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) [(Int, a)]
stk SimpleDoc a
x)
    go Int
i [(Int, a)]
stk                (SLine Int
ind SimpleDoc a
x)    = ShowS -> (String, SpanList a) -> (String, SpanList a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst ((Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
ind Char
' ') String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
go (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ind) [(Int, a)]
stk SimpleDoc a
x)
    go Int
i [(Int, a)]
stk                (SAnnPush a
ann SimpleDoc a
x) = Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
go Int
i ((Int
i, a
ann)(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
stk) SimpleDoc a
x
    go Int
i ((Int
start, a
ann):[(Int, a)]
stk) (SAnnPop SimpleDoc a
x)      = (SpanList a -> SpanList a)
-> (String, SpanList a) -> (String, SpanList a)
forall a b c. (a -> b) -> (c, a) -> (c, b)
mapSnd ((Int
start, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start, a
ann) (Int, Int, a) -> SpanList a -> SpanList a
forall a. a -> [a] -> [a]
:) (Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
forall a. Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a)
go Int
i [(Int, a)]
stk SimpleDoc a
x)

    -- malformed documents
    go Int
_ []  (SAnnPop SimpleDoc a
_) = String -> (String, SpanList a)
forall a. HasCallStack => String -> a
error String
"stack underflow"
    go Int
_ [(Int, a)]
_ SimpleDoc a
SEmpty        = String -> (String, SpanList a)
forall a. HasCallStack => String -> a
error String
"Stack not consumed by rendering"
    go Int
_ [(Int, a)]
_ SimpleDoc a
SFail         = (String, SpanList a)
forall void. void
panicUncaughtFail

    mapFst :: (a -> b) -> (a, c) -> (b, c)
    mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst a -> b
f (a
x, c
y) = (a -> b
f a
x, c
y)

    mapSnd :: (a -> b) -> (c, a) -> (c, b)
    mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd a -> b
f (c
x, a
y) = (c
x, a -> b
f a
y)

displayIO :: Handle -> SimpleDoc a -> IO ()
displayIO :: Handle -> SimpleDoc a -> IO ()
displayIO Handle
h SimpleDoc a
simpleDoc = SimpleDoc a -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go SimpleDoc a
simpleDoc
   where
     go :: SimpleDocStream ann -> IO ()
go SimpleDocStream ann
SFail          = IO ()
forall void. void
panicUncaughtFail
     go SimpleDocStream ann
SEmpty         = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
     go (SChar Char
c SimpleDocStream ann
x)    = Handle -> Char -> IO ()
hPutChar Handle
h Char
c IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleDocStream ann -> IO ()
go SimpleDocStream ann
x
     go (SText Int
_ Text
s SimpleDocStream ann
x)  = Handle -> Text -> IO ()
T.hPutStr Handle
h Text
s IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleDocStream ann -> IO ()
go SimpleDocStream ann
x
     go (SLine Int
i SimpleDocStream ann
x)    = Handle -> String -> IO ()
hPutStr Handle
h (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ') IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SimpleDocStream ann -> IO ()
go SimpleDocStream ann
x
     go (SAnnPush ann
_ SimpleDocStream ann
x) = SimpleDocStream ann -> IO ()
go SimpleDocStream ann
x
     go (SAnnPop SimpleDocStream ann
x)    = SimpleDocStream ann -> IO ()
go SimpleDocStream ann
x