-- |
-- Module      :  Text.PrettyPrint.Mainland
-- Copyright   :  (c) 2006-2011 Harvard University
--                (c) 2011-2012 Geoffrey Mainland
--                (c) 2015-2017 Drexel University
-- License     :  BSD-style
-- Maintainer  :  mainland@drexel.edu
--
-- Stability   :  provisional
-- Portability :  portable
--
-- This module is based on /A Prettier Printer/ by Phil Wadler in
-- /The Fun of Programming/, Jeremy Gibbons and Oege de Moor (eds)
-- <http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf>
--
-- At the time it was originally written I didn't know about Daan Leijen's
-- pretty printing module based on the same paper. I have since incorporated
-- many of his improvements. This module is geared towards pretty printing
-- source code; its main advantages over other libraries are the ability to
-- automatically track the source locations associated with pretty printed
-- values and output appropriate #line pragmas and the use of
-- 'Data.Text.Lazy.Text' for output.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}

module Text.PrettyPrint.Mainland (
    -- * The document type
    Doc,

    -- * Constructing documents
    -- ** Converting values into documents
    text, bool, char, string, int, integer, float, double, rational,
    strictText, lazyText,

    -- ** Simple documents documents
    star, colon, comma, dot, equals, semi, space, spaces,
    backquote, squote, dquote,
    langle, rangle, lbrace, rbrace, lbracket, rbracket, lparen, rparen,

    -- ** Basic document combinators
    empty,
    srcloc, line, softline, softbreak,
    (<|>), (<+>), (</>), (<+/>), (<//>),
    group, flatten,

    -- ** Wrapping documents in delimiters
    enclose, squotes, dquotes, angles, backquotes, braces, brackets, parens,
    parensIf,

    -- * Combining lists of documents
    folddoc, spread, stack, cat, sep,
    punctuate, commasep, semisep,
    enclosesep, tuple, list,

    -- ** Alignment and indentation
    align, hang, indent,
    nest, column, nesting,
    width, fill, fillbreak,

    -- ** Utilities
    faildoc, errordoc,

    -- * The rendered document type
    RDoc(..),

    -- * Document rendering
    render, renderCompact,
    displayS, prettyS, pretty, prettyCompactS, prettyCompact,
    displayPragmaS, prettyPragmaS, prettyPragma,
    displayLazyText, prettyLazyText,
    displayPragmaLazyText, prettyPragmaLazyText,

    -- * Document output
    putDoc, putDocLn, hPutDoc, hPutDocLn
  ) where

import Data.Loc (L(..),
                 Loc(..),
                 Located(..),
                 Pos(..),
                 posFile,
                 posLine)
import qualified Data.Map as Map
#if !(MIN_VERSION_base(4,9,0))
import Data.Monoid (Monoid(..), (<>))
#endif /* !(MIN_VERSION_base(4,9,0)) */
#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import qualified Data.Set as Set
import Data.String (IsString(..))
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TIO
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B
import System.IO (Handle)

-- | The abstract type of documents.
data Doc -- | The empty document
         =  Empty
         -- | A single character
         | Char {-# UNPACK #-} !Char
         -- | 'String' with associated length (to avoid recomputation)
         | String {-# UNPACK #-} !Int String
         -- | 'T.Text'
         | Text T.Text
         -- | 'L.Text'
         | LazyText L.Text
         -- | Newline
         | Line
         -- | Indented document
         | Nest {-# UNPACK #-} !Int Doc
         -- | Tag output with source location
         | SrcLoc Loc
         -- | Document concatenation
         | Doc `Cat` Doc
         -- | Provide alternatives. Invariant: both arguments must flatten to
         -- the same document.
         | Doc `Alt` Doc
         -- | Calculate document based on current column
         | Column  (Int -> Doc)
         -- | Calculate document based on current nesting
         | Nesting (Int -> Doc)

#if MIN_VERSION_base(4,9,0)
instance Semigroup Doc where
    <> :: Doc -> Doc -> Doc
(<>) = Doc -> Doc -> Doc
Cat
#endif

instance Monoid Doc where
    mempty :: Doc
mempty  = Doc
empty
#if !(MIN_VERSION_base(4,11,0))
    mappend = Cat
#endif

instance IsString Doc where
    fromString :: String -> Doc
fromString String
s = String -> Doc
string String
s

-- | The document @'text' s@ consists of the string @s@, which should not
-- contain any newlines. For a string that may include newlines, use 'string'.
text :: String -> Doc
text :: String -> Doc
text String
s = Int -> String -> Doc
String (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) String
s

-- | The document @bool b@ is equivalent to @text (show b)@.
bool :: Bool -> Doc
bool :: Bool -> Doc
bool Bool
b = String -> Doc
text (Bool -> String
forall a. Show a => a -> String
show Bool
b)

-- | The document @'char' c@ consists the single character @c@.
char :: Char -> Doc
char :: Char -> Doc
char Char
'\n' = Doc
line
char Char
c    = Char -> Doc
Char Char
c

-- | The document @'string' s@ consists of all the characters in @s@ but with
-- newlines replaced by 'line'.
string :: String -> Doc
string :: String -> Doc
string String
""         = Doc
empty
string (Char
'\n' : String
s) = Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
string String
s
string String
s          = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
s of
                      (String
xs, String
ys) -> String -> Doc
text String
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
string String
ys

-- | The document @int i@ is equivalent to @text (show i)@.
int :: Int -> Doc
int :: Int -> Doc
int Int
i = String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
i)

-- | The document @integer i@ is equivalent to @text (show i)@.
-- 'text'.
integer :: Integer -> Doc
integer :: Integer -> Doc
integer Integer
i = String -> Doc
text (Integer -> String
forall a. Show a => a -> String
show Integer
i)

-- | The document @float f@ is equivalent to @text (show f)@.
float :: Float -> Doc
float :: Float -> Doc
float Float
f = String -> Doc
text (Float -> String
forall a. Show a => a -> String
show Float
f)

-- | The document @double d@ is equivalent to @text (show d)@.
double :: Double -> Doc
double :: Double -> Doc
double Double
d = String -> Doc
text (Double -> String
forall a. Show a => a -> String
show Double
d)

-- | The document @rational r@ is equivalent to @text (show r)@.
rational :: Rational -> Doc
rational :: Rational -> Doc
rational Rational
r = String -> Doc
text (Rational -> String
forall a. Show a => a -> String
show Rational
r)

-- | The document @'strictText' s@ consists of the 'T.Text' @s@, which should
-- not contain any newlines.
strictText :: T.Text -> Doc
strictText :: Text -> Doc
strictText = Text -> Doc
Text

-- | The document @'lazyText' s@ consists of the 'L.Text' @s@, which should
-- not contain any newlines.
lazyText :: L.Text -> Doc
lazyText :: Text -> Doc
lazyText = Text -> Doc
LazyText

-- | The document @star@ consists of an asterisk, @\"*\"@.
star :: Doc
star :: Doc
star = Char -> Doc
char Char
'*'

-- | The document @colon@ consists of a colon, @\":\"@.
colon :: Doc
colon :: Doc
colon = Char -> Doc
char Char
':'

-- | The document @comma@ consists of a comma, @\",\"@.
comma :: Doc
comma :: Doc
comma = Char -> Doc
char Char
','

-- | The document @dot@ consists of a period, @\".\"@.
dot :: Doc
dot :: Doc
dot = Char -> Doc
char Char
'.'

-- | The document @equals@ consists of an equals sign, @\"=\"@.
equals :: Doc
equals :: Doc
equals = Char -> Doc
char Char
'='

-- | The document @semi@ consists of a semicolon, @\";\"@.
semi :: Doc
semi :: Doc
semi = Char -> Doc
char Char
';'

-- | The document @space@ consists of a space, @\" \"@.
space :: Doc
space :: Doc
space = Char -> Doc
char Char
' '

-- | The document @'space' n@ consists of n spaces.
spaces :: Int -> Doc
spaces :: Int -> Doc
spaces Int
n = String -> Doc
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ')

-- | The document @backquote@ consists of a backquote, @\"`\"@.
backquote :: Doc
backquote :: Doc
backquote = Char -> Doc
char Char
'`'

-- | The document @squote@ consists of a single quote, @\"\\'\"@.
squote :: Doc
squote :: Doc
squote = Char -> Doc
char Char
'\''

-- | The document @dquote@ consists of a double quote, @\"\\\"\"@.
dquote :: Doc
dquote :: Doc
dquote = Char -> Doc
char Char
'"'

-- | The document @langle@ consists of a less-than sign, @\"<\"@.
langle :: Doc
langle :: Doc
langle = Char -> Doc
char Char
'<'

-- | The document @rangle@ consists of a greater-than sign, @\">\"@.
rangle :: Doc
rangle :: Doc
rangle = Char -> Doc
char Char
'>'

-- | The document @lbrace@ consists of a left brace, @\"{\"@.
lbrace :: Doc
lbrace :: Doc
lbrace = Char -> Doc
char Char
'{'

-- | The document @rbrace@ consists of a right brace, @\"}\"@.
rbrace :: Doc
rbrace :: Doc
rbrace = Char -> Doc
char Char
'}'

-- | The document @lbracket@ consists of a right brace, @\"[\"@.
lbracket :: Doc
lbracket :: Doc
lbracket = Char -> Doc
char Char
'['

-- | The document @rbracket@ consists of a right brace, @\"]\"@.
rbracket :: Doc
rbracket :: Doc
rbracket = Char -> Doc
char Char
']'

-- | The document @lparen@ consists of a right brace, @\"(\"@.
lparen :: Doc
lparen :: Doc
lparen = Char -> Doc
char Char
'('

-- | The document @rparen@ consists of a right brace, @\")\"@.
rparen :: Doc
rparen :: Doc
rparen = Char -> Doc
char Char
')'

-- | The empty document.
empty :: Doc
empty :: Doc
empty = Doc
Empty

-- | The document @'srcloc' x@ tags the current line with @'locOf' x@. Only
-- shown when running 'prettyPragma' and friends.
srcloc :: Located a => a -> Doc
srcloc :: a -> Doc
srcloc a
x = Loc -> Doc
SrcLoc (a -> Loc
forall a. Located a => a -> Loc
locOf a
x)

-- | The document @'line'@ advances to the next line and indents to the current
-- indentation level. When undone by 'group', it behaves like 'space'.
line :: Doc
line :: Doc
line = Doc
Line

-- | Becomes 'space' if there is room, otherwise 'line'.
--
-- > pretty 11 $ text "foo" <+/> text "bar" <+/> text "baz" =="foo bar baz"
-- > pretty  7 $ text "foo" <+/> text "bar" <+/> text "baz" == "foo bar\nbaz"
-- > pretty  6 $ text "foo" <+/> text "bar" <+/> text "baz" == "foo\nbar\nbaz"
softline :: Doc
softline :: Doc
softline = Doc
space Doc -> Doc -> Doc
`Alt` Doc
line

-- | Becomes 'empty' if there is room, otherwise 'line'.
softbreak :: Doc
softbreak :: Doc
softbreak = Doc
empty Doc -> Doc -> Doc
`Alt` Doc
line

#if !MIN_VERSION_base(4,5,0)
infixr 6 <>
#endif /* !MIN_VERSION_base(4,5,0) */
infixr 6 <+>
infixr 5 </>, <+/>, <//>
infixl 3 <|>

#if !MIN_VERSION_base(4,5,0)
-- | Concatenates two documents.
(<>) :: Doc -> Doc -> Doc
x <> y = x `Cat` y
#endif /* !MIN_VERSION_base(4,5,0) */

-- | Concatenates two documents with a 'space' in between, with identity
-- 'empty'.
(<+>) :: Doc -> Doc -> Doc
Doc
Empty <+> :: Doc -> Doc -> Doc
<+> Doc
y     = Doc
y
Doc
x     <+> Doc
Empty = Doc
x
Doc
x     <+> Doc
y     = Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y

-- | Concatenates two documents with a 'line' in between, with identity 'empty'.
(</>) :: Doc -> Doc -> Doc
Doc
Empty </> :: Doc -> Doc -> Doc
</> Doc
y     = Doc
y
Doc
x     </> Doc
Empty = Doc
x
Doc
x     </> Doc
y     = Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y

-- | Concatenates two documents with a 'softline' in between, with identity
-- 'empty'.
(<+/>) :: Doc -> Doc -> Doc
Doc
Empty <+/> :: Doc -> Doc -> Doc
<+/> Doc
y     = Doc
y
Doc
x     <+/> Doc
Empty = Doc
x
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

-- | Concatenates two documents with a 'softbreak' in between.
(<//>) :: Doc -> Doc -> Doc
Doc
x <//> :: Doc -> Doc -> Doc
<//> 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

-- | Provide alternative layouts of the same content. Invariant: both arguments
-- must flatten to the same document.
(<|>) :: Doc -> Doc -> Doc
Doc
x <|> :: Doc -> Doc -> Doc
<|> Doc
y = Doc
x Doc -> Doc -> Doc
`Alt` Doc
y

-- | The document @'group' d@ will flatten @d@ to /one/ line if there is
-- room for it, otherwise the original @d@.
group :: Doc -> Doc
group :: Doc -> Doc
group Doc
Empty = Doc
Empty
group Doc
d     = Doc -> Doc
flatten Doc
d Doc -> Doc -> Doc
`Alt` Doc
d

-- | The document @'flatten' d@ will flatten @d@ to /one/ line.
flatten :: Doc -> Doc
flatten :: Doc -> Doc
flatten Doc
Empty        = Doc
Empty
flatten (Char Char
c)     = Char -> Doc
Char Char
c
flatten (String Int
l String
s) = Int -> String -> Doc
String Int
l String
s
flatten (Text Text
s)     = Text -> Doc
Text Text
s
flatten (LazyText Text
s) = Text -> Doc
LazyText Text
s
flatten Doc
Line         = Char -> Doc
Char Char
' '
flatten (Doc
x `Cat` Doc
y)  = Doc -> Doc
flatten Doc
x Doc -> Doc -> Doc
`Cat` Doc -> Doc
flatten Doc
y
flatten (Nest Int
i Doc
x)   = Int -> Doc -> Doc
Nest Int
i (Doc -> Doc
flatten Doc
x)
flatten (Doc
x `Alt` Doc
_)  = Doc -> Doc
flatten Doc
x
flatten (SrcLoc Loc
loc) = Loc -> Doc
SrcLoc Loc
loc
flatten (Column Int -> Doc
f)   = (Int -> Doc) -> Doc
Column (Doc -> Doc
flatten (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
f)
flatten (Nesting Int -> Doc
f)  = (Int -> Doc) -> Doc
Nesting (Doc -> Doc
flatten (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
f)

-- | The document @'enclose' l r d@ encloses the document @d@ between the
-- documents @l@ and @r@ using @<>@. It obeys the law
--
-- @'enclose' l r d = l <> d <> r@
enclose :: Doc -> Doc -> Doc -> Doc
enclose :: Doc -> Doc -> Doc -> Doc
enclose Doc
left Doc
right Doc
d = Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right

-- | The document @'squotes' d@ encloses the alinged document @d@ in \'...\'.
squotes :: Doc -> Doc
squotes :: Doc -> Doc
squotes = Doc -> Doc -> Doc -> Doc
enclose Doc
squote Doc
squote (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align

-- | The document @'dquotes' d@ encloses the aligned document @d@ in "...".
dquotes :: Doc -> Doc
dquotes :: Doc -> Doc
dquotes = Doc -> Doc -> Doc -> Doc
enclose Doc
dquote Doc
dquote (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align

-- | The document @'angles' d@ encloses the aligned document @d@ in \<...\>.
angles :: Doc -> Doc
angles :: Doc -> Doc
angles = Doc -> Doc -> Doc -> Doc
enclose Doc
langle Doc
rangle (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align

-- | The document @'backquotes' d@ encloses the aligned document @d@ in \`...\`.
backquotes :: Doc -> Doc
backquotes :: Doc -> Doc
backquotes = Doc -> Doc -> Doc -> Doc
enclose Doc
backquote Doc
backquote (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align

-- | The document @'braces' d@ encloses the aligned document @d@ in {...}.
braces :: Doc -> Doc
braces :: Doc -> Doc
braces = Doc -> Doc -> Doc -> Doc
enclose Doc
lbrace Doc
rbrace (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align

-- | The document @'brackets' d@ encloses the aligned document @d@ in [...].
brackets :: Doc -> Doc
brackets :: Doc -> Doc
brackets = Doc -> Doc -> Doc -> Doc
enclose Doc
lbracket Doc
rbracket (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align

-- | The document @'parens' d@ encloses the aligned document @d@ in (...).
parens :: Doc -> Doc
parens :: Doc -> Doc
parens = Doc -> Doc -> Doc -> Doc
enclose Doc
lparen Doc
rparen (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align

-- | The document @'parensIf' p d@ encloses the document @d@ in parenthesis if
-- @p@ is @True@, and otherwise yields just @d@.
parensIf :: Bool -> Doc -> Doc
parensIf :: Bool -> Doc -> Doc
parensIf Bool
True Doc
doc  = Doc -> Doc
parens Doc
doc
parensIf Bool
False Doc
doc = Doc
doc

-- | The document @'folddoc' f ds@ obeys the laws:
--
-- * @'folddoc' f [] = 'empty'@
-- * @'folddoc' f [d1, d2, ..., dnm1, dn] = d1 `f` (d2 `f` ... (dnm1 `f` dn))@
folddoc :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc Doc -> Doc -> Doc
_ []     = Doc
empty
folddoc Doc -> Doc -> Doc
_ [Doc
x]    = Doc
x
folddoc Doc -> Doc -> Doc
f (Doc
x:[Doc]
xs) = Doc -> Doc -> Doc
f Doc
x ((Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc Doc -> Doc -> Doc
f [Doc]
xs)

-- | The document @'spread' ds@ concatenates the documents @ds@ with 'space'.
spread :: [Doc] -> Doc
spread :: [Doc] -> Doc
spread = (Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc Doc -> Doc -> Doc
(<+>)

-- | The document @'stack' ds@ concatenates the documents @ds@ with 'line'.
stack :: [Doc] -> Doc
stack :: [Doc] -> Doc
stack = (Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc Doc -> Doc -> Doc
(</>)

-- | The document @'cat' ds@ concatenates the documents @ds@ with the 'empty'
-- document as long as there is room, and uses 'line' when there isn't.
cat :: [Doc] -> Doc
cat :: [Doc] -> Doc
cat = Doc -> Doc
group (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc Doc -> Doc -> Doc
(<//>)

-- | The document @'sep' ds@ concatenates the documents @ds@ with the 'space'
-- document as long as there is room, and uses 'line' when there isn't.
sep :: [Doc] -> Doc
sep :: [Doc] -> Doc
sep = Doc -> Doc
group (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc Doc -> Doc -> Doc
(<+/>)

-- | The document @'punctuate' p ds@ obeys the law:
--
-- @'punctuate' p [d1, d2, ..., dn] = [d1 <> p, d2 <> p, ..., dn]@
punctuate :: Doc -> [Doc] -> [Doc]
punctuate :: Doc -> [Doc] -> [Doc]
punctuate Doc
_ []     = []
punctuate Doc
_ [Doc
d]    = [Doc
d]
punctuate Doc
p (Doc
d:[Doc]
ds) = (Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
p) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate Doc
p [Doc]
ds

-- | The document @'commasep' ds@ comma-space separates @ds@, aligning the
-- resulting document to the current nesting level.
commasep :: [Doc] -> Doc
commasep :: [Doc] -> Doc
commasep = Doc -> Doc
align (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
sep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

-- | The document @'semisep' ds@ semicolon-space separates @ds@, aligning the
-- resulting document to the current nesting level.
semisep :: [Doc] -> Doc
semisep :: [Doc] -> Doc
semisep = Doc -> Doc
align (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
sep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi

-- | The document @'enclosesep' l r p ds@ separates @ds@ with the punctuation @p@
-- and encloses the result using @l@ and @r@. When wrapped, punctuation appears
-- at the end of the line. The enclosed portion of the document is aligned one
-- column to the right of the opening document.
--
-- @
-- \> ws = map text (words \"The quick brown fox jumps over the lazy dog\")
-- \> test = pretty 15 (enclosesep lparen rparen comma ws)
-- @
--
-- will be layed out as:
--
-- @
-- (The, quick,
--  brown, fox,
--  jumps, over,
--  the, lazy,
--  dog)
-- @
enclosesep :: Doc -> Doc -> Doc -> [Doc] -> Doc
enclosesep :: Doc -> Doc -> Doc -> [Doc] -> Doc
enclosesep Doc
left Doc
right Doc
p [Doc]
ds =
    case [Doc]
ds of
      [] ->  Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right
      [Doc
d] -> Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right
      [Doc]
_ ->   Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
align ([Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
p [Doc]
ds)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right

-- | The document @'tuple' ds@ separates @ds@ with commas and encloses them with
-- parentheses.
tuple :: [Doc] -> Doc
tuple :: [Doc] -> Doc
tuple = Doc -> Doc -> Doc -> [Doc] -> Doc
enclosesep Doc
lparen Doc
rparen Doc
comma

-- | The document @'list' ds@ separates @ds@ with commas and encloses them with
-- brackets.
list :: [Doc] -> Doc
list :: [Doc] -> Doc
list = Doc -> Doc -> Doc -> [Doc] -> Doc
enclosesep Doc
lbracket Doc
rbracket Doc
comma

-- | The document @'align' d@ renders @d@ with a nesting level set to the current
-- column.
align :: Doc -> Doc
align :: Doc -> Doc
align Doc
Empty = Doc
Empty
align Doc
d     = (Int -> Doc) -> Doc
column  ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
k ->
              (Int -> Doc) -> Doc
nesting ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
i ->
              Int -> Doc -> Doc
nest (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Doc
d

-- | The document @'hang' i d@ renders @d@ with a nesting level set to the
-- current column plus @i@, /not including/ the first line.
hang :: Int -> Doc -> Doc
hang :: Int -> Doc -> Doc
hang Int
i Doc
d = Doc -> Doc
align (Int -> Doc -> Doc
nest Int
i Doc
d)

-- | The document @'indent' i d@ renders @d@ with a nesting level set to the
-- current column plus @i@, /including/ the first line.
indent :: Int -> Doc -> Doc
indent :: Int -> Doc -> Doc
indent Int
i Doc
d = Doc -> Doc
align (Int -> Doc -> Doc
nest Int
i (Int -> Doc
spaces Int
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d))

-- | The document @'nest' i d@ renders the document @d@ with the current
-- indentation level increased by @i@.
nest :: Int -> Doc -> Doc
nest :: Int -> Doc -> Doc
nest Int
i Doc
d = Int -> Doc -> Doc
Nest Int
i Doc
d

-- | The document @'column' f@ is produced by calling @f@ with the current
-- column.
column :: (Int -> Doc) -> Doc
column :: (Int -> Doc) -> Doc
column = (Int -> Doc) -> Doc
Column

-- | The document @'column' f@ is produced by calling @f@ with the
-- current nesting level.
nesting :: (Int -> Doc) -> Doc
nesting :: (Int -> Doc) -> Doc
nesting = (Int -> Doc) -> Doc
Nesting

-- | The document @'width' d f@ is produced by concatenating @d@ with the result
-- of calling @f@ with the width of the document @d@.
width :: Doc -> (Int -> Doc) -> Doc
width :: Doc -> (Int -> Doc) -> Doc
width Doc
d Int -> Doc
f = (Int -> Doc) -> Doc
column ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
k1 -> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ((Int -> Doc) -> Doc
column ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
k2 -> Int -> Doc
f (Int
k2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k1))

-- | The document @'fill' i d@ renders document @x@, appending
-- @space@s until the width is equal to @i@. If the width of @d@ is already
-- greater than @i@, nothing is appended.
fill :: Int -> Doc -> Doc
fill :: Int -> Doc -> Doc
fill Int
f Doc
d = Doc -> (Int -> Doc) -> Doc
width Doc
d ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
w ->
           if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
f
           then Doc
empty
           else Int -> Doc
spaces (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)

-- | The document @'fillbreak' i d@ renders document @d@, appending @'space'@s
-- until the width is equal to @i@. If the width of @d@ is already greater than
-- @i@, the nesting level is increased by @i@ and a @line@ is appended.
fillbreak :: Int -> Doc -> Doc
fillbreak :: Int -> Doc -> Doc
fillbreak Int
f Doc
d = Doc -> (Int -> Doc) -> Doc
width Doc
d ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
w ->
                if (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
f)
                then Int -> Doc -> Doc
nest Int
f Doc
line
                else Int -> Doc
spaces (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)

-- | Equivalent of 'fail', but with a document instead of a string.
#if MIN_VERSION_base(4,13,0)
faildoc :: MonadFail m => Doc -> m a
#else
faildoc :: Monad m => Doc -> m a
#endif
faildoc :: Doc -> m a
faildoc = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (Doc -> String) -> Doc -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> String
pretty Int
80

-- | Equivalent of 'error', but with a document instead of a string.
errordoc :: Doc -> a
errordoc :: Doc -> a
errordoc = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (Doc -> String) -> Doc -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> String
pretty Int
80

-- | A rendered document.
data RDoc -- | The empty document
          = REmpty
          -- | A single character
          | RChar {-# UNPACK #-} !Char RDoc
          -- | 'String' with associated length (to avoid recomputation)
          | RString {-# UNPACK #-} !Int String RDoc
          -- | 'T.Text'
          | RText T.Text RDoc
          -- | 'L.Text'
          | RLazyText L.Text RDoc
          -- | Tag output with source location
          | RPos Pos RDoc
          -- | A newline with the indentation of the subsequent line. If this is
          -- followed by a 'RPos', output an appropriate #line pragma /before/
          -- the newline.
          | RLine {-# UNPACK #-} !Int RDoc

-- | Render a document given a maximum width.
render :: Int -> Doc -> RDoc
render :: Int -> Doc -> RDoc
render Int
w Doc
x = Int -> Int -> Doc -> RDoc
best Int
w Int
0 Doc
x

type RDocS = RDoc -> RDoc

data Docs -- | No document.
          = Nil
          -- | Indentation, document and tail
          | Cons {-# UNPACK #-} !Int Doc Docs

best :: Int -> Int -> Doc -> RDoc
best :: Int -> Int -> Doc -> RDoc
best !Int
w Int
k Doc
x = Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
True Maybe Pos
forall a. Maybe a
Nothing Maybe Pos
forall a. Maybe a
Nothing Int
k RDocS
forall a. a -> a
id (Int -> Doc -> Docs -> Docs
Cons Int
0 Doc
x Docs
Nil)
  where
    be :: Bool      -- ^ Did a newline just occur?
       -> Maybe Pos -- ^ Previous source position
       -> Maybe Pos -- ^ Current source position
       -> Int       -- ^ Current column
       -> RDocS     -- ^ Our continuation
       -> Docs      -- ^ 'Docs' to layout
       -> RDoc
    be :: Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
_  Maybe Pos
_ Maybe Pos
_  !Int
_  RDocS
f Docs
Nil           = RDocS
f RDoc
REmpty
    be Bool
nl Maybe Pos
p Maybe Pos
p' !Int
k  RDocS
f (Cons Int
i Doc
d Docs
ds) =
        case Doc
d of
          Doc
Empty      -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
nl    Maybe Pos
p Maybe Pos
p' Int
k RDocS
f Docs
ds
          Char Char
c     -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
False Maybe Pos
p Maybe Pos
p' (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (RDocS
f RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDocS
prag RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> RDocS
RChar Char
c) Docs
ds
          String Int
l String
s -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
False Maybe Pos
p Maybe Pos
p' (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) (RDocS
f RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDocS
prag RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> RDocS
RString Int
l String
s) Docs
ds
          Text Text
s     -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
False Maybe Pos
p Maybe Pos
p' (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Text -> Int
T.length Text
s) (RDocS
f RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDocS
prag RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RDocS
RText Text
s) Docs
ds
          LazyText Text
s -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
False Maybe Pos
p Maybe Pos
p' (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int64
L.length Text
s)) (RDocS
f RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDocS
prag RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RDocS
RLazyText Text
s) Docs
ds
          Doc
Line       -> (RDocS
f RDocS -> RDocS -> RDocS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RDocS
RLine Int
i) (Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
True Maybe Pos
p'' Maybe Pos
forall a. Maybe a
Nothing Int
i RDocS
forall a. a -> a
id Docs
ds)
          Doc
x `Cat` Doc
y  -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
nl Maybe Pos
p Maybe Pos
p' Int
k RDocS
f (Int -> Doc -> Docs -> Docs
Cons Int
i Doc
x (Int -> Doc -> Docs -> Docs
Cons Int
i Doc
y Docs
ds))
          Nest Int
j Doc
x   -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
nl Maybe Pos
p Maybe Pos
p' Int
k RDocS
f (Int -> Doc -> Docs -> Docs
Cons (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j) Doc
x Docs
ds)
          Doc
x `Alt` Doc
y  -> Int -> RDocS -> RDoc -> RDocS
better Int
k RDocS
f (Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
nl Maybe Pos
p Maybe Pos
p' Int
k RDocS
forall a. a -> a
id (Int -> Doc -> Docs -> Docs
Cons Int
i Doc
x Docs
ds))
                                   (Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
nl Maybe Pos
p Maybe Pos
p' Int
k RDocS
forall a. a -> a
id (Int -> Doc -> Docs -> Docs
Cons Int
i Doc
y Docs
ds))
          SrcLoc Loc
loc -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
nl Maybe Pos
p (Maybe Pos -> Loc -> Maybe Pos
updatePos Maybe Pos
p' Loc
loc) Int
k RDocS
f Docs
ds
          Column Int -> Doc
g   -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
nl Maybe Pos
p Maybe Pos
p' Int
k RDocS
f (Int -> Doc -> Docs -> Docs
Cons Int
i (Int -> Doc
g Int
k) Docs
ds)
          Nesting Int -> Doc
g  -> Bool -> Maybe Pos -> Maybe Pos -> Int -> RDocS -> Docs -> RDoc
be Bool
nl Maybe Pos
p Maybe Pos
p' Int
k RDocS
f (Int -> Doc -> Docs -> Docs
Cons Int
i (Int -> Doc
g Int
i) Docs
ds)
      where
        p'' :: Maybe Pos
        prag :: RDocS
        (Maybe Pos
p'', RDocS
prag) = Maybe Pos -> Maybe Pos -> (Maybe Pos, RDocS)
lineLoc Maybe Pos
p Maybe Pos
p'

        -- | Given the previous and current position, figure out the actual
        -- current position and return a 'RDocS' that will add a #line pragma
        -- (in the form of an 'RPos') if necessary.
        lineLoc :: Maybe Pos          -- ^ Previous source position
                -> Maybe Pos          -- ^ Current source position
                -> (Maybe Pos, RDocS) -- ^ Current source position and position
                                      -- pragma
        lineLoc :: Maybe Pos -> Maybe Pos -> (Maybe Pos, RDocS)
lineLoc Maybe Pos
Nothing   Maybe Pos
Nothing       = (Maybe Pos
forall a. Maybe a
Nothing, RDocS
noPragma)
        lineLoc Maybe Pos
Nothing   (Just Pos
p)      = (Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
p, Pos -> RDocS
pragma Pos
p)
        lineLoc (Just Pos
p1) (Just Pos
p2)
            | Pos -> String
posFile Pos
p2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Pos -> String
posFile Pos
p1 Bool -> Bool -> Bool
&&
              Pos -> Int
posLine Pos
p2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Pos -> Int
posLine Pos
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = (Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
p2, RDocS
noPragma)
            | Bool
otherwise                    = (Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
p2, Pos -> RDocS
pragma Pos
p2)
        lineLoc (Just Pos
p1) Maybe Pos
Nothing       = (Pos -> Maybe Pos
forall a. a -> Maybe a
Just (Pos -> Pos
advance Pos
p1), RDocS
noPragma)
          where
            advance :: Pos -> Pos
            advance :: Pos -> Pos
advance (Pos String
f Int
l Int
c Int
coff) = String -> Int -> Int -> Int -> Pos
Pos String
f (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
c Int
coff

        noPragma :: RDocS
        noPragma :: RDocS
noPragma = RDocS
forall a. a -> a
id

        -- We only insert a pragma if a newline was just output.
        pragma :: Pos -> RDocS
        pragma :: Pos -> RDocS
pragma Pos
p | Bool
nl        = Pos -> RDocS
RPos Pos
p
                 | Bool
otherwise = RDocS
forall a. a -> a
id

    better :: Int -> RDocS -> RDoc -> RDoc -> RDoc
    better :: Int -> RDocS -> RDoc -> RDocS
better !Int
k RDocS
f RDoc
x RDoc
y | Int -> RDoc -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) RDoc
x = RDocS
f RDoc
x
                    | Bool
otherwise      = RDocS
f RDoc
y

    fits :: Int -> RDoc -> Bool
    fits :: Int -> RDoc -> Bool
fits  !Int
w  RDoc
_        | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
False
    fits  !Int
_  RDoc
REmpty           = Bool
True
    fits  !Int
w  (RChar Char
_ RDoc
x)      = Int -> RDoc -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) RDoc
x
    fits  !Int
w  (RString Int
l String
_ RDoc
x)  = Int -> RDoc -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) RDoc
x
    fits  !Int
w  (RText Text
s RDoc
x)      = Int -> RDoc -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) RDoc
x
    fits  !Int
w  (RLazyText Text
s RDoc
x)  = Int -> RDoc -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int64
L.length Text
s)) RDoc
x
    fits  !Int
w  (RPos Pos
_ RDoc
x)       = Int -> RDoc -> Bool
fits Int
w RDoc
x
    fits  !Int
_  (RLine Int
_ RDoc
_)      = Bool
True

    updatePos :: Maybe Pos -> Loc -> Maybe Pos
    updatePos :: Maybe Pos -> Loc -> Maybe Pos
updatePos Maybe Pos
Nothing  Loc
NoLoc     = Maybe Pos
forall a. Maybe a
Nothing
    updatePos Maybe Pos
_        (Loc Pos
p Pos
_) = Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
p
    updatePos (Just Pos
p) Loc
NoLoc     = Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
p

-- | Render a document without indentation on infinitely long lines. Since no
-- \'pretty\' printing is involved, this renderer is fast. The resulting output
-- contains fewer characters.
renderCompact :: Doc -> RDoc
renderCompact :: Doc -> RDoc
renderCompact Doc
doc = Int -> [Doc] -> RDoc
scan Int
0 [Doc
doc]
  where
    scan :: Int -> [Doc] -> RDoc
    scan :: Int -> [Doc] -> RDoc
scan !Int
_ []     = RDoc
REmpty
    scan !Int
k (Doc
d:[Doc]
ds) =
        case Doc
d of
          Doc
Empty       -> Int -> [Doc] -> RDoc
scan Int
k [Doc]
ds
          Char Char
c      -> Char -> RDocS
RChar Char
c (Int -> [Doc] -> RDoc
scan (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Doc]
ds)
          String Int
l String
s  -> Int -> String -> RDocS
RString Int
l String
s (Int -> [Doc] -> RDoc
scan (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) [Doc]
ds)
          Text Text
s      -> Text -> RDocS
RText Text
s (Int -> [Doc] -> RDoc
scan (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Text -> Int
T.length Text
s) [Doc]
ds)
          LazyText Text
s  -> Text -> RDocS
RLazyText Text
s (Int -> [Doc] -> RDoc
scan (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int64
L.length Text
s)) [Doc]
ds)
          Doc
Line        -> Int -> RDocS
RLine Int
0 (Int -> [Doc] -> RDoc
scan Int
0 [Doc]
ds)
          Nest Int
_ Doc
x    -> Int -> [Doc] -> RDoc
scan Int
k (Doc
xDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
          SrcLoc Loc
_    -> Int -> [Doc] -> RDoc
scan Int
k [Doc]
ds
          Cat Doc
x Doc
y     -> Int -> [Doc] -> RDoc
scan Int
k (Doc
xDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:Doc
yDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
          Alt Doc
x Doc
_     -> Int -> [Doc] -> RDoc
scan Int
k (Doc
xDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
          Column Int -> Doc
f    -> Int -> [Doc] -> RDoc
scan Int
k (Int -> Doc
f Int
kDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)
          Nesting Int -> Doc
f   -> Int -> [Doc] -> RDoc
scan Int
k (Int -> Doc
f Int
0Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds)

-- | Display a rendered document.
displayS :: RDoc -> ShowS
displayS :: RDoc -> ShowS
displayS = RDoc -> ShowS
go
  where
    go :: RDoc -> ShowS
    go :: RDoc -> ShowS
go RDoc
REmpty          = ShowS
forall a. a -> a
id
    go (RChar Char
c RDoc
x)     = Char -> ShowS
showChar Char
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x
    go (RString Int
_ String
s RDoc
x) = String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x
    go (RText Text
s RDoc
x)     = String -> ShowS
showString (Text -> String
T.unpack Text
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x
    go (RLazyText Text
s RDoc
x) = String -> ShowS
showString (Text -> String
L.unpack Text
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x
    go (RPos Pos
_ RDoc
x)      = RDoc -> ShowS
go RDoc
x
    go (RLine Int
i RDoc
x)     = String -> ShowS
showString (Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x

-- | Render and display a document.
prettyS :: Int -> Doc -> ShowS
prettyS :: Int -> Doc -> ShowS
prettyS Int
w Doc
x = RDoc -> ShowS
displayS (Int -> Doc -> RDoc
render Int
w Doc
x)

-- | Render and convert a document to a 'String'.
pretty :: Int -> Doc -> String
pretty :: Int -> Doc -> String
pretty Int
w Doc
x = Int -> Doc -> ShowS
prettyS Int
w Doc
x String
""

-- | Render and display a document compactly.
prettyCompactS :: Doc -> ShowS
prettyCompactS :: Doc -> ShowS
prettyCompactS Doc
x = RDoc -> ShowS
displayS (Doc -> RDoc
renderCompact Doc
x)

-- | Render and convert a document to a 'String' compactly.
prettyCompact :: Doc -> String
prettyCompact :: Doc -> String
prettyCompact Doc
x = Doc -> ShowS
prettyCompactS Doc
x String
""

-- | Display a rendered document with #line pragmas.
displayPragmaS :: RDoc -> ShowS
displayPragmaS :: RDoc -> ShowS
displayPragmaS = RDoc -> ShowS
go
  where
    go :: RDoc -> ShowS
    go :: RDoc -> ShowS
go RDoc
REmpty          = ShowS
forall a. a -> a
id
    go (RChar Char
c RDoc
x)     = Char -> ShowS
showChar Char
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x
    go (RString Int
_ String
s RDoc
x) = String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x
    go (RText Text
s RDoc
x)     = String -> ShowS
showString (Text -> String
T.unpack Text
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x
    go (RLazyText Text
s RDoc
x) = String -> ShowS
showString (Text -> String
L.unpack Text
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> ShowS
go RDoc
x
    go (RPos Pos
p RDoc
x)      = Pos -> ShowS
showPos Pos
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         RDoc -> ShowS
go RDoc
x
    go (RLine Int
i RDoc
x)     = case RDoc
x of
                           RPos Pos
p RDoc
x' -> Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Pos -> ShowS
showPos Pos
p 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
i Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        RDoc -> ShowS
go RDoc
x'
                           RDoc
_         -> String -> ShowS
showString (Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        RDoc -> ShowS
go RDoc
x

    showPos :: Pos -> ShowS
    showPos :: Pos -> ShowS
showPos Pos
p =
        String -> ShowS
showString String
"#line " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Int -> ShowS
forall a. Show a => a -> ShowS
shows (Pos -> Int
posLine Pos
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Char -> ShowS
showChar Char
'"' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString (Pos -> String
posFile Pos
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Char -> ShowS
showChar Char
'"'

-- | Render and display a document with #line pragmas.
prettyPragmaS :: Int -> Doc -> ShowS
prettyPragmaS :: Int -> Doc -> ShowS
prettyPragmaS Int
w Doc
x = RDoc -> ShowS
displayPragmaS (Int -> Doc -> RDoc
render Int
w Doc
x)

-- | Render and convert a document to a 'String' with #line pragmas.
--
-- > > let loc = Loc (Pos "filename" 3 5 7) (Pos "filename" 5 7 9)
-- > > in  putStrLn $ prettyPragma 80 $ srcloc loc <> text "foo" </> text "bar" </> text "baz"
--
-- will be printed as
--
-- @
-- foo
-- #line 3 "filename"
-- bar
-- baz
-- @
prettyPragma :: Int -> Doc -> String
prettyPragma :: Int -> Doc -> String
prettyPragma Int
w Doc
x = Int -> Doc -> ShowS
prettyPragmaS Int
w Doc
x String
""

-- | Display a rendered document as 'L.Text'. Uses a builder.
displayLazyText :: RDoc -> L.Text
displayLazyText :: RDoc -> Text
displayLazyText = Builder -> Text
B.toLazyText (Builder -> Text) -> (RDoc -> Builder) -> RDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> Builder
go
  where
    go :: RDoc -> B.Builder
    go :: RDoc -> Builder
go RDoc
REmpty          = Builder
forall a. Monoid a => a
mempty
    go (RChar Char
c RDoc
x)     = Char -> Builder
B.singleton Char
c Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x
    go (RString Int
_ String
s RDoc
x) = String -> Builder
B.fromString String
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x
    go (RText Text
s RDoc
x)     = Text -> Builder
B.fromText Text
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x
    go (RLazyText Text
s RDoc
x) = Text -> Builder
B.fromLazyText Text
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x
    go (RPos Pos
_ RDoc
x)      = RDoc -> Builder
go RDoc
x
    go (RLine Int
i RDoc
x)     = String -> Builder
B.fromString (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ') Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x

-- | Render and display a document as 'L.Text'. Uses a builder.
prettyLazyText :: Int -> Doc -> L.Text
prettyLazyText :: Int -> Doc -> Text
prettyLazyText Int
w Doc
x = RDoc -> Text
displayLazyText (Int -> Doc -> RDoc
render Int
w Doc
x)

-- | Display a rendered document with #line pragmas as 'L.Text'. Uses a builder.
displayPragmaLazyText :: RDoc -> L.Text
displayPragmaLazyText :: RDoc -> Text
displayPragmaLazyText = Builder -> Text
B.toLazyText (Builder -> Text) -> (RDoc -> Builder) -> RDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> Builder
go
  where
    go :: RDoc -> B.Builder
    go :: RDoc -> Builder
go RDoc
REmpty          = Builder
forall a. Monoid a => a
mempty
    go (RChar Char
c RDoc
x)     = Char -> Builder
B.singleton Char
c Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x
    go (RText Text
s RDoc
x)     = Text -> Builder
B.fromText Text
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x
    go (RLazyText Text
s RDoc
x) = Text -> Builder
B.fromLazyText Text
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x
    go (RString Int
_ String
s RDoc
x) = String -> Builder
B.fromString String
s Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` RDoc -> Builder
go RDoc
x
    go (RPos Pos
p RDoc
x)      = Pos -> Builder
displayPos Pos
p Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                         Char -> Builder
B.singleton Char
'\n' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                         RDoc -> Builder
go RDoc
x
    go (RLine Int
i RDoc
x)     = case RDoc
x of
                           RPos Pos
p RDoc
x' -> Char -> Builder
B.singleton Char
'\n' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                                        Pos -> Builder
displayPos Pos
p Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                                        String -> Builder
B.fromString (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ') Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                                        RDoc -> Builder
go RDoc
x'
                           RDoc
_         -> String -> Builder
B.fromString (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ') Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
                                        RDoc -> Builder
go RDoc
x

    displayPos :: Pos -> B.Builder
    displayPos :: Pos -> Builder
displayPos Pos
p =
        String -> Builder
B.fromString String
"#line " Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
        Pos -> Builder
renderPosLine Pos
p Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
        Char -> Builder
B.singleton Char
' ' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
        Pos -> Builder
renderPosFile Pos
p

    renderPosLine :: Pos -> B.Builder
    renderPosLine :: Pos -> Builder
renderPosLine = RDoc -> Builder
go (RDoc -> Builder) -> (Pos -> RDoc) -> Pos -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> RDoc
renderCompact (Doc -> RDoc) -> (Pos -> Doc) -> Pos -> RDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
int (Int -> Doc) -> (Pos -> Int) -> Pos -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
posLine

    renderPosFile :: Pos -> B.Builder
    renderPosFile :: Pos -> Builder
renderPosFile = RDoc -> Builder
go (RDoc -> Builder) -> (Pos -> RDoc) -> Pos -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> RDoc
renderCompact (Doc -> RDoc) -> (Pos -> Doc) -> Pos -> RDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc -> Doc
enclose Doc
dquote Doc
dquote (Doc -> Doc) -> (Pos -> Doc) -> Pos -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
string (String -> Doc) -> (Pos -> String) -> Pos -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> String
posFile

-- | Render and convert a document to 'L.Text' with #line pragmas. Uses a builder.
prettyPragmaLazyText :: Int -> Doc -> L.Text
prettyPragmaLazyText :: Int -> Doc -> Text
prettyPragmaLazyText Int
w Doc
x = RDoc -> Text
displayPragmaLazyText (Int -> Doc -> RDoc
render Int
w Doc
x)

-- | Render a document with a width of 80 and print it to standard output.
putDoc :: Doc -> IO ()
putDoc :: Doc -> IO ()
putDoc = Text -> IO ()
TIO.putStr (Text -> IO ()) -> (Doc -> Text) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Text
prettyLazyText Int
80

-- | Render a document with a width of 80 and print it to standard output,
-- followed by a newline.
putDocLn :: Doc -> IO ()
putDocLn :: Doc -> IO ()
putDocLn = Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Doc -> Text) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Text
prettyLazyText Int
80

-- | Render a document with a width of 80 and print it to the specified handle.
hPutDoc :: Handle -> Doc -> IO ()
hPutDoc :: Handle -> Doc -> IO ()
hPutDoc Handle
h = Handle -> Text -> IO ()
TIO.hPutStr Handle
h (Text -> IO ()) -> (Doc -> Text) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Text
prettyLazyText Int
80

-- | Render a document with a width of 80 and print it to the specified handle,
-- followed by a newline.
hPutDocLn :: Handle -> Doc -> IO ()
hPutDocLn :: Handle -> Doc -> IO ()
hPutDocLn Handle
h = Handle -> Text -> IO ()
TIO.hPutStrLn Handle
h (Text -> IO ()) -> (Doc -> Text) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Text
prettyLazyText Int
80