{-# OPTIONS_HADDOCK not-home #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveGeneric #-}
#endif
#ifndef TESTING
module Text.PrettyPrint.HughesPJ (
Doc, TextDetails(..),
char, text, ptext, sizedText, zeroWidthText,
int, integer, float, double, rational,
semi, comma, colon, space, equals,
lparen, rparen, lbrack, rbrack, lbrace, rbrace,
parens, brackets, braces, quotes, doubleQuotes,
maybeParens, maybeBrackets, maybeBraces, maybeQuotes, maybeDoubleQuotes,
empty,
(<>), (<+>), hcat, hsep,
($$), ($+$), vcat,
sep, cat,
fsep, fcat,
nest,
hang, punctuate,
isEmpty,
first, reduceDoc,
render,
Style(..),
style,
renderStyle,
Mode(..),
fullRender
) where
#endif
import Text.PrettyPrint.Annotated.HughesPJ
( TextDetails(..), Mode(..), Style(..), style )
import qualified Text.PrettyPrint.Annotated.HughesPJ as Ann
import Control.DeepSeq ( NFData(rnf) )
import Data.Function ( on )
#if __GLASGOW_HASKELL__ >= 803
import Prelude hiding ( (<>) )
#endif
#if __GLASGOW_HASKELL__ >= 800
import qualified Data.Semigroup as Semi ( Semigroup((<>)) )
#elif __GLASGOW_HASKELL__ < 709
import Data.Monoid ( Monoid(mempty, mappend) )
#endif
import Data.String ( IsString(fromString) )
import GHC.Generics
infixl 6 <>
infixl 6 <+>
infixl 5 $$, $+$
newtype Doc = Doc (Ann.Doc ())
#if __GLASGOW_HASKELL__ >= 701
deriving ((forall x. Doc -> Rep Doc x)
-> (forall x. Rep Doc x -> Doc) -> Generic Doc
forall x. Rep Doc x -> Doc
forall x. Doc -> Rep Doc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Doc x -> Doc
$cfrom :: forall x. Doc -> Rep Doc x
Generic)
#endif
liftList :: ([Ann.Doc ()] -> Ann.Doc ()) -> ([Doc] -> Doc)
liftList :: ([Doc ()] -> Doc ()) -> [Doc] -> Doc
liftList [Doc ()] -> Doc ()
f [Doc]
ds = Doc () -> Doc
Doc ([Doc ()] -> Doc ()
f [ Doc ()
d | Doc Doc ()
d <- [Doc]
ds ])
{-# INLINE liftList #-}
liftBinary :: (Ann.Doc () -> Ann.Doc () -> Ann.Doc ())
-> ( Doc -> Doc -> Doc )
liftBinary :: (Doc () -> Doc () -> Doc ()) -> Doc -> Doc -> Doc
liftBinary Doc () -> Doc () -> Doc ()
f (Doc Doc ()
a) (Doc Doc ()
b) = Doc () -> Doc
Doc (Doc () -> Doc () -> Doc ()
f Doc ()
a Doc ()
b)
{-# INLINE liftBinary #-}
type RDoc = Doc
#if __GLASGOW_HASKELL__ >= 800
instance Semi.Semigroup Doc where
<> :: Doc -> Doc -> Doc
(<>) = Doc -> Doc -> Doc
(Text.PrettyPrint.HughesPJ.<>)
instance Monoid Doc where
mempty :: Doc
mempty = Doc
empty
mappend :: Doc -> Doc -> Doc
mappend = Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(Semi.<>)
#else
instance Monoid Doc where
mempty = empty
mappend = (<>)
#endif
instance IsString Doc where
fromString :: String -> Doc
fromString = String -> Doc
text
instance Show Doc where
showsPrec :: Int -> Doc -> ShowS
showsPrec Int
_ Doc
doc String
cont = Mode
-> Int
-> Float
-> (TextDetails -> ShowS)
-> String
-> Doc
-> String
forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender (Style -> Mode
mode Style
style) (Style -> Int
lineLength Style
style)
(Style -> Float
ribbonsPerLine Style
style)
TextDetails -> ShowS
txtPrinter String
cont Doc
doc
instance Eq Doc where
== :: Doc -> Doc -> Bool
(==) = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool) -> (Doc -> String) -> Doc -> Doc -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Doc -> String
render
instance NFData Doc where
rnf :: Doc -> ()
rnf (Doc Doc ()
a) = Doc () -> ()
forall a. NFData a => a -> ()
rnf Doc ()
a
char :: Char -> Doc
char :: Char -> Doc
char Char
c = Doc () -> Doc
Doc (Char -> Doc ()
forall a. Char -> Doc a
Ann.char Char
c)
{-# INLINE char #-}
text :: String -> Doc
text :: String -> Doc
text String
s = Doc () -> Doc
Doc (String -> Doc ()
forall a. String -> Doc a
Ann.text String
s)
{-# INLINE text #-}
ptext :: String -> Doc
ptext :: String -> Doc
ptext String
s = Doc () -> Doc
Doc (String -> Doc ()
forall a. String -> Doc a
Ann.ptext String
s)
{-# INLINE ptext #-}
sizedText :: Int -> String -> Doc
sizedText :: Int -> String -> Doc
sizedText Int
l String
s = Doc () -> Doc
Doc (Int -> String -> Doc ()
forall a. Int -> String -> Doc a
Ann.sizedText Int
l String
s)
zeroWidthText :: String -> Doc
zeroWidthText :: String -> Doc
zeroWidthText = Int -> String -> Doc
sizedText Int
0
empty :: Doc
empty :: Doc
empty = Doc () -> Doc
Doc Doc ()
forall a. Doc a
Ann.empty
isEmpty :: Doc -> Bool
isEmpty :: Doc -> Bool
isEmpty (Doc Doc ()
d) = Doc () -> Bool
forall a. Doc a -> Bool
Ann.isEmpty Doc ()
d
semi :: Doc
comma :: Doc
colon :: Doc
space :: Doc
equals :: Doc
lparen :: Doc
rparen :: Doc
lbrack :: Doc
rbrack :: Doc
lbrace :: Doc
rbrace :: Doc
semi :: Doc
semi = Char -> Doc
char Char
';'
comma :: Doc
comma = Char -> Doc
char Char
','
colon :: Doc
colon = Char -> Doc
char Char
':'
space :: Doc
space = Char -> Doc
char Char
' '
equals :: Doc
equals = Char -> Doc
char Char
'='
lparen :: Doc
lparen = Char -> Doc
char Char
'('
rparen :: Doc
rparen = Char -> Doc
char Char
')'
lbrack :: Doc
lbrack = Char -> Doc
char Char
'['
rbrack :: Doc
rbrack = Char -> Doc
char Char
']'
lbrace :: Doc
lbrace = Char -> Doc
char Char
'{'
rbrace :: Doc
rbrace = Char -> Doc
char Char
'}'
int :: Int -> Doc
integer :: Integer -> Doc
float :: Float -> Doc
double :: Double -> Doc
rational :: Rational -> Doc
int :: Int -> Doc
int Int
n = String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
n)
integer :: Integer -> Doc
integer Integer
n = String -> Doc
text (Integer -> String
forall a. Show a => a -> String
show Integer
n)
float :: Float -> Doc
float Float
n = String -> Doc
text (Float -> String
forall a. Show a => a -> String
show Float
n)
double :: Double -> Doc
double Double
n = String -> Doc
text (Double -> String
forall a. Show a => a -> String
show Double
n)
rational :: Rational -> Doc
rational Rational
n = String -> Doc
text (Rational -> String
forall a. Show a => a -> String
show Rational
n)
parens :: Doc -> Doc
brackets :: Doc -> Doc
braces :: Doc -> Doc
quotes :: Doc -> Doc
doubleQuotes :: Doc -> Doc
quotes :: Doc -> Doc
quotes Doc
p = Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<> Doc
p Doc -> Doc -> Doc
<> Char -> Doc
char Char
'\''
doubleQuotes :: Doc -> Doc
doubleQuotes Doc
p = Char -> Doc
char Char
'"' Doc -> Doc -> Doc
<> Doc
p Doc -> Doc -> Doc
<> Char -> Doc
char Char
'"'
parens :: Doc -> Doc
parens Doc
p = Char -> Doc
char Char
'(' Doc -> Doc -> Doc
<> Doc
p Doc -> Doc -> Doc
<> Char -> Doc
char Char
')'
brackets :: Doc -> Doc
brackets Doc
p = Char -> Doc
char Char
'[' Doc -> Doc -> Doc
<> Doc
p Doc -> Doc -> Doc
<> Char -> Doc
char Char
']'
braces :: Doc -> Doc
braces Doc
p = Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<> Doc
p Doc -> Doc -> Doc
<> Char -> Doc
char Char
'}'
maybeParens :: Bool -> Doc -> Doc
maybeParens :: Bool -> Doc -> Doc
maybeParens Bool
False = Doc -> Doc
forall a. a -> a
id
maybeParens Bool
True = Doc -> Doc
parens
maybeBrackets :: Bool -> Doc -> Doc
maybeBrackets :: Bool -> Doc -> Doc
maybeBrackets Bool
False = Doc -> Doc
forall a. a -> a
id
maybeBrackets Bool
True = Doc -> Doc
brackets
maybeBraces :: Bool -> Doc -> Doc
maybeBraces :: Bool -> Doc -> Doc
maybeBraces Bool
False = Doc -> Doc
forall a. a -> a
id
maybeBraces Bool
True = Doc -> Doc
braces
maybeQuotes :: Bool -> Doc -> Doc
maybeQuotes :: Bool -> Doc -> Doc
maybeQuotes Bool
False = Doc -> Doc
forall a. a -> a
id
maybeQuotes Bool
True = Doc -> Doc
quotes
maybeDoubleQuotes :: Bool -> Doc -> Doc
maybeDoubleQuotes :: Bool -> Doc -> Doc
maybeDoubleQuotes Bool
False = Doc -> Doc
forall a. a -> a
id
maybeDoubleQuotes Bool
True = Doc -> Doc
doubleQuotes
reduceDoc :: Doc -> RDoc
reduceDoc :: Doc -> Doc
reduceDoc (Doc Doc ()
d) = Doc () -> Doc
Doc (Doc () -> Doc ()
forall a. Doc a -> Doc a
Ann.reduceDoc Doc ()
d)
{-# INLINE reduceDoc #-}
hcat :: [Doc] -> Doc
hcat :: [Doc] -> Doc
hcat = ([Doc ()] -> Doc ()) -> [Doc] -> Doc
liftList [Doc ()] -> Doc ()
forall a. [Doc a] -> Doc a
Ann.hcat
{-# INLINE hcat #-}
hsep :: [Doc] -> Doc
hsep :: [Doc] -> Doc
hsep = ([Doc ()] -> Doc ()) -> [Doc] -> Doc
liftList [Doc ()] -> Doc ()
forall a. [Doc a] -> Doc a
Ann.hsep
{-# INLINE hsep #-}
vcat :: [Doc] -> Doc
vcat :: [Doc] -> Doc
vcat = ([Doc ()] -> Doc ()) -> [Doc] -> Doc
liftList [Doc ()] -> Doc ()
forall a. [Doc a] -> Doc a
Ann.vcat
{-# INLINE vcat #-}
nest :: Int -> Doc -> Doc
nest :: Int -> Doc -> Doc
nest Int
k (Doc Doc ()
p) = Doc () -> Doc
Doc (Int -> Doc () -> Doc ()
forall a. Int -> Doc a -> Doc a
Ann.nest Int
k Doc ()
p)
{-# INLINE nest #-}
hang :: Doc -> Int -> Doc -> Doc
hang :: Doc -> Int -> Doc -> Doc
hang (Doc Doc ()
d1) Int
n (Doc Doc ()
d2) = Doc () -> Doc
Doc (Doc () -> Int -> Doc () -> Doc ()
forall a. Doc a -> Int -> Doc a -> Doc a
Ann.hang Doc ()
d1 Int
n Doc ()
d2)
{-# INLINE hang #-}
punctuate :: Doc -> [Doc] -> [Doc]
punctuate :: Doc -> [Doc] -> [Doc]
punctuate (Doc Doc ()
p) [Doc]
ds = [ Doc () -> Doc
Doc Doc ()
d | Doc ()
d <- Doc () -> [Doc ()] -> [Doc ()]
forall a. Doc a -> [Doc a] -> [Doc a]
Ann.punctuate Doc ()
p [ Doc ()
d | Doc Doc ()
d <- [Doc]
ds ] ]
{-# INLINE punctuate #-}
($$) :: Doc -> Doc -> Doc
$$ :: Doc -> Doc -> Doc
($$) = (Doc () -> Doc () -> Doc ()) -> Doc -> Doc -> Doc
liftBinary Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
(Ann.$$)
{-# INLINE ($$) #-}
($+$) :: Doc -> Doc -> Doc
$+$ :: Doc -> Doc -> Doc
($+$) = (Doc () -> Doc () -> Doc ()) -> Doc -> Doc -> Doc
liftBinary Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
(Ann.$+$)
{-# INLINE ($+$) #-}
(<>) :: Doc -> Doc -> Doc
<> :: Doc -> Doc -> Doc
(<>) = (Doc () -> Doc () -> Doc ()) -> Doc -> Doc -> Doc
liftBinary Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
(Ann.<>)
{-# INLINE (<>) #-}
(<+>) :: Doc -> Doc -> Doc
<+> :: Doc -> Doc -> Doc
(<+>) = (Doc () -> Doc () -> Doc ()) -> Doc -> Doc -> Doc
liftBinary Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
(Ann.<+>)
{-# INLINE (<+>) #-}
sep :: [Doc] -> Doc
sep :: [Doc] -> Doc
sep = ([Doc ()] -> Doc ()) -> [Doc] -> Doc
liftList [Doc ()] -> Doc ()
forall a. [Doc a] -> Doc a
Ann.sep
{-# INLINE sep #-}
cat :: [Doc] -> Doc
cat :: [Doc] -> Doc
cat = ([Doc ()] -> Doc ()) -> [Doc] -> Doc
liftList [Doc ()] -> Doc ()
forall a. [Doc a] -> Doc a
Ann.cat
{-# INLINE cat #-}
fcat :: [Doc] -> Doc
fcat :: [Doc] -> Doc
fcat = ([Doc ()] -> Doc ()) -> [Doc] -> Doc
liftList [Doc ()] -> Doc ()
forall a. [Doc a] -> Doc a
Ann.fcat
{-# INLINE fcat #-}
fsep :: [Doc] -> Doc
fsep :: [Doc] -> Doc
fsep = ([Doc ()] -> Doc ()) -> [Doc] -> Doc
liftList [Doc ()] -> Doc ()
forall a. [Doc a] -> Doc a
Ann.fsep
{-# INLINE fsep #-}
first :: Doc -> Doc -> Doc
first :: Doc -> Doc -> Doc
first = (Doc () -> Doc () -> Doc ()) -> Doc -> Doc -> Doc
liftBinary Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
Ann.first
{-# INLINE first #-}
render :: Doc -> String
render :: Doc -> String
render = Mode
-> Int
-> Float
-> (TextDetails -> ShowS)
-> String
-> Doc
-> String
forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender (Style -> Mode
mode Style
style) (Style -> Int
lineLength Style
style) (Style -> Float
ribbonsPerLine Style
style)
TextDetails -> ShowS
txtPrinter String
""
{-# INLINE render #-}
renderStyle :: Style -> Doc -> String
renderStyle :: Style -> Doc -> String
renderStyle Style
s = Mode
-> Int
-> Float
-> (TextDetails -> ShowS)
-> String
-> Doc
-> String
forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender (Style -> Mode
mode Style
s) (Style -> Int
lineLength Style
s) (Style -> Float
ribbonsPerLine Style
s)
TextDetails -> ShowS
txtPrinter String
""
{-# INLINE renderStyle #-}
txtPrinter :: TextDetails -> String -> String
txtPrinter :: TextDetails -> ShowS
txtPrinter (Chr Char
c) String
s = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
s
txtPrinter (Str String
s1) String
s2 = String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2
txtPrinter (PStr String
s1) String
s2 = String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2
fullRender :: Mode
-> Int
-> Float
-> (TextDetails -> a -> a)
-> a
-> Doc
-> a
fullRender :: forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender Mode
m Int
lineLen Float
ribbons TextDetails -> a -> a
txt a
rest (Doc Doc ()
doc)
= Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc () -> a
forall a b.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc b -> a
Ann.fullRender Mode
m Int
lineLen Float
ribbons TextDetails -> a -> a
txt a
rest Doc ()
doc
{-# INLINE fullRender #-}