{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

#include "version-compatibility-macros.h"

-- | __Warning: internal module!__ This means that the API may change
-- arbitrarily between versions without notice. Depending on this module may
-- lead to unexpected breakages, so proceed with caution!
--
-- For a stable API, use the non-internal modules. For the special case of
-- writing adaptors to this library’s @'Doc'@ type, see
-- "Data.Text.Prettyprint.Doc.Internal.Type".
module Data.Text.Prettyprint.Doc.Internal (
    -- * Documents
    Doc(..),

    -- * Basic functionality
    Pretty(..),
    viaShow, unsafeViaShow, unsafeTextWithoutNewlines,
    emptyDoc, nest, line, line', softline, softline', hardline, group, flatAlt,

    -- * Alignment functions
    align, hang, indent, encloseSep, list, tupled,

    -- * Binary functions
    (<+>),

    -- * List functions
    concatWith,

    -- ** 'sep' family
    hsep, vsep, fillSep, sep,
    -- ** 'cat' family
    hcat, vcat, fillCat, cat,
    -- ** Others
    punctuate,

    -- * Reactive/conditional layouts
    column, nesting, width, pageWidth,

    -- * Filler functions
    fill, fillBreak,

    -- * General convenience
    plural, enclose, surround,

    -- ** Annotations
    annotate,
    unAnnotate,
    reAnnotate,
    alterAnnotations,
    unAnnotateS,
    reAnnotateS,
    alterAnnotationsS,

    -- * Optimization
    fuse, FusionDepth(..),

    -- * Layout
    SimpleDocStream(..),
    PageWidth(..), defaultPageWidth,
    LayoutOptions(..), defaultLayoutOptions,
    layoutPretty, layoutCompact, layoutSmart,
    removeTrailingWhitespace,

    -- * Rendering
    renderShowS,

    -- * Internal helpers
    textSpaces
) where



import           Control.Applicative
import           Data.Int
import           Data.List.NonEmpty  (NonEmpty (..))
import           Data.Maybe
import           Data.String         (IsString (..))
import           Data.Text           (Text)
import qualified Data.Text           as T
import qualified Data.Text.Lazy      as Lazy
import           Data.Typeable       (Typeable)
import           Data.Void
import           Data.Word
import           GHC.Generics        (Generic)

-- Depending on the Cabal file, this might be from base, or for older builds,
-- from the semigroups package.
import Data.Semigroup

#if NATURAL_IN_BASE
import Numeric.Natural
#endif

#if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)
import Data.Foldable    (Foldable (..))
import Data.Traversable (Traversable (..))
import Prelude          hiding (foldr, foldr1)
#endif

#if FUNCTOR_IDENTITY_IN_BASE
import Data.Functor.Identity
#endif

import Data.Text.Prettyprint.Doc.Render.Util.Panic



-- | The abstract data type @'Doc' ann@ represents pretty documents that have
-- been annotated with data of type @ann@.
--
-- More specifically, a value of type @'Doc'@ represents a non-empty set of
-- possible layouts of a document. The layout functions select one of these
-- possibilities, taking into account things like the width of the output
-- document.
--
-- The annotation is an arbitrary piece of data associated with (part of) a
-- document. Annotations may be used by the rendering backends in order to
-- display output differently, such as
--
--   - color information (e.g. when rendering to the terminal)
--   - mouseover text (e.g. when rendering to rich HTML)
--   - whether to show something or not (to allow simple or detailed versions)
--
-- The simplest way to display a 'Doc' is via the 'Show' class.
--
-- >>> putStrLn (show (vsep ["hello", "world"]))
-- hello
-- world
data Doc ann =

    -- | Occurs when flattening a line. The layouter will reject this document,
    -- choosing a more suitable rendering.
    Fail

    -- | The empty document; conceptually the unit of 'Cat'
    | Empty

    -- | invariant: not '\n'
    | Char !Char

    -- | Invariants: at least two characters long, does not contain '\n'. For
    -- empty documents, there is @Empty@; for singleton documents, there is
    -- @Char@; newlines should be replaced by e.g. @Line@.
    --
    -- Since the frequently used 'T.length' of 'Text' is /O(length)/, we cache
    -- it in this constructor.
    | Text !Int !Text

    -- | Hard line break
    | Line

    -- | Lay out the first 'Doc', but when flattened (via 'group'), fall back to
    -- the second. The flattened version should in general be higher and
    -- narrower than the fallback.
    | FlatAlt (Doc ann) (Doc ann)

    -- | Concatenation of two documents
    | Cat (Doc ann) (Doc ann)

    -- | Document indented by a number of columns
    | Nest !Int (Doc ann)

    -- | Invariant: The first lines of first document should be longer than the
    -- first lines of the second one, so the layout algorithm can pick the one
    -- that fits best. Used to implement layout alternatives for 'group'.
    | Union (Doc ann) (Doc ann)

    -- | React on the current cursor position, see 'column'
    | Column (Int -> Doc ann)

    -- | React on the document's width, see 'pageWidth'
    | WithPageWidth (PageWidth -> Doc ann)

    -- | React on the current nesting level, see 'nesting'
    | Nesting (Int -> Doc ann)

    -- | Add an annotation to the enclosed 'Doc'. Can be used for example to add
    -- styling directives or alt texts that can then be used by the renderer.
    | Annotated ann (Doc ann)
    deriving ((forall x. Doc ann -> Rep (Doc ann) x)
-> (forall x. Rep (Doc ann) x -> Doc ann) -> Generic (Doc ann)
forall x. Rep (Doc ann) x -> Doc ann
forall x. Doc ann -> Rep (Doc ann) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ann x. Rep (Doc ann) x -> Doc ann
forall ann x. Doc ann -> Rep (Doc ann) x
$cto :: forall ann x. Rep (Doc ann) x -> Doc ann
$cfrom :: forall ann x. Doc ann -> Rep (Doc ann) x
Generic, Typeable)

-- |
-- @
-- x '<>' y = 'hcat' [x, y]
-- @
--
-- >>> "hello" <> "world" :: Doc ann
-- helloworld
instance Semigroup (Doc ann) where
    <> :: Doc ann -> Doc ann -> Doc ann
(<>) = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat
    sconcat :: NonEmpty (Doc ann) -> Doc ann
sconcat (x :: Doc ann
x :| xs :: [Doc ann]
xs) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
xs)

-- |
-- @
-- 'mempty' = 'emptyDoc'
-- 'mconcat' = 'hcat'
-- @
--
-- >>> mappend "hello" "world" :: Doc ann
-- helloworld
instance Monoid (Doc ann) where
    mempty :: Doc ann
mempty = Doc ann
forall ann. Doc ann
emptyDoc
    mappend :: Doc ann -> Doc ann -> Doc ann
mappend = Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [Doc ann] -> Doc ann
mconcat = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat

-- | >>> pretty ("hello\nworld")
-- hello
-- world
--
-- This instance uses the 'Pretty' 'Text' instance, and uses the same newline to
-- 'line' conversion.
instance IsString (Doc ann) where
    fromString :: String -> Doc ann
fromString = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (String -> Text) -> String -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Alter the document’s annotations.
--
-- This instance makes 'Doc' more flexible (because it can be used in
-- 'Functor'-polymorphic values), but @'fmap'@ is much less readable compared to
-- using @'reAnnotate'@ in code that only works for @'Doc'@ anyway. Consider
-- using the latter when the type does not matter.
instance Functor Doc where
    fmap :: (a -> b) -> Doc a -> Doc b
fmap = (a -> b) -> Doc a -> Doc b
forall a b. (a -> b) -> Doc a -> Doc b
reAnnotate

-- | Overloaded conversion to 'Doc'.
--
-- Laws:
--
--   1. output should be pretty. :-)
class Pretty a where

    -- | >>> pretty 1 <+> pretty "hello" <+> pretty 1.234
    -- 1 hello 1.234
    pretty :: a -> Doc ann

    default pretty :: Show a => a -> Doc ann
    pretty = a -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

    -- | @'prettyList'@ is only used to define the @instance
    -- 'Pretty' a => 'Pretty' [a]@. In normal circumstances only the @'pretty'@
    -- function is used.
    --
    -- >>> prettyList [1, 23, 456]
    -- [1, 23, 456]
    prettyList :: [a] -> Doc ann
    prettyList = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> ([a] -> Doc ann) -> [a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ([Doc ann] -> Doc ann) -> ([a] -> [Doc ann]) -> [a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc ann) -> [a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

    {-# MINIMAL pretty #-}

-- $
-- Issue #67: Nested lists were not aligned with »pretty«, leading to non-pretty
-- output, violating the Pretty class law.
--
-- >>> pretty (replicate 2 (replicate 4 (1, replicate 8 2)))
-- [ [ (1, [2, 2, 2, 2, 2, 2, 2, 2])
--   , (1, [2, 2, 2, 2, 2, 2, 2, 2])
--   , (1, [2, 2, 2, 2, 2, 2, 2, 2])
--   , (1, [2, 2, 2, 2, 2, 2, 2, 2]) ]
-- , [ (1, [2, 2, 2, 2, 2, 2, 2, 2])
--   , (1, [2, 2, 2, 2, 2, 2, 2, 2])
--   , (1, [2, 2, 2, 2, 2, 2, 2, 2])
--   , (1, [2, 2, 2, 2, 2, 2, 2, 2]) ] ]

instance Pretty a => Pretty (Const a b) where
  pretty :: Const a b -> Doc ann
pretty = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (a -> Doc ann) -> (Const a b -> a) -> Const a b -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const a b -> a
forall a k (b :: k). Const a b -> a
getConst

#if FUNCTOR_IDENTITY_IN_BASE
-- | >>> pretty (Identity 1)
-- 1
instance Pretty a => Pretty (Identity a) where
  pretty :: Identity a -> Doc ann
pretty = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (a -> Doc ann) -> (Identity a -> a) -> Identity a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity
#endif

-- | >>> pretty [1,2,3]
-- [1, 2, 3]
instance Pretty a => Pretty [a] where
    pretty :: [a] -> Doc ann
pretty = [a] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
prettyList

instance Pretty a => Pretty (NonEmpty a) where
    pretty :: NonEmpty a -> Doc ann
pretty (x :: a
x:|xs :: [a]
xs) = [a] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
prettyList (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

-- | >>> pretty ()
-- ()
--
-- The argument is not used,
--
-- >>> pretty (error "Strict?" :: ())
-- ()
instance Pretty () where
    pretty :: () -> Doc ann
pretty _ = "()"

-- | >>> pretty True
-- True
instance Pretty Bool where
    pretty :: Bool -> Doc ann
pretty True  = "True"
    pretty False = "False"

-- | Instead of @('pretty' '\n')@, consider using @'line'@ as a more readable
-- alternative.
--
-- >>> pretty 'f' <> pretty 'o' <> pretty 'o'
-- foo
-- >>> pretty ("string" :: String)
-- string
instance Pretty Char where
    pretty :: Char -> Doc ann
pretty '\n' = Doc ann
forall ann. Doc ann
line
    pretty c :: Char
c = Char -> Doc ann
forall ann. Char -> Doc ann
Char Char
c

    prettyList :: String -> Doc ann
prettyList = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (String -> Text) -> String -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text
forall a. a -> a
id :: Text -> Text) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | Convenience function to convert a 'Show'able value to a 'Doc'. If the
-- 'String' does not contain newlines, consider using the more performant
-- 'unsafeViaShow'.
viaShow :: Show a => a -> Doc ann
viaShow :: a -> Doc ann
viaShow = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (a -> Text) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Convenience function to convert a 'Show'able value /that must not contain
-- newlines/ to a 'Doc'. If there may be newlines, use 'viaShow' instead.
unsafeViaShow :: Show a => a -> Doc ann
unsafeViaShow :: a -> Doc ann
unsafeViaShow = Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines (Text -> Doc ann) -> (a -> Text) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | >>> pretty (123 :: Int)
-- 123
instance Pretty Int    where pretty :: Int -> Doc ann
pretty = Int -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Int8   where pretty :: Int8 -> Doc ann
pretty = Int8 -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Int16  where pretty :: Int16 -> Doc ann
pretty = Int16 -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Int32  where pretty :: Int32 -> Doc ann
pretty = Int32 -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Int64  where pretty :: Int64 -> Doc ann
pretty = Int64 -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Word   where pretty :: Word -> Doc ann
pretty = Word -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Word8  where pretty :: Word8 -> Doc ann
pretty = Word8 -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Word16 where pretty :: Word16 -> Doc ann
pretty = Word16 -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Word32 where pretty :: Word32 -> Doc ann
pretty = Word32 -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
instance Pretty Word64 where pretty :: Word64 -> Doc ann
pretty = Word64 -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow

-- | >>> pretty (2^123 :: Integer)
-- 10633823966279326983230456482242756608
instance Pretty Integer where pretty :: Integer -> Doc ann
pretty = Integer -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow

#if NATURAL_IN_BASE
instance Pretty Natural where pretty :: Natural -> Doc ann
pretty = Natural -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow
#endif

-- | >>> pretty (pi :: Float)
-- 3.1415927
instance Pretty Float where pretty :: Float -> Doc ann
pretty = Float -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow

-- | >>> pretty (exp 1 :: Double)
-- 2.71828182845904...
instance Pretty Double where pretty :: Double -> Doc ann
pretty = Double -> Doc ann
forall a ann. Show a => a -> Doc ann
unsafeViaShow

-- | >>> pretty (123, "hello")
-- (123, hello)
instance (Pretty a1, Pretty a2) => Pretty (a1,a2) where
    pretty :: (a1, a2) -> Doc ann
pretty (x1 :: a1
x1,x2 :: a2
x2) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled [a1 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a1
x1, a2 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a2
x2]

-- | >>> pretty (123, "hello", False)
-- (123, hello, False)
instance (Pretty a1, Pretty a2, Pretty a3) => Pretty (a1,a2,a3) where
    pretty :: (a1, a2, a3) -> Doc ann
pretty (x1 :: a1
x1,x2 :: a2
x2,x3 :: a3
x3) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled [a1 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a1
x1, a2 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a2
x2, a3 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a3
x3]

--    -- | >>> pretty (123, "hello", False, ())
--    -- (123, hello, False, ())
--    instance (Pretty a1, Pretty a2, Pretty a3, Pretty a4) => Pretty (a1,a2,a3,a4) where
--        pretty (x1,x2,x3,x4) = tupled [pretty x1, pretty x2, pretty x3, pretty x4]
--
--    -- | >>> pretty (123, "hello", False, (), 3.14)
--    -- (123, hello, False, (), 3.14)
--    instance (Pretty a1, Pretty a2, Pretty a3, Pretty a4, Pretty a5) => Pretty (a1,a2,a3,a4,a5) where
--        pretty (x1,x2,x3,x4,x5) = tupled [pretty x1, pretty x2, pretty x3, pretty x4, pretty x5]
--
--    -- | >>> pretty (123, "hello", False, (), 3.14, Just 2.71)
--    -- ( 123
--    -- , hello
--    -- , False
--    -- , ()
--    -- , 3.14
--    -- , 2.71 )
--    instance (Pretty a1, Pretty a2, Pretty a3, Pretty a4, Pretty a5, Pretty a6) => Pretty (a1,a2,a3,a4,a5,a6) where
--        pretty (x1,x2,x3,x4,x5,x6) = tupled [pretty x1, pretty x2, pretty x3, pretty x4, pretty x5, pretty x6]
--
--    -- | >>> pretty (123, "hello", False, (), 3.14, Just 2.71, [1,2,3])
--    -- ( 123
--    -- , hello
--    -- , False
--    -- , ()
--    -- , 3.14
--    -- , 2.71
--    -- , [1, 2, 3] )
--    instance (Pretty a1, Pretty a2, Pretty a3, Pretty a4, Pretty a5, Pretty a6, Pretty a7) => Pretty (a1,a2,a3,a4,a5,a6,a7) where
--        pretty (x1,x2,x3,x4,x5,x6,x7) = tupled [pretty x1, pretty x2, pretty x3, pretty x4, pretty x5, pretty x6, pretty x7]

-- | Ignore 'Nothing's, print 'Just' contents.
--
-- >>> pretty (Just True)
-- True
-- >>> braces (pretty (Nothing :: Maybe Bool))
-- {}
--
-- >>> pretty [Just 1, Nothing, Just 3, Nothing]
-- [1, 3]
instance Pretty a => Pretty (Maybe a) where
    pretty :: Maybe a -> Doc ann
pretty = Doc ann -> (a -> Doc ann) -> Maybe a -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
    prettyList :: [Maybe a] -> Doc ann
prettyList = [a] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
prettyList ([a] -> Doc ann) -> ([Maybe a] -> [a]) -> [Maybe a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes

-- | Automatically converts all newlines to @'line'@.
--
-- >>> pretty ("hello\nworld" :: Text)
-- hello
-- world
--
-- Note that  @'line'@ can be undone by @'group'@:
--
-- >>> group (pretty ("hello\nworld" :: Text))
-- hello world
--
-- Manually use @'hardline'@ if you /definitely/ want newlines.
instance Pretty Text where pretty :: Text -> Doc ann
pretty = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> (Text -> [Doc ann]) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
unsafeTextWithoutNewlines ([Text] -> [Doc ann]) -> (Text -> [Text]) -> Text -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn "\n"

-- | (lazy 'Text' instance, identical to the strict version)
instance Pretty Lazy.Text where pretty :: Text -> Doc ann
pretty = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (Text -> Text) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Lazy.toStrict

-- | Finding a good example for printing something that does not exist is hard,
-- so here is an example of printing a list full of nothing.
--
-- >>> pretty ([] :: [Void])
-- []
instance Pretty Void where pretty :: Void -> Doc ann
pretty = Void -> Doc ann
forall a. Void -> a
absurd



-- | @(unsafeTextWithoutNewlines s)@ contains the literal string @s@.
--
-- The string must not contain any newline characters, since this is an
-- invariant of the 'Text' constructor.
unsafeTextWithoutNewlines :: Text -> Doc ann
unsafeTextWithoutNewlines :: Text -> Doc ann
unsafeTextWithoutNewlines text :: Text
text = case Text -> Maybe (Char, Text)
T.uncons Text
text of
    Nothing -> Doc ann
forall ann. Doc ann
Empty
    Just (t :: Char
t,ext :: Text
ext)
        | Text -> Bool
T.null Text
ext -> Char -> Doc ann
forall ann. Char -> Doc ann
Char Char
t
        | Bool
otherwise -> Int -> Text -> Doc ann
forall ann. Int -> Text -> Doc ann
Text (Text -> Int
T.length Text
text) Text
text

-- | The empty document behaves like @('pretty' "")@, so it has a height of 1.
-- This may lead to surprising behaviour if we expect it to bear no weight
-- inside e.g. 'vcat', where we get an empty line of output from it ('parens'
-- for visibility only):
--
-- >>> vsep ["hello", parens emptyDoc, "world"]
-- hello
-- ()
-- world
--
-- Together with '<>', 'emptyDoc' forms the 'Monoid' 'Doc'.
emptyDoc :: Doc ann
emptyDoc :: Doc ann
emptyDoc = Doc ann
forall ann. Doc ann
Empty

-- | @('nest' i x)@ lays out the document @x@ with the current nesting level
-- (indentation of the following lines) increased by @i@. Negative values are
-- allowed, and decrease the nesting level accordingly.
--
-- >>> vsep [nest 4 (vsep ["lorem", "ipsum", "dolor"]), "sit", "amet"]
-- lorem
--     ipsum
--     dolor
-- sit
-- amet
--
-- See also
--
--   * 'hang' ('nest' relative to current cursor position instead of
--      current nesting level)
--   * 'align' (set nesting level to current cursor position)
--   * 'indent' (increase indentation on the spot, padding with spaces).
nest
    :: Int -- ^ Change of nesting level
    -> Doc ann
    -> Doc ann
nest :: Int -> Doc ann -> Doc ann
nest 0 x :: Doc ann
x = Doc ann
x -- Optimization
nest i :: Int
i x :: Doc ann
x = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
Nest Int
i Doc ann
x

-- | The @'line'@ document advances to the next line and indents to the current
-- nesting level.
--
-- >>> let doc = "lorem ipsum" <> line <> "dolor sit amet"
-- >>> doc
-- lorem ipsum
-- dolor sit amet
--
-- @'line'@ behaves like @'space'@ if the line break is undone by 'group':
--
-- >>> group doc
-- lorem ipsum dolor sit amet
line :: Doc ann
line :: Doc ann
line = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
FlatAlt Doc ann
forall ann. Doc ann
Line (Char -> Doc ann
forall ann. Char -> Doc ann
Char ' ')

-- | @'line''@ is like @'line'@, but behaves like @'mempty'@ if the line break
-- is undone by 'group' (instead of @'space'@).
--
-- >>> let doc = "lorem ipsum" <> line' <> "dolor sit amet"
-- >>> doc
-- lorem ipsum
-- dolor sit amet
-- >>> group doc
-- lorem ipsumdolor sit amet
line' :: Doc ann
line' :: Doc ann
line' = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
FlatAlt Doc ann
forall ann. Doc ann
Line Doc ann
forall a. Monoid a => a
mempty

-- | @softline@ behaves like @'space'@ if the resulting output fits the page,
-- otherwise like @'line'@.
--
-- Here, we have enough space to put everything in one line:
--
-- >>> let doc = "lorem ipsum" <> softline <> "dolor sit amet"
-- >>> putDocW 80 doc
-- lorem ipsum dolor sit amet
--
-- If we narrow the page to width 10, the layouter produces a line break:
--
-- >>> putDocW 10 doc
-- lorem ipsum
-- dolor sit amet
--
-- @
-- 'softline' = 'group' 'line'
-- @
softline :: Doc ann
softline :: Doc ann
softline = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Union (Char -> Doc ann
forall ann. Char -> Doc ann
Char ' ') Doc ann
forall ann. Doc ann
Line

-- | @'softline''@ is like @'softline'@, but behaves like @'mempty'@ if the
-- resulting output does not fit on the page (instead of @'space'@). In other
-- words, @'line'@ is to @'line''@ how @'softline'@ is to @'softline''@.
--
-- With enough space, we get direct concatenation:
--
-- >>> let doc = "ThisWord" <> softline' <> "IsWayTooLong"
-- >>> putDocW 80 doc
-- ThisWordIsWayTooLong
--
-- If we narrow the page to width 10, the layouter produces a line break:
--
-- >>> putDocW 10 doc
-- ThisWord
-- IsWayTooLong
--
-- @
-- 'softline'' = 'group' 'line''
-- @
softline' :: Doc ann
softline' :: Doc ann
softline' = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Union Doc ann
forall a. Monoid a => a
mempty Doc ann
forall ann. Doc ann
Line

-- | A @'hardline'@ is /always/ laid out as a line break, even when 'group'ed or
-- when there is plenty of space. Note that it might still be simply discarded
-- if it is part of a 'flatAlt' inside a 'group'.
--
-- >>> let doc = "lorem ipsum" <> hardline <> "dolor sit amet"
-- >>> putDocW 1000 doc
-- lorem ipsum
-- dolor sit amet
--
-- >>> group doc
-- lorem ipsum
-- dolor sit amet
hardline :: Doc ann
hardline :: Doc ann
hardline = Doc ann
forall ann. Doc ann
Line

-- | @('group' x)@ tries laying out @x@ into a single line by removing the
-- contained line breaks; if this does not fit the page, @x@ is laid out without
-- any changes. The 'group' function is key to layouts that adapt to available
-- space nicely.
--
-- See 'vcat', 'line', or 'flatAlt' for examples that are related, or make good
-- use of it.
group :: Doc ann -> Doc ann
-- See note [Group: special flattening]
group :: Doc ann -> Doc ann
group x :: Doc ann
x = case Doc ann
x of
    Union{} -> Doc ann
x
    FlatAlt a :: Doc ann
a b :: Doc ann
b -> case Doc ann -> FlattenResult (Doc ann)
forall ann. Doc ann -> FlattenResult (Doc ann)
changesUponFlattening Doc ann
b of
        Flattened b' :: Doc ann
b' -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Union Doc ann
b' Doc ann
a
        AlreadyFlat  -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Union Doc ann
b Doc ann
a
        NeverFlat    -> Doc ann
a
    _ -> case Doc ann -> FlattenResult (Doc ann)
forall ann. Doc ann -> FlattenResult (Doc ann)
changesUponFlattening Doc ann
x of
        Flattened x' :: Doc ann
x' -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Union Doc ann
x' Doc ann
x
        AlreadyFlat  -> Doc ann
x
        NeverFlat    -> Doc ann
x

-- Note [Group: special flattening]
--
-- Since certain documents do not change under removal of newlines etc, there is
-- no point in creating a 'Union' of the flattened and unflattened version – all
-- this does is introducing two branches for the layout algorithm to take,
-- resulting in potentially exponential behavior on deeply nested examples, such
-- as
--
--     pathological n = iterate (\x ->  hsep [x, sep []] ) "foobar" !! n
--
-- See https://github.com/quchen/prettyprinter/issues/22 for the  corresponding
-- ticket.

data FlattenResult a
    = Flattened a
    -- ^ @a@ is likely flatter than the input.
    | AlreadyFlat
    -- ^ The input was already flat, e.g. a 'Text'.
    | NeverFlat
    -- ^ The input couldn't be flattened: It contained a 'Line' or 'Fail'.

instance Functor FlattenResult where
    fmap :: (a -> b) -> FlattenResult a -> FlattenResult b
fmap f :: a -> b
f (Flattened a :: a
a) = b -> FlattenResult b
forall a. a -> FlattenResult a
Flattened (a -> b
f a
a)
    fmap _ AlreadyFlat   = FlattenResult b
forall a. FlattenResult a
AlreadyFlat
    fmap _ NeverFlat     = FlattenResult b
forall a. FlattenResult a
NeverFlat

-- | Choose the first element of each @Union@, and discard the first field of
-- all @FlatAlt@s.
--
-- The result is 'Flattened' if the element might change depending on the layout
-- algorithm (i.e. contains differently renderable sub-documents), and 'AlreadyFlat'
-- if the document is static (e.g. contains only a plain 'Empty' node).
-- 'NeverFlat' is returned when the document cannot be flattened because it
-- contains a hard 'Line' or 'Fail'.
-- See [Group: special flattening] for further explanations.
changesUponFlattening :: Doc ann -> FlattenResult (Doc ann)
changesUponFlattening :: Doc ann -> FlattenResult (Doc ann)
changesUponFlattening = \doc :: Doc ann
doc -> case Doc ann
doc of
    FlatAlt _ y :: Doc ann
y     -> Doc ann -> FlattenResult (Doc ann)
forall a. a -> FlattenResult a
Flattened (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten Doc ann
y)
    Line            -> FlattenResult (Doc ann)
forall a. FlattenResult a
NeverFlat
    Union x :: Doc ann
x _       -> Doc ann -> FlattenResult (Doc ann)
forall a. a -> FlattenResult a
Flattened Doc ann
x
    Nest i :: Int
i x :: Doc ann
x        -> (Doc ann -> Doc ann)
-> FlattenResult (Doc ann) -> FlattenResult (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
Nest Int
i) (Doc ann -> FlattenResult (Doc ann)
forall ann. Doc ann -> FlattenResult (Doc ann)
changesUponFlattening Doc ann
x)
    Annotated ann :: ann
ann x :: Doc ann
x -> (Doc ann -> Doc ann)
-> FlattenResult (Doc ann) -> FlattenResult (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ann -> Doc ann -> Doc ann
forall ann. ann -> Doc ann -> Doc ann
Annotated ann
ann) (Doc ann -> FlattenResult (Doc ann)
forall ann. Doc ann -> FlattenResult (Doc ann)
changesUponFlattening Doc ann
x)

    Column f :: Int -> Doc ann
f        -> Doc ann -> FlattenResult (Doc ann)
forall a. a -> FlattenResult a
Flattened ((Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
Column (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten (Doc ann -> Doc ann) -> (Int -> Doc ann) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f))
    Nesting f :: Int -> Doc ann
f       -> Doc ann -> FlattenResult (Doc ann)
forall a. a -> FlattenResult a
Flattened ((Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
Nesting (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten (Doc ann -> Doc ann) -> (Int -> Doc ann) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f))
    WithPageWidth f :: PageWidth -> Doc ann
f -> Doc ann -> FlattenResult (Doc ann)
forall a. a -> FlattenResult a
Flattened ((PageWidth -> Doc ann) -> Doc ann
forall ann. (PageWidth -> Doc ann) -> Doc ann
WithPageWidth (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten (Doc ann -> Doc ann)
-> (PageWidth -> Doc ann) -> PageWidth -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Doc ann
f))

    Cat x :: Doc ann
x y :: Doc ann
y -> case (Doc ann -> FlattenResult (Doc ann)
forall ann. Doc ann -> FlattenResult (Doc ann)
changesUponFlattening Doc ann
x, Doc ann -> FlattenResult (Doc ann)
forall ann. Doc ann -> FlattenResult (Doc ann)
changesUponFlattening Doc ann
y) of
        (NeverFlat    ,  _          ) -> FlattenResult (Doc ann)
forall a. FlattenResult a
NeverFlat
        (_            , NeverFlat   ) -> FlattenResult (Doc ann)
forall a. FlattenResult a
NeverFlat
        (Flattened x' :: Doc ann
x' , Flattened y' :: Doc ann
y') -> Doc ann -> FlattenResult (Doc ann)
forall a. a -> FlattenResult a
Flattened (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x' Doc ann
y')
        (Flattened x' :: Doc ann
x' , AlreadyFlat ) -> Doc ann -> FlattenResult (Doc ann)
forall a. a -> FlattenResult a
Flattened (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x' Doc ann
y)
        (AlreadyFlat  , Flattened y' :: Doc ann
y') -> Doc ann -> FlattenResult (Doc ann)
forall a. a -> FlattenResult a
Flattened (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x Doc ann
y')
        (AlreadyFlat  , AlreadyFlat ) -> FlattenResult (Doc ann)
forall a. FlattenResult a
AlreadyFlat

    Empty  -> FlattenResult (Doc ann)
forall a. FlattenResult a
AlreadyFlat
    Char{} -> FlattenResult (Doc ann)
forall a. FlattenResult a
AlreadyFlat
    Text{} -> FlattenResult (Doc ann)
forall a. FlattenResult a
AlreadyFlat
    Fail   -> FlattenResult (Doc ann)
forall a. FlattenResult a
NeverFlat
  where
    -- Flatten, but don’t report whether anything changes.
    flatten :: Doc ann -> Doc ann
    flatten :: Doc ann -> Doc ann
flatten = \doc :: Doc ann
doc -> case Doc ann
doc of
        FlatAlt _ y :: Doc ann
y     -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten Doc ann
y
        Cat x :: Doc ann
x y :: Doc ann
y         -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten Doc ann
x) (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten Doc ann
y)
        Nest i :: Int
i x :: Doc ann
x        -> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
Nest Int
i (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten Doc ann
x)
        Line            -> Doc ann
forall ann. Doc ann
Fail
        Union x :: Doc ann
x _       -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten Doc ann
x
        Column f :: Int -> Doc ann
f        -> (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
Column (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten (Doc ann -> Doc ann) -> (Int -> Doc ann) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f)
        WithPageWidth f :: PageWidth -> Doc ann
f -> (PageWidth -> Doc ann) -> Doc ann
forall ann. (PageWidth -> Doc ann) -> Doc ann
WithPageWidth (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten (Doc ann -> Doc ann)
-> (PageWidth -> Doc ann) -> PageWidth -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Doc ann
f)
        Nesting f :: Int -> Doc ann
f       -> (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
Nesting (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten (Doc ann -> Doc ann) -> (Int -> Doc ann) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f)
        Annotated ann :: ann
ann x :: Doc ann
x -> ann -> Doc ann -> Doc ann
forall ann. ann -> Doc ann -> Doc ann
Annotated ann
ann (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
flatten Doc ann
x)

        x :: Doc ann
x@Doc ann
Fail   -> Doc ann
x
        x :: Doc ann
x@Doc ann
Empty  -> Doc ann
x
        x :: Doc ann
x@Char{} -> Doc ann
x
        x :: Doc ann
x@Text{} -> Doc ann
x



-- | @('flatAlt' x fallback)@ renders as @x@ by default, but falls back to
-- @fallback@ when 'group'ed. Since the layout algorithms rely on 'group' having
-- an effect of shortening the width of the contained text, careless usage of
-- 'flatAlt' with wide fallbacks might lead to unappealingly long lines.
--
-- 'flatAlt' is particularly useful for defining conditional separators such as
--
-- @
-- softHyphen = 'flatAlt' 'mempty' "-"
-- softline   = 'flatAlt' 'space' 'line'
-- @
--
-- We can use this to render Haskell's do-notation nicely:
--
-- >>> let open        = flatAlt "" "{ "
-- >>> let close       = flatAlt "" " }"
-- >>> let separator   = flatAlt "" "; "
-- >>> let prettyDo xs = group ("do" <+> align (encloseSep open close separator xs))
-- >>> let statements  = ["name:_ <- getArgs", "let greet = \"Hello, \" <> name", "putStrLn greet"]
--
-- This is put into a single line with @{;}@ style if it fits,
--
-- >>> putDocW 80 (prettyDo statements)
-- do { name:_ <- getArgs; let greet = "Hello, " <> name; putStrLn greet }
--
-- When there is not enough space the statements are broken up into lines
-- nicely,
--
-- >>> putDocW 10 (prettyDo statements)
-- do name:_ <- getArgs
--    let greet = "Hello, " <> name
--    putStrLn greet
flatAlt
    :: Doc ann -- ^ Default
    -> Doc ann -- ^ Fallback when 'group'ed
    -> Doc ann
flatAlt :: Doc ann -> Doc ann -> Doc ann
flatAlt = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
FlatAlt



-- | @('align' x)@ lays out the document @x@ with the nesting level set to the
-- current column. It is used for example to implement 'hang'.
--
-- As an example, we will put a document right above another one, regardless of
-- the current nesting level. Without 'align'ment, the second line is put simply
-- below everything we've had so far,
--
-- >>> "lorem" <+> vsep ["ipsum", "dolor"]
-- lorem ipsum
-- dolor
--
-- If we add an 'align' to the mix, the @'vsep'@'s contents all start in the
-- same column,
--
-- >>> "lorem" <+> align (vsep ["ipsum", "dolor"])
-- lorem ipsum
--       dolor
align :: Doc ann -> Doc ann
align :: Doc ann -> Doc ann
align d :: Doc ann
d = (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
column (\k :: Int
k -> (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
nesting (\i :: Int
i -> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Doc ann
d)) -- nesting might be negative!

-- | @('hang' i x)@ lays out the document @x@ with a nesting level set to the
-- /current column/ plus @i@. Negative values are allowed, and decrease the
-- nesting level accordingly.
--
-- >>> let doc = reflow "Indenting these words with hang"
-- >>> putDocW 24 ("prefix" <+> hang 4 doc)
-- prefix Indenting these
--            words with
--            hang
--
-- This differs from 'nest', which is based on the /current nesting level/ plus
-- @i@. When you're not sure, try the more efficient 'nest' first. In our
-- example, this would yield
--
-- >>> let doc = reflow "Indenting these words with nest"
-- >>> putDocW 24 ("prefix" <+> nest 4 doc)
-- prefix Indenting these
--     words with nest
--
-- @
-- 'hang' i doc = 'align' ('nest' i doc)
-- @
hang
    :: Int -- ^ Change of nesting level, relative to the start of the first line
    -> Doc ann
    -> Doc ann
hang :: Int -> Doc ann -> Doc ann
hang i :: Int
i d :: Doc ann
d = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
i Doc ann
d)

-- | @('indent' i x)@ indents document @x@ with @i@ spaces, starting from the
-- current cursor position.
--
-- >>> let doc = reflow "The indent function indents these words!"
-- >>> putDocW 24 ("prefix" <> indent 4 doc)
-- prefix    The indent
--           function
--           indents these
--           words!
--
-- @
-- 'indent' i d = 'hang' i ({i spaces} <> d)
-- @
indent
    :: Int -- ^ Number of spaces to increase indentation by
    -> Doc ann
    -> Doc ann
indent :: Int -> Doc ann -> Doc ann
indent i :: Int
i d :: Doc ann
d = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
i (Int -> Doc ann
forall ann. Int -> Doc ann
spaces Int
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
d)

-- | @('encloseSep' l r sep xs)@ concatenates the documents @xs@ separated by
-- @sep@, and encloses the resulting document by @l@ and @r@.
--
-- The documents are laid out horizontally if that fits the page,
--
-- >>> let doc = "list" <+> align (encloseSep lbracket rbracket comma (map pretty [1,20,300,4000]))
-- >>> putDocW 80 doc
-- list [1,20,300,4000]
--
-- If there is not enough space, then the input is split into lines entry-wise
-- therwise they are laid out vertically, with separators put in the front:
--
-- >>> putDocW 10 doc
-- list [1
--      ,20
--      ,300
--      ,4000]
--
-- Note that @doc@ contains an explicit call to 'align' so that the list items
-- are aligned vertically.
--
-- For putting separators at the end of entries instead, have a look at
-- 'punctuate'.
encloseSep
    :: Doc ann   -- ^ left delimiter
    -> Doc ann   -- ^ right delimiter
    -> Doc ann   -- ^ separator
    -> [Doc ann] -- ^ input documents
    -> Doc ann
encloseSep :: Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep l :: Doc ann
l r :: Doc ann
r s :: Doc ann
s ds :: [Doc ann]
ds = case [Doc ann]
ds of
    []  -> Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
r
    [d :: Doc ann
d] -> Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
d Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
r
    _   -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat ((Doc ann -> Doc ann -> Doc ann)
-> [Doc ann] -> [Doc ann] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc ann
l Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann]
forall a. a -> [a]
repeat Doc ann
s) [Doc ann]
ds) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
r

-- | Haskell-inspired variant of 'encloseSep' with braces and comma as
-- separator.
--
-- >>> let doc = list (map pretty [1,20,300,4000])
--
-- >>> putDocW 80 doc
-- [1, 20, 300, 4000]
--
-- >>> putDocW 10 doc
-- [ 1
-- , 20
-- , 300
-- , 4000 ]
list :: [Doc ann] -> Doc ann
list :: [Doc ann] -> Doc ann
list = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt "[ " "[")
                          (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt " ]" "]")
                          ", "

-- | Haskell-inspired variant of 'encloseSep' with parentheses and comma as
-- separator.
--
-- >>> let doc = tupled (map pretty [1,20,300,4000])
--
-- >>> putDocW 80 doc
-- (1, 20, 300, 4000)
--
-- >>> putDocW 10 doc
-- ( 1
-- , 20
-- , 300
-- , 4000 )
tupled :: [Doc ann] -> Doc ann
tupled :: [Doc ann] -> Doc ann
tupled = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt "( " "(")
                            (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt " )" ")")
                            ", "



-- | @(x '<+>' y)@ concatenates document @x@ and @y@ with a @'space'@ in
-- between.
--
-- >>> "hello" <+> "world"
-- hello world
--
-- @
-- x '<+>' y = x '<>' 'space' '<>' y
-- @
(<+>) :: Doc ann -> Doc ann -> Doc ann
x :: Doc ann
x <+> :: Doc ann -> Doc ann -> Doc ann
<+> y :: Doc ann
y = Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall ann. Char -> Doc ann
Char ' ' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y
infixr 6 <+> -- like <>



-- | Concatenate all documents element-wise with a binary function.
--
-- @
-- 'concatWith' _ [] = 'mempty'
-- 'concatWith' (**) [x,y,z] = x ** y ** z
-- @
--
-- Multiple convenience definitions based on 'concatWith' are alredy predefined,
-- for example
--
-- @
-- 'hsep'    = 'concatWith' ('<+>')
-- 'fillSep' = 'concatWith' (\\x y -> x '<>' 'softline' '<>' y)
-- @
--
-- This is also useful to define customized joiners,
--
-- >>> concatWith (surround dot) ["Data", "Text", "Prettyprint", "Doc"]
-- Data.Text.Prettyprint.Doc
concatWith :: Foldable t => (Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith :: (Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith f :: Doc ann -> Doc ann -> Doc ann
f ds :: t (Doc ann)
ds
#if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)
    | foldr (\_ _ -> False) True ds = mempty
#else
    | t (Doc ann) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t (Doc ann)
ds = Doc ann
forall a. Monoid a => a
mempty
#endif
    | Bool
otherwise = (Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc ann -> Doc ann -> Doc ann
f t (Doc ann)
ds
{-# INLINE concatWith #-}
{-# SPECIALIZE concatWith :: (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann #-}

-- | @('hsep' xs)@ concatenates all documents @xs@ horizontally with @'<+>'@,
-- i.e. it puts a space between all entries.
--
-- >>> let docs = Util.words "lorem ipsum dolor sit amet"
--
-- >>> hsep docs
-- lorem ipsum dolor sit amet
--
-- @'hsep'@ does not introduce line breaks on its own, even when the page is too
-- narrow:
--
-- >>> putDocW 5 (hsep docs)
-- lorem ipsum dolor sit amet
--
-- For automatic line breaks, consider using 'fillSep' instead.
hsep :: [Doc ann] -> Doc ann
hsep :: [Doc ann] -> Doc ann
hsep = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
(<+>)

-- | @('vsep' xs)@ concatenates all documents @xs@ above each other. If a
-- 'group' undoes the line breaks inserted by @vsep@, the documents are
-- separated with a 'space' instead.
--
-- Using 'vsep' alone yields
--
-- >>> "prefix" <+> vsep ["text", "to", "lay", "out"]
-- prefix text
-- to
-- lay
-- out
--
-- 'group'ing a 'vsep' separates the documents with a 'space' if it fits the
-- page (and does nothing otherwise). See the @'sep'@ convenience function for
-- this use case.
--
-- The 'align' function can be used to align the documents under their first
-- element:
--
-- >>> "prefix" <+> align (vsep ["text", "to", "lay", "out"])
-- prefix text
--        to
--        lay
--        out
--
-- Since 'group'ing a 'vsep' is rather common, 'sep' is a built-in for doing
-- that.
vsep :: [Doc ann] -> Doc ann
vsep :: [Doc ann] -> Doc ann
vsep = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\x :: Doc ann
x y :: 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)

-- | @('fillSep' xs)@ concatenates the documents @xs@ horizontally with @'<+>'@
-- as long as it fits the page, then inserts a @'line'@ and continues doing that
-- for all documents in @xs@. (@'line'@ means that if 'group'ed, the documents
-- are separated with a 'space' instead of newlines. Use 'fillCat' if you do not
-- want a 'space'.)
--
-- Let's print some words to fill the line:
--
-- >>> let docs = take 20 (cycle ["lorem", "ipsum", "dolor", "sit", "amet"])
-- >>> putDocW 80 ("Docs:" <+> fillSep docs)
-- Docs: lorem ipsum dolor sit amet lorem ipsum dolor sit amet lorem ipsum dolor
-- sit amet lorem ipsum dolor sit amet
--
-- The same document, printed at a width of only 40, yields
--
-- >>> putDocW 40 ("Docs:" <+> fillSep docs)
-- Docs: lorem ipsum dolor sit amet lorem
-- ipsum dolor sit amet lorem ipsum dolor
-- sit amet lorem ipsum dolor sit amet
fillSep :: [Doc ann] -> Doc ann
fillSep :: [Doc ann] -> Doc ann
fillSep = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\x :: Doc ann
x y :: 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)

-- | @('sep' xs)@ tries laying out the documents @xs@ separated with 'space's,
-- and if this does not fit the page, separates them with newlines. This is what
-- differentiates it from 'vsep', which always lays out its contents beneath
-- each other.
--
-- >>> let doc = "prefix" <+> sep ["text", "to", "lay", "out"]
-- >>> putDocW 80 doc
-- prefix text to lay out
--
-- With a narrower layout, the entries are separated by newlines:
--
-- >>> putDocW 20 doc
-- prefix text
-- to
-- lay
-- out
--
-- @
-- 'sep' = 'group' . 'vsep'
-- @
sep :: [Doc ann] -> Doc ann
sep :: [Doc ann] -> Doc ann
sep = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep



-- | @('hcat' xs)@ concatenates all documents @xs@ horizontally with @'<>'@
-- (i.e. without any spacing).
--
-- It is provided only for consistency, since it is identical to 'mconcat'.
--
-- >>> let docs = Util.words "lorem ipsum dolor"
-- >>> hcat docs
-- loremipsumdolor
hcat :: [Doc ann] -> Doc ann
hcat :: [Doc ann] -> Doc ann
hcat = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>)

-- | @('vcat' xs)@ vertically concatenates the documents @xs@. If it is
-- 'group'ed, the line breaks are removed.
--
-- In other words @'vcat'@ is like @'vsep'@, with newlines removed instead of
-- replaced by 'space's.
--
-- >>> let docs = Util.words "lorem ipsum dolor"
-- >>> vcat docs
-- lorem
-- ipsum
-- dolor
-- >>> group (vcat docs)
-- loremipsumdolor
--
-- Since 'group'ing a 'vcat' is rather common, 'cat' is a built-in shortcut for
-- it.
vcat :: [Doc ann] -> Doc ann
vcat :: [Doc ann] -> Doc ann
vcat = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\x :: Doc ann
x y :: 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)

-- | @('fillCat' xs)@ concatenates documents @xs@ horizontally with @'<>'@ as
-- long as it fits the page, then inserts a @'line''@ and continues doing that
-- for all documents in @xs@. This is similar to how an ordinary word processor
-- lays out the text if you just keep typing after you hit the maximum line
-- length.
--
-- (@'line''@ means that if 'group'ed, the documents are separated with nothing
-- instead of newlines. See 'fillSep' if you want a 'space' instead.)
--
-- Observe the difference between 'fillSep' and 'fillCat'. 'fillSep'
-- concatenates the entries 'space'd when 'group'ed,
--
-- >>> let docs = take 20 (cycle (["lorem", "ipsum", "dolor", "sit", "amet"]))
-- >>> putDocW 40 ("Grouped:" <+> group (fillSep docs))
-- Grouped: lorem ipsum dolor sit amet
-- lorem ipsum dolor sit amet lorem ipsum
-- dolor sit amet lorem ipsum dolor sit
-- amet
--
-- On the other hand, 'fillCat' concatenates the entries directly when
-- 'group'ed,
--
-- >>> putDocW 40 ("Grouped:" <+> group (fillCat docs))
-- Grouped: loremipsumdolorsitametlorem
-- ipsumdolorsitametloremipsumdolorsitamet
-- loremipsumdolorsitamet
fillCat :: [Doc ann] -> Doc ann
fillCat :: [Doc ann] -> Doc ann
fillCat = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\x :: Doc ann
x y :: 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)

-- | @('cat' xs)@ tries laying out the documents @xs@ separated with nothing,
-- and if this does not fit the page, separates them with newlines. This is what
-- differentiates it from 'vcat', which always lays out its contents beneath
-- each other.
--
-- >>> let docs = Util.words "lorem ipsum dolor"
-- >>> putDocW 80 ("Docs:" <+> cat docs)
-- Docs: loremipsumdolor
--
-- When there is enough space, the documents are put above one another,
--
-- >>> putDocW 10 ("Docs:" <+> cat docs)
-- Docs: lorem
-- ipsum
-- dolor
--
-- @
-- 'cat' = 'group' . 'vcat'
-- @
cat :: [Doc ann] -> Doc ann
cat :: [Doc ann] -> Doc ann
cat = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat



-- | @('punctuate' p xs)@ appends @p@ to all but the last document in @xs@.
--
-- >>> let docs = punctuate comma (Util.words "lorem ipsum dolor sit amet")
-- >>> putDocW 80 (hsep docs)
-- lorem, ipsum, dolor, sit, amet
--
-- The separators are put at the end of the entries, which we can see if we
-- position the result vertically:
--
-- >>> putDocW 20 (vsep docs)
-- lorem,
-- ipsum,
-- dolor,
-- sit,
-- amet
--
-- If you want put the commas in front of their elements instead of at the end,
-- you should use 'tupled' or, in general, 'encloseSep'.
punctuate
    :: Doc ann -- ^ Punctuation, e.g. 'comma'
    -> [Doc ann]
    -> [Doc ann]
punctuate :: Doc ann -> [Doc ann] -> [Doc ann]
punctuate p :: Doc ann
p = [Doc ann] -> [Doc ann]
go
  where
    go :: [Doc ann] -> [Doc ann]
go []     = []
    go [d :: Doc ann
d]    = [Doc ann
d]
    go (d :: Doc ann
d:ds :: [Doc ann]
ds) = (Doc ann
d Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
p) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann] -> [Doc ann]
go [Doc ann]
ds



-- | Layout a document depending on which column it starts at. 'align' is
-- implemented in terms of 'column'.
--
-- >>> column (\l -> "Columns are" <+> pretty l <> "-based.")
-- Columns are 0-based.
--
-- >>> let doc = "prefix" <+> column (\l -> "| <- column" <+> pretty l)
-- >>> vsep [indent n doc | n <- [0,4,8]]
-- prefix | <- column 7
--     prefix | <- column 11
--         prefix | <- column 15
column :: (Int -> Doc ann) -> Doc ann
column :: (Int -> Doc ann) -> Doc ann
column = (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
Column

-- | Layout a document depending on the current 'nest'ing level. 'align' is
-- implemented in terms of 'nesting'.
--
-- >>> let doc = "prefix" <+> nesting (\l -> brackets ("Nested:" <+> pretty l))
-- >>> vsep [indent n doc | n <- [0,4,8]]
-- prefix [Nested: 0]
--     prefix [Nested: 4]
--         prefix [Nested: 8]
nesting :: (Int -> Doc ann) -> Doc ann
nesting :: (Int -> Doc ann) -> Doc ann
nesting = (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
Nesting

-- | @('width' doc f)@ lays out the document 'doc', and makes the column width
-- of it available to a function.
--
-- >>> let annotate doc = width (brackets doc) (\w -> " <- width:" <+> pretty w)
-- >>> align (vsep (map annotate ["---", "------", indent 3 "---", vsep ["---", indent 4 "---"]]))
-- [---] <- width: 5
-- [------] <- width: 8
-- [   ---] <- width: 8
-- [---
--     ---] <- width: 8
width :: Doc ann -> (Int -> Doc ann) -> Doc ann
width :: Doc ann -> (Int -> Doc ann) -> Doc ann
width doc :: Doc ann
doc f :: Int -> Doc ann
f
  = (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
column (\colStart :: Int
colStart ->
        Doc ann
doc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
column (\colEnd :: Int
colEnd ->
            Int -> Doc ann
f (Int
colEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colStart)))

-- | Layout a document depending on the page width, if one has been specified.
--
-- >>> let prettyPageWidth (AvailablePerLine l r) = "Width:" <+> pretty l <> ", ribbon fraction:" <+> pretty r
-- >>> let doc = "prefix" <+> pageWidth (brackets . prettyPageWidth)
-- >>> putDocW 32 (vsep [indent n doc | n <- [0,4,8]])
-- prefix [Width: 32, ribbon fraction: 1.0]
--     prefix [Width: 32, ribbon fraction: 1.0]
--         prefix [Width: 32, ribbon fraction: 1.0]
pageWidth :: (PageWidth -> Doc ann) -> Doc ann
pageWidth :: (PageWidth -> Doc ann) -> Doc ann
pageWidth = (PageWidth -> Doc ann) -> Doc ann
forall ann. (PageWidth -> Doc ann) -> Doc ann
WithPageWidth



-- | @('fill' i x)@ lays out the document @x@. It then appends @space@s until
-- the width is equal to @i@. If the width of @x@ is already larger, nothing is
-- appended.
--
-- This function is quite useful in practice to output a list of bindings:
--
-- >>> let types = [("empty","Doc"), ("nest","Int -> Doc -> Doc"), ("fillSep","[Doc] -> Doc")]
-- >>> let ptype (name, tp) = fill 5 (pretty name) <+> "::" <+> pretty tp
-- >>> "let" <+> align (vcat (map ptype types))
-- let empty :: Doc
--     nest  :: Int -> Doc -> Doc
--     fillSep :: [Doc] -> Doc
fill
    :: Int -- ^ Append spaces until the document is at least this wide
    -> Doc ann
    -> Doc ann
fill :: Int -> Doc ann -> Doc ann
fill n :: Int
n doc :: Doc ann
doc = Doc ann -> (Int -> Doc ann) -> Doc ann
forall ann. Doc ann -> (Int -> Doc ann) -> Doc ann
width Doc ann
doc (\w :: Int
w -> Int -> Doc ann
forall ann. Int -> Doc ann
spaces (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w))

-- | @('fillBreak' i x)@ first lays out the document @x@. It then appends @space@s
-- until the width is equal to @i@. If the width of @x@ is already larger than
-- @i@, the nesting level is increased by @i@ and a @line@ is appended. When we
-- redefine @ptype@ in the example given in 'fill' to use @'fillBreak'@, we get
-- a useful variation of the output:
--
-- >>> let types = [("empty","Doc"), ("nest","Int -> Doc -> Doc"), ("fillSep","[Doc] -> Doc")]
-- >>> let ptype (name, tp) = fillBreak 5 (pretty name) <+> "::" <+> pretty tp
-- >>> "let" <+> align (vcat (map ptype types))
-- let empty :: Doc
--     nest  :: Int -> Doc -> Doc
--     fillSep
--           :: [Doc] -> Doc
fillBreak
    :: Int -- ^ Append spaces until the document is at least this wide
    -> Doc ann
    -> Doc ann
fillBreak :: Int -> Doc ann -> Doc ann
fillBreak f :: Int
f x :: Doc ann
x = Doc ann -> (Int -> Doc ann) -> Doc ann
forall ann. Doc ann -> (Int -> Doc ann) -> Doc ann
width Doc ann
x (\w :: Int
w ->
    if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
f
        then Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
f Doc ann
forall ann. Doc ann
line'
        else Int -> Doc ann
forall ann. Int -> Doc ann
spaces (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w))

-- | Insert a number of spaces. Negative values count as 0.
spaces :: Int -> Doc ann
spaces :: Int -> Doc ann
spaces n :: Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0    = Doc ann
forall ann. Doc ann
Empty
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1    = Char -> Doc ann
forall ann. Char -> Doc ann
Char ' '
  | Bool
otherwise = Int -> Text -> Doc ann
forall ann. Int -> Text -> Doc ann
Text Int
n (Int -> Text
textSpaces Int
n)

-- $
-- prop> \(NonNegative n) -> length (show (spaces n)) == n
--
-- >>> case spaces 1 of Char ' ' -> True; _ -> False
-- True
--
-- >>> case spaces 0 of Empty -> True; _ -> False
-- True
--
-- prop> \(Positive n) -> case (spaces (-n)) of Empty -> True; _ -> False



-- | @('plural' n one many)@ is @one@ if @n@ is @1@, and @many@ otherwise. A
-- typical use case is  adding a plural "s".
--
-- >>> let things = [True]
-- >>> let amount = length things
-- >>> pretty things <+> "has" <+> pretty amount <+> plural "entry" "entries" amount
-- [True] has 1 entry
plural
    :: (Num amount, Eq amount)
    => doc -- ^ @1@ case
    -> doc -- ^ other cases
    -> amount
    -> doc
plural :: doc -> doc -> amount -> doc
plural one :: doc
one multiple :: doc
multiple n :: amount
n
    | amount
n amount -> amount -> Bool
forall a. Eq a => a -> a -> Bool
== 1    = doc
one
    | Bool
otherwise = doc
multiple

-- | @('enclose' l r x)@ encloses document @x@ between documents @l@ and @r@
-- using @'<>'@.
--
-- >>> enclose "A" "Z" "·"
-- A·Z
--
-- @
-- 'enclose' l r x = l '<>' x '<>' r
-- @
enclose
    :: Doc ann -- ^ L
    -> Doc ann -- ^ R
    -> Doc ann -- ^ x
    -> Doc ann -- ^ LxR
enclose :: Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose l :: Doc ann
l r :: Doc ann
r x :: Doc ann
x = Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
r

-- | @('surround' x l r)@ surrounds document @x@ with @l@ and @r@.
--
-- >>> surround "·" "A" "Z"
-- A·Z
--
-- This is merely an argument reordering of @'enclose'@, but allows for
-- definitions like
--
-- >>> concatWith (surround ".") ["Data", "Text", "Prettyprint", "Doc"]
-- Data.Text.Prettyprint.Doc
surround
    :: Doc ann
    -> Doc ann
    -> Doc ann
    -> Doc ann
surround :: Doc ann -> Doc ann -> Doc ann -> Doc ann
surround x :: Doc ann
x l :: Doc ann
l r :: Doc ann
r = Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
r






-- | Add an annotation to a @'Doc'@. This annotation can then be used by the
-- renderer to e.g. add color to certain parts of the output. For a full
-- tutorial example on how to use it, see the
-- "Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial" or
-- "Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial" modules.
--
-- This function is only relevant for custom formats with their own annotations,
-- and not relevant for basic prettyprinting. The predefined renderers, e.g.
-- "Data.Text.Prettyprint.Doc.Render.Text", should be enough for the most common
-- needs.
annotate :: ann -> Doc ann -> Doc ann
annotate :: ann -> Doc ann -> Doc ann
annotate = ann -> Doc ann -> Doc ann
forall ann. ann -> Doc ann -> Doc ann
Annotated

-- | Remove all annotations.
--
-- Although 'unAnnotate' is idempotent with respect to rendering,
--
-- @
-- 'unAnnotate' . 'unAnnotate' = 'unAnnotate'
-- @
--
-- it should not be used without caution, for each invocation traverses the
-- entire contained document. If possible, it is preferrable to unannotate after
-- producing the layout by using 'unAnnotateS'.
unAnnotate :: Doc ann -> Doc xxx
unAnnotate :: Doc ann -> Doc xxx
unAnnotate = (ann -> [xxx]) -> Doc ann -> Doc xxx
forall ann ann'. (ann -> [ann']) -> Doc ann -> Doc ann'
alterAnnotations ([xxx] -> ann -> [xxx]
forall a b. a -> b -> a
const [])

-- | Change the annotation of a 'Doc'ument.
--
-- Useful in particular to embed documents with one form of annotation in a more
-- generlly annotated document.
--
-- Since this traverses the entire @'Doc'@ tree, including parts that are not
-- rendered due to other layouts fitting better, it is preferrable to reannotate
-- after producing the layout by using @'reAnnotateS'@.
--
-- Since @'reAnnotate'@ has the right type and satisfies @'reAnnotate id = id'@,
-- it is used to define the @'Functor'@ instance of @'Doc'@.
reAnnotate :: (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate :: (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate re :: ann -> ann'
re = (ann -> [ann']) -> Doc ann -> Doc ann'
forall ann ann'. (ann -> [ann']) -> Doc ann -> Doc ann'
alterAnnotations (ann' -> [ann']
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ann' -> [ann']) -> (ann -> ann') -> ann -> [ann']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ann -> ann'
re)

-- | Change the annotations of a 'Doc'ument. Individual annotations can be
-- removed, changed, or replaced by multiple ones.
--
-- This is a general function that combines 'unAnnotate' and 'reAnnotate', and
-- it is useful for mapping semantic annotations (such as »this is a keyword«)
-- to display annotations (such as »this is red and underlined«), because some
-- backends may not care about certain annotations, while others may.
--
-- Annotations earlier in the new list will be applied earlier, i.e. returning
-- @[Bold, Green]@ will result in a bold document that contains green text, and
-- not vice-versa.
--
-- Since this traverses the entire @'Doc'@ tree, including parts that are not
-- rendered due to other layouts fitting better, it is preferrable to reannotate
-- after producing the layout by using @'alterAnnotationsS'@.
alterAnnotations :: (ann -> [ann']) -> Doc ann -> Doc ann'
alterAnnotations :: (ann -> [ann']) -> Doc ann -> Doc ann'
alterAnnotations re :: ann -> [ann']
re = Doc ann -> Doc ann'
go
  where
    go :: Doc ann -> Doc ann'
go = \doc :: Doc ann
doc -> case Doc ann
doc of
        Fail     -> Doc ann'
forall ann. Doc ann
Fail
        Empty    -> Doc ann'
forall ann. Doc ann
Empty
        Char c :: Char
c   -> Char -> Doc ann'
forall ann. Char -> Doc ann
Char Char
c
        Text l :: Int
l t :: Text
t -> Int -> Text -> Doc ann'
forall ann. Int -> Text -> Doc ann
Text Int
l Text
t
        Line     -> Doc ann'
forall ann. Doc ann
Line

        FlatAlt x :: Doc ann
x y :: Doc ann
y     -> Doc ann' -> Doc ann' -> Doc ann'
forall ann. Doc ann -> Doc ann -> Doc ann
FlatAlt (Doc ann -> Doc ann'
go Doc ann
x) (Doc ann -> Doc ann'
go Doc ann
y)
        Cat x :: Doc ann
x y :: Doc ann
y         -> Doc ann' -> Doc ann' -> Doc ann'
forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Doc ann -> Doc ann'
go Doc ann
x) (Doc ann -> Doc ann'
go Doc ann
y)
        Nest i :: Int
i x :: Doc ann
x        -> Int -> Doc ann' -> Doc ann'
forall ann. Int -> Doc ann -> Doc ann
Nest Int
i (Doc ann -> Doc ann'
go Doc ann
x)
        Union x :: Doc ann
x y :: Doc ann
y       -> Doc ann' -> Doc ann' -> Doc ann'
forall ann. Doc ann -> Doc ann -> Doc ann
Union (Doc ann -> Doc ann'
go Doc ann
x) (Doc ann -> Doc ann'
go Doc ann
y)
        Column f :: Int -> Doc ann
f        -> (Int -> Doc ann') -> Doc ann'
forall ann. (Int -> Doc ann) -> Doc ann
Column (Doc ann -> Doc ann'
go (Doc ann -> Doc ann') -> (Int -> Doc ann) -> Int -> Doc ann'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f)
        WithPageWidth f :: PageWidth -> Doc ann
f -> (PageWidth -> Doc ann') -> Doc ann'
forall ann. (PageWidth -> Doc ann) -> Doc ann
WithPageWidth (Doc ann -> Doc ann'
go (Doc ann -> Doc ann')
-> (PageWidth -> Doc ann) -> PageWidth -> Doc ann'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Doc ann
f)
        Nesting f :: Int -> Doc ann
f       -> (Int -> Doc ann') -> Doc ann'
forall ann. (Int -> Doc ann) -> Doc ann
Nesting (Doc ann -> Doc ann'
go (Doc ann -> Doc ann') -> (Int -> Doc ann) -> Int -> Doc ann'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f)
        Annotated ann :: ann
ann x :: Doc ann
x -> (ann' -> Doc ann' -> Doc ann') -> Doc ann' -> [ann'] -> Doc ann'
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ann' -> Doc ann' -> Doc ann'
forall ann. ann -> Doc ann -> Doc ann
Annotated (Doc ann -> Doc ann'
go Doc ann
x) (ann -> [ann']
re ann
ann)

-- $
-- >>> let doc = "lorem" <+> annotate () "ipsum" <+> "dolor"
-- >>> let re () = ["FOO", "BAR"]
-- >>> layoutPretty defaultLayoutOptions (alterAnnotations re doc)
-- SText 5 "lorem" (SChar ' ' (SAnnPush "FOO" (SAnnPush "BAR" (SText 5 "ipsum" (SAnnPop (SAnnPop (SChar ' ' (SText 5 "dolor" SEmpty))))))))

-- | Remove all annotations. 'unAnnotate' for 'SimpleDocStream'.
unAnnotateS :: SimpleDocStream ann -> SimpleDocStream xxx
unAnnotateS :: SimpleDocStream ann -> SimpleDocStream xxx
unAnnotateS = SimpleDocStream ann -> SimpleDocStream xxx
forall ann ann. SimpleDocStream ann -> SimpleDocStream ann
go
  where
    go :: SimpleDocStream ann -> SimpleDocStream ann
go = \doc :: SimpleDocStream ann
doc -> case SimpleDocStream ann
doc of
        SFail              -> SimpleDocStream ann
forall ann. SimpleDocStream ann
SFail
        SEmpty             -> SimpleDocStream ann
forall ann. SimpleDocStream ann
SEmpty
        SChar c :: Char
c rest :: SimpleDocStream ann
rest       -> Char -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c (SimpleDocStream ann -> SimpleDocStream ann
go SimpleDocStream ann
rest)
        SText l :: Int
l t :: Text
t rest :: SimpleDocStream ann
rest     -> Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
l Text
t (SimpleDocStream ann -> SimpleDocStream ann
go SimpleDocStream ann
rest)
        SLine l :: Int
l rest :: SimpleDocStream ann
rest       -> Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine Int
l (SimpleDocStream ann -> SimpleDocStream ann
go SimpleDocStream ann
rest)
        SAnnPop rest :: SimpleDocStream ann
rest       -> SimpleDocStream ann -> SimpleDocStream ann
go SimpleDocStream ann
rest
        SAnnPush _ann :: ann
_ann rest :: SimpleDocStream ann
rest -> SimpleDocStream ann -> SimpleDocStream ann
go SimpleDocStream ann
rest

-- | Change the annotation of a document. 'reAnnotate' for 'SimpleDocStream'.
reAnnotateS :: (ann -> ann') -> SimpleDocStream ann -> SimpleDocStream ann'
reAnnotateS :: (ann -> ann') -> SimpleDocStream ann -> SimpleDocStream ann'
reAnnotateS re :: ann -> ann'
re = SimpleDocStream ann -> SimpleDocStream ann'
go
  where
    go :: SimpleDocStream ann -> SimpleDocStream ann'
go = \doc :: SimpleDocStream ann
doc -> case SimpleDocStream ann
doc of
        SFail             -> SimpleDocStream ann'
forall ann. SimpleDocStream ann
SFail
        SEmpty            -> SimpleDocStream ann'
forall ann. SimpleDocStream ann
SEmpty
        SChar c :: Char
c rest :: SimpleDocStream ann
rest      -> Char -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c (SimpleDocStream ann -> SimpleDocStream ann'
go SimpleDocStream ann
rest)
        SText l :: Int
l t :: Text
t rest :: SimpleDocStream ann
rest    -> Int -> Text -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
l Text
t (SimpleDocStream ann -> SimpleDocStream ann'
go SimpleDocStream ann
rest)
        SLine l :: Int
l rest :: SimpleDocStream ann
rest      -> Int -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine Int
l (SimpleDocStream ann -> SimpleDocStream ann'
go SimpleDocStream ann
rest)
        SAnnPop rest :: SimpleDocStream ann
rest      -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann. SimpleDocStream ann -> SimpleDocStream ann
SAnnPop (SimpleDocStream ann -> SimpleDocStream ann'
go SimpleDocStream ann
rest)
        SAnnPush ann :: ann
ann rest :: SimpleDocStream ann
rest -> ann' -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann. ann -> SimpleDocStream ann -> SimpleDocStream ann
SAnnPush (ann -> ann'
re ann
ann) (SimpleDocStream ann -> SimpleDocStream ann'
go SimpleDocStream ann
rest)

data AnnotationRemoval = Remove | DontRemove
  deriving Typeable

-- | Change the annotation of a document to a different annotation, or none at
-- all. 'alterAnnotations' for 'SimpleDocStream'.
--
-- Note that the 'Doc' version is more flexible, since it allows changing a
-- single annotation to multiple ones.
-- ('Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.SimpleDocTree' restores
-- this flexibility again.)
alterAnnotationsS :: (ann -> Maybe ann') -> SimpleDocStream ann -> SimpleDocStream ann'
alterAnnotationsS :: (ann -> Maybe ann') -> SimpleDocStream ann -> SimpleDocStream ann'
alterAnnotationsS re :: ann -> Maybe ann'
re = [AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go []
  where
    -- We keep a stack of whether to remove a pop so that we can remove exactly
    -- the pops corresponding to annotations that mapped to Nothing.
    go :: [AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go stack :: [AnnotationRemoval]
stack = \sds :: SimpleDocStream ann
sds -> case SimpleDocStream ann
sds of
        SFail             -> SimpleDocStream ann'
forall ann. SimpleDocStream ann
SFail
        SEmpty            -> SimpleDocStream ann'
forall ann. SimpleDocStream ann
SEmpty
        SChar c :: Char
c rest :: SimpleDocStream ann
rest      -> Char -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c ([AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go [AnnotationRemoval]
stack SimpleDocStream ann
rest)
        SText l :: Int
l t :: Text
t rest :: SimpleDocStream ann
rest    -> Int -> Text -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
l Text
t ([AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go [AnnotationRemoval]
stack SimpleDocStream ann
rest)
        SLine l :: Int
l rest :: SimpleDocStream ann
rest      -> Int -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine Int
l ([AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go [AnnotationRemoval]
stack SimpleDocStream ann
rest)
        SAnnPush ann :: ann
ann rest :: SimpleDocStream ann
rest -> case ann -> Maybe ann'
re ann
ann of
            Nothing   -> [AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go (AnnotationRemoval
RemoveAnnotationRemoval -> [AnnotationRemoval] -> [AnnotationRemoval]
forall a. a -> [a] -> [a]
:[AnnotationRemoval]
stack) SimpleDocStream ann
rest
            Just ann' :: ann'
ann' -> ann' -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann. ann -> SimpleDocStream ann -> SimpleDocStream ann
SAnnPush ann'
ann' ([AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go (AnnotationRemoval
DontRemoveAnnotationRemoval -> [AnnotationRemoval] -> [AnnotationRemoval]
forall a. a -> [a] -> [a]
:[AnnotationRemoval]
stack) SimpleDocStream ann
rest)
        SAnnPop rest :: SimpleDocStream ann
rest      -> case [AnnotationRemoval]
stack of
            []                -> SimpleDocStream ann'
forall void. void
panicPeekedEmpty
            DontRemove:stack' :: [AnnotationRemoval]
stack' -> SimpleDocStream ann' -> SimpleDocStream ann'
forall ann. SimpleDocStream ann -> SimpleDocStream ann
SAnnPop ([AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go [AnnotationRemoval]
stack' SimpleDocStream ann
rest)
            Remove:stack' :: [AnnotationRemoval]
stack'     -> [AnnotationRemoval] -> SimpleDocStream ann -> SimpleDocStream ann'
go [AnnotationRemoval]
stack' SimpleDocStream ann
rest

-- | Fusion depth parameter, used by 'fuse'.
data FusionDepth =

    -- | Do not dive deep into nested documents, fusing mostly concatenations of
    -- text nodes together.
    Shallow

    -- | Recurse into all parts of the 'Doc', including different layout
    -- alternatives, and location-sensitive values such as created by 'nesting'
    -- which cannot be fused before, but only during, the layout process. As a
    -- result, the performance cost of using deep fusion is often hard to
    -- predict, and depends on the interplay between page layout and document to
    -- prettyprint.
    --
    -- This value should only be used if profiling shows it is significantly
    -- faster than using 'Shallow'.
    | Deep
    deriving (FusionDepth -> FusionDepth -> Bool
(FusionDepth -> FusionDepth -> Bool)
-> (FusionDepth -> FusionDepth -> Bool) -> Eq FusionDepth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FusionDepth -> FusionDepth -> Bool
$c/= :: FusionDepth -> FusionDepth -> Bool
== :: FusionDepth -> FusionDepth -> Bool
$c== :: FusionDepth -> FusionDepth -> Bool
Eq, Eq FusionDepth
Eq FusionDepth =>
(FusionDepth -> FusionDepth -> Ordering)
-> (FusionDepth -> FusionDepth -> Bool)
-> (FusionDepth -> FusionDepth -> Bool)
-> (FusionDepth -> FusionDepth -> Bool)
-> (FusionDepth -> FusionDepth -> Bool)
-> (FusionDepth -> FusionDepth -> FusionDepth)
-> (FusionDepth -> FusionDepth -> FusionDepth)
-> Ord FusionDepth
FusionDepth -> FusionDepth -> Bool
FusionDepth -> FusionDepth -> Ordering
FusionDepth -> FusionDepth -> FusionDepth
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FusionDepth -> FusionDepth -> FusionDepth
$cmin :: FusionDepth -> FusionDepth -> FusionDepth
max :: FusionDepth -> FusionDepth -> FusionDepth
$cmax :: FusionDepth -> FusionDepth -> FusionDepth
>= :: FusionDepth -> FusionDepth -> Bool
$c>= :: FusionDepth -> FusionDepth -> Bool
> :: FusionDepth -> FusionDepth -> Bool
$c> :: FusionDepth -> FusionDepth -> Bool
<= :: FusionDepth -> FusionDepth -> Bool
$c<= :: FusionDepth -> FusionDepth -> Bool
< :: FusionDepth -> FusionDepth -> Bool
$c< :: FusionDepth -> FusionDepth -> Bool
compare :: FusionDepth -> FusionDepth -> Ordering
$ccompare :: FusionDepth -> FusionDepth -> Ordering
$cp1Ord :: Eq FusionDepth
Ord, Int -> FusionDepth -> ShowS
[FusionDepth] -> ShowS
FusionDepth -> String
(Int -> FusionDepth -> ShowS)
-> (FusionDepth -> String)
-> ([FusionDepth] -> ShowS)
-> Show FusionDepth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FusionDepth] -> ShowS
$cshowList :: [FusionDepth] -> ShowS
show :: FusionDepth -> String
$cshow :: FusionDepth -> String
showsPrec :: Int -> FusionDepth -> ShowS
$cshowsPrec :: Int -> FusionDepth -> ShowS
Show, Typeable)

-- | @('fuse' depth doc)@ combines text nodes so they can be rendered more
-- efficiently. A fused document is always laid out identical to its unfused
-- version.
--
-- When laying a 'Doc'ument out to a 'SimpleDocStream', every component of the
-- input is translated directly to the simpler output format. This sometimes
-- yields undesirable chunking when many pieces have been concatenated together.
--
-- For example
--
-- >>> "a" <> "b" <> pretty 'c' <> "d"
-- abcd
--
-- results in a chain of four entries in a 'SimpleDocStream', although this is fully
-- equivalent to the tightly packed
--
-- >>> "abcd" :: Doc ann
-- abcd
--
-- which is only a single 'SimpleDocStream' entry, and can be processed faster.
--
-- It is therefore a good idea to run 'fuse' on concatenations of lots of small
-- strings that are used many times,
--
-- >>> let oftenUsed = fuse Shallow ("a" <> "b" <> pretty 'c' <> "d")
-- >>> hsep (replicate 5 oftenUsed)
-- abcd abcd abcd abcd abcd
fuse :: FusionDepth -> Doc ann -> Doc ann
fuse :: FusionDepth -> Doc ann -> Doc ann
fuse depth :: FusionDepth
depth = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
go
  where
    go :: Doc ann -> Doc ann
go = \doc :: Doc ann
doc -> case Doc ann
doc of
        Cat Empty x :: Doc ann
x                   -> Doc ann -> Doc ann
go Doc ann
x
        Cat x :: Doc ann
x Empty                   -> Doc ann -> Doc ann
go Doc ann
x
        Cat (Char c1 :: Char
c1) (Char c2 :: Char
c2)       -> Int -> Text -> Doc ann
forall ann. Int -> Text -> Doc ann
Text 2 (Char -> Text
T.singleton Char
c1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c2)
        Cat (Text lt :: Int
lt t :: Text
t) (Char c :: Char
c)      -> Int -> Text -> Doc ann
forall ann. Int -> Text -> Doc ann
Text (Int
ltInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Text -> Char -> Text
T.snoc Text
t Char
c)
        Cat (Char c :: Char
c) (Text lt :: Int
lt t :: Text
t)      -> Int -> Text -> Doc ann
forall ann. Int -> Text -> Doc ann
Text (1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lt) (Char -> Text -> Text
T.cons Char
c Text
t)
        Cat (Text l1 :: Int
l1 t1 :: Text
t1) (Text l2 :: Int
l2 t2 :: Text
t2) -> Int -> Text -> Doc ann
forall ann. Int -> Text -> Doc ann
Text (Int
l1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l2) (Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t2)

        Cat x :: Doc ann
x@Char{} (Cat y :: Doc ann
y@Char{} z :: Doc ann
z) -> Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x Doc ann
y)) Doc ann
z)
        Cat x :: Doc ann
x@Text{} (Cat y :: Doc ann
y@Char{} z :: Doc ann
z) -> Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x Doc ann
y)) Doc ann
z)
        Cat x :: Doc ann
x@Char{} (Cat y :: Doc ann
y@Text{} z :: Doc ann
z) -> Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x Doc ann
y)) Doc ann
z)
        Cat x :: Doc ann
x@Text{} (Cat y :: Doc ann
y@Text{} z :: Doc ann
z) -> Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x Doc ann
y)) Doc ann
z)

        Cat (Cat x :: Doc ann
x y :: Doc ann
y@Char{}) z :: Doc ann
z -> Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x (Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
y Doc ann
z)))
        Cat (Cat x :: Doc ann
x y :: Doc ann
y@Text{}) z :: Doc ann
z -> Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
x (Doc ann -> Doc ann
go (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat Doc ann
y Doc ann
z)))

        Cat x :: Doc ann
x y :: Doc ann
y -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Doc ann -> Doc ann
go Doc ann
x) (Doc ann -> Doc ann
go Doc ann
y)

        Nest i :: Int
i (Nest j :: Int
j x :: Doc ann
x) -> let !fused :: Doc ann
fused = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
Nest (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j) Doc ann
x
                             in Doc ann -> Doc ann
go Doc ann
fused
        Nest _ x :: Doc ann
x@Empty{} -> Doc ann
x
        Nest _ x :: Doc ann
x@Text{}  -> Doc ann
x
        Nest _ x :: Doc ann
x@Char{}  -> Doc ann
x
        Nest 0 x :: Doc ann
x         -> Doc ann -> Doc ann
go Doc ann
x
        Nest i :: Int
i x :: Doc ann
x         -> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
Nest Int
i (Doc ann -> Doc ann
go Doc ann
x)

        Annotated ann :: ann
ann x :: Doc ann
x -> ann -> Doc ann -> Doc ann
forall ann. ann -> Doc ann -> Doc ann
Annotated ann
ann (Doc ann -> Doc ann
go Doc ann
x)

        FlatAlt x1 :: Doc ann
x1 x2 :: Doc ann
x2 -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
FlatAlt (Doc ann -> Doc ann
go Doc ann
x1) (Doc ann -> Doc ann
go Doc ann
x2)
        Union x1 :: Doc ann
x1 x2 :: Doc ann
x2   -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Union (Doc ann -> Doc ann
go Doc ann
x1) (Doc ann -> Doc ann
go Doc ann
x2)

        other :: Doc ann
other | FusionDepth
depth FusionDepth -> FusionDepth -> Bool
forall a. Eq a => a -> a -> Bool
== FusionDepth
Shallow -> Doc ann
other

        Column f :: Int -> Doc ann
f        -> (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
Column (Doc ann -> Doc ann
go (Doc ann -> Doc ann) -> (Int -> Doc ann) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f)
        WithPageWidth f :: PageWidth -> Doc ann
f -> (PageWidth -> Doc ann) -> Doc ann
forall ann. (PageWidth -> Doc ann) -> Doc ann
WithPageWidth (Doc ann -> Doc ann
go (Doc ann -> Doc ann)
-> (PageWidth -> Doc ann) -> PageWidth -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Doc ann
f)
        Nesting f :: Int -> Doc ann
f       -> (Int -> Doc ann) -> Doc ann
forall ann. (Int -> Doc ann) -> Doc ann
Nesting (Doc ann -> Doc ann
go (Doc ann -> Doc ann) -> (Int -> Doc ann) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann
f)

        other :: Doc ann
other -> Doc ann
other



-- | The data type @SimpleDocStream@ represents laid out documents and is used
-- by the display functions.
--
-- A simplified view is that @'Doc' = ['SimpleDocStream']@, and the layout
-- functions pick one of the 'SimpleDocStream's based on which one fits the
-- layout constraints best. This means that 'SimpleDocStream' has all complexity
-- contained in 'Doc' resolved, making it very easy to convert it to other
-- formats, such as plain text or terminal output.
--
-- To write your own @'Doc'@ to X converter, it is therefore sufficient to
-- convert from @'SimpleDocStream'@. The »Render« submodules provide some
-- built-in converters to do so, and helpers to create own ones.
data SimpleDocStream ann =
      SFail
    | SEmpty
    | SChar Char (SimpleDocStream ann)

    -- | Some layout algorithms use the Since the frequently used 'T.length' of
    -- the 'Text', which scales linearly with its length, we cache it in this
    -- constructor.
    | SText !Int Text (SimpleDocStream ann)

    -- | @Int@ = indentation level for the (next) line
    | SLine !Int (SimpleDocStream ann)

    -- | Add an annotation to the remaining document.
    | SAnnPush ann (SimpleDocStream ann)

    -- | Remove a previously pushed annotation.
    | SAnnPop (SimpleDocStream ann)
    deriving (SimpleDocStream ann -> SimpleDocStream ann -> Bool
(SimpleDocStream ann -> SimpleDocStream ann -> Bool)
-> (SimpleDocStream ann -> SimpleDocStream ann -> Bool)
-> Eq (SimpleDocStream ann)
forall ann.
Eq ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleDocStream ann -> SimpleDocStream ann -> Bool
$c/= :: forall ann.
Eq ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Bool
== :: SimpleDocStream ann -> SimpleDocStream ann -> Bool
$c== :: forall ann.
Eq ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Bool
Eq, Eq (SimpleDocStream ann)
Eq (SimpleDocStream ann) =>
(SimpleDocStream ann -> SimpleDocStream ann -> Ordering)
-> (SimpleDocStream ann -> SimpleDocStream ann -> Bool)
-> (SimpleDocStream ann -> SimpleDocStream ann -> Bool)
-> (SimpleDocStream ann -> SimpleDocStream ann -> Bool)
-> (SimpleDocStream ann -> SimpleDocStream ann -> Bool)
-> (SimpleDocStream ann
    -> SimpleDocStream ann -> SimpleDocStream ann)
-> (SimpleDocStream ann
    -> SimpleDocStream ann -> SimpleDocStream ann)
-> Ord (SimpleDocStream ann)
SimpleDocStream ann -> SimpleDocStream ann -> Bool
SimpleDocStream ann -> SimpleDocStream ann -> Ordering
SimpleDocStream ann -> SimpleDocStream ann -> SimpleDocStream ann
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall ann. Ord ann => Eq (SimpleDocStream ann)
forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Bool
forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Ordering
forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> SimpleDocStream ann
min :: SimpleDocStream ann -> SimpleDocStream ann -> SimpleDocStream ann
$cmin :: forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> SimpleDocStream ann
max :: SimpleDocStream ann -> SimpleDocStream ann -> SimpleDocStream ann
$cmax :: forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> SimpleDocStream ann
>= :: SimpleDocStream ann -> SimpleDocStream ann -> Bool
$c>= :: forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Bool
> :: SimpleDocStream ann -> SimpleDocStream ann -> Bool
$c> :: forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Bool
<= :: SimpleDocStream ann -> SimpleDocStream ann -> Bool
$c<= :: forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Bool
< :: SimpleDocStream ann -> SimpleDocStream ann -> Bool
$c< :: forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Bool
compare :: SimpleDocStream ann -> SimpleDocStream ann -> Ordering
$ccompare :: forall ann.
Ord ann =>
SimpleDocStream ann -> SimpleDocStream ann -> Ordering
$cp1Ord :: forall ann. Ord ann => Eq (SimpleDocStream ann)
Ord, Int -> SimpleDocStream ann -> ShowS
[SimpleDocStream ann] -> ShowS
SimpleDocStream ann -> String
(Int -> SimpleDocStream ann -> ShowS)
-> (SimpleDocStream ann -> String)
-> ([SimpleDocStream ann] -> ShowS)
-> Show (SimpleDocStream ann)
forall ann. Show ann => Int -> SimpleDocStream ann -> ShowS
forall ann. Show ann => [SimpleDocStream ann] -> ShowS
forall ann. Show ann => SimpleDocStream ann -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleDocStream ann] -> ShowS
$cshowList :: forall ann. Show ann => [SimpleDocStream ann] -> ShowS
show :: SimpleDocStream ann -> String
$cshow :: forall ann. Show ann => SimpleDocStream ann -> String
showsPrec :: Int -> SimpleDocStream ann -> ShowS
$cshowsPrec :: forall ann. Show ann => Int -> SimpleDocStream ann -> ShowS
Show, (forall x. SimpleDocStream ann -> Rep (SimpleDocStream ann) x)
-> (forall x. Rep (SimpleDocStream ann) x -> SimpleDocStream ann)
-> Generic (SimpleDocStream ann)
forall x. Rep (SimpleDocStream ann) x -> SimpleDocStream ann
forall x. SimpleDocStream ann -> Rep (SimpleDocStream ann) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ann x. Rep (SimpleDocStream ann) x -> SimpleDocStream ann
forall ann x. SimpleDocStream ann -> Rep (SimpleDocStream ann) x
$cto :: forall ann x. Rep (SimpleDocStream ann) x -> SimpleDocStream ann
$cfrom :: forall ann x. SimpleDocStream ann -> Rep (SimpleDocStream ann) x
Generic, Typeable)

-- | Remove all trailing space characters.
--
-- This has some performance impact, because it does an entire additional pass
-- over the 'SimpleDocStream'.
--
-- No trimming will be done inside annotations, which are considered to contain
-- no (trimmable) whitespace, since the annotation might actually be /about/ the
-- whitespace, for example a renderer that colors the background of trailing
-- whitespace, as e.g. @git diff@ can be configured to do.
removeTrailingWhitespace :: SimpleDocStream ann -> SimpleDocStream ann
removeTrailingWhitespace :: SimpleDocStream ann -> SimpleDocStream ann
removeTrailingWhitespace = WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go ([Int] -> Int -> WhitespaceStrippingState
RecordedWhitespace [] 0)
  where
    commitWhitespace
        :: [Int] -- Withheld lines
        -> Int -- Withheld spaces
        -> SimpleDocStream ann
        -> SimpleDocStream ann
    commitWhitespace :: [Int] -> Int -> SimpleDocStream ann -> SimpleDocStream ann
commitWhitespace is :: [Int]
is !Int
n sds :: SimpleDocStream ann
sds = case [Int]
is of
        []      -> case Int
n of
                       0 -> SimpleDocStream ann
sds
                       1 -> Char -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar ' ' SimpleDocStream ann
sds
                       _ -> Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
n (Int -> Text
textSpaces Int
n) SimpleDocStream ann
sds
        (i :: Int
i:is' :: [Int]
is') -> let !end :: SimpleDocStream ann
end = Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) SimpleDocStream ann
sds
                   in [Int] -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. [Int] -> SimpleDocStream ann -> SimpleDocStream ann
prependEmptyLines [Int]
is' SimpleDocStream ann
end

    prependEmptyLines :: [Int] -> SimpleDocStream ann -> SimpleDocStream ann
    prependEmptyLines :: [Int] -> SimpleDocStream ann -> SimpleDocStream ann
prependEmptyLines is :: [Int]
is sds0 :: SimpleDocStream ann
sds0 = (Int -> SimpleDocStream ann -> SimpleDocStream ann)
-> SimpleDocStream ann -> [Int] -> SimpleDocStream ann
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\_ sds :: SimpleDocStream ann
sds -> Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine 0 SimpleDocStream ann
sds) SimpleDocStream ann
sds0 [Int]
is

    go :: WhitespaceStrippingState -> SimpleDocStream ann -> SimpleDocStream ann
    -- We do not strip whitespace inside annotated documents, since it might
    -- actually be relevant there.
    go :: WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go annLevel :: WhitespaceStrippingState
annLevel@(AnnotationLevel annLvl :: Int
annLvl) = \sds :: SimpleDocStream ann
sds -> case SimpleDocStream ann
sds of
        SFail             -> SimpleDocStream ann
forall ann. SimpleDocStream ann
SFail
        SEmpty            -> SimpleDocStream ann
forall ann. SimpleDocStream ann
SEmpty
        SChar c :: Char
c rest :: SimpleDocStream ann
rest      -> Char -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go WhitespaceStrippingState
annLevel SimpleDocStream ann
rest)
        SText l :: Int
l text :: Text
text rest :: SimpleDocStream ann
rest -> Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
l Text
text (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go WhitespaceStrippingState
annLevel SimpleDocStream ann
rest)
        SLine i :: Int
i rest :: SimpleDocStream ann
rest      -> Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine Int
i (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go WhitespaceStrippingState
annLevel SimpleDocStream ann
rest)
        SAnnPush ann :: ann
ann rest :: SimpleDocStream ann
rest -> let !annLvl' :: Int
annLvl' = Int
annLvlInt -> Int -> Int
forall a. Num a => a -> a -> a
+1
                             in ann -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. ann -> SimpleDocStream ann -> SimpleDocStream ann
SAnnPush ann
ann (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go (Int -> WhitespaceStrippingState
AnnotationLevel Int
annLvl') SimpleDocStream ann
rest)
        SAnnPop rest :: SimpleDocStream ann
rest
            | Int
annLvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1  -> let !annLvl' :: Int
annLvl' = Int
annLvlInt -> Int -> Int
forall a. Num a => a -> a -> a
-1
                             in SimpleDocStream ann -> SimpleDocStream ann
forall ann. SimpleDocStream ann -> SimpleDocStream ann
SAnnPop (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go (Int -> WhitespaceStrippingState
AnnotationLevel Int
annLvl') SimpleDocStream ann
rest)
            | Bool
otherwise   -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. SimpleDocStream ann -> SimpleDocStream ann
SAnnPop (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go ([Int] -> Int -> WhitespaceStrippingState
RecordedWhitespace [] 0) SimpleDocStream ann
rest)
    -- Record all spaces/lines encountered, and once proper text starts again,
    -- release only the necessary ones.
    go (RecordedWhitespace withheldLines :: [Int]
withheldLines withheldSpaces :: Int
withheldSpaces) = \sds :: SimpleDocStream ann
sds -> case SimpleDocStream ann
sds of
        SFail -> SimpleDocStream ann
forall ann. SimpleDocStream ann
SFail
        SEmpty -> [Int] -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. [Int] -> SimpleDocStream ann -> SimpleDocStream ann
prependEmptyLines [Int]
withheldLines SimpleDocStream ann
forall ann. SimpleDocStream ann
SEmpty
        SChar c :: Char
c rest :: SimpleDocStream ann
rest
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' -> WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go ([Int] -> Int -> WhitespaceStrippingState
RecordedWhitespace [Int]
withheldLines (Int
withheldSpacesInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)) SimpleDocStream ann
rest
            | Bool
otherwise -> [Int] -> Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
[Int] -> Int -> SimpleDocStream ann -> SimpleDocStream ann
commitWhitespace
                               [Int]
withheldLines
                               Int
withheldSpaces
                               (Char -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go ([Int] -> Int -> WhitespaceStrippingState
RecordedWhitespace [] 0) SimpleDocStream ann
rest))
        SText textLength :: Int
textLength text :: Text
text rest :: SimpleDocStream ann
rest ->
            let stripped :: Text
stripped = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') Text
text
                strippedLength :: Int
strippedLength = Text -> Int
T.length Text
stripped
                trailingLength :: Int
trailingLength = Int
textLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
strippedLength
                isOnlySpace :: Bool
isOnlySpace = Int
strippedLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
            in if Bool
isOnlySpace
                then WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go ([Int] -> Int -> WhitespaceStrippingState
RecordedWhitespace [Int]
withheldLines (Int
withheldSpaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
textLength)) SimpleDocStream ann
rest
                else [Int] -> Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
[Int] -> Int -> SimpleDocStream ann -> SimpleDocStream ann
commitWhitespace
                        [Int]
withheldLines
                        Int
withheldSpaces
                        (Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
strippedLength
                               Text
stripped
                               (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go ([Int] -> Int -> WhitespaceStrippingState
RecordedWhitespace [] Int
trailingLength) SimpleDocStream ann
rest))
        SLine i :: Int
i rest :: SimpleDocStream ann
rest -> WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go ([Int] -> Int -> WhitespaceStrippingState
RecordedWhitespace (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
withheldLines) 0) SimpleDocStream ann
rest
        SAnnPush ann :: ann
ann rest :: SimpleDocStream ann
rest -> [Int] -> Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
[Int] -> Int -> SimpleDocStream ann -> SimpleDocStream ann
commitWhitespace
                                 [Int]
withheldLines
                                 Int
withheldSpaces
                                 (ann -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. ann -> SimpleDocStream ann -> SimpleDocStream ann
SAnnPush ann
ann (WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
WhitespaceStrippingState
-> SimpleDocStream ann -> SimpleDocStream ann
go (Int -> WhitespaceStrippingState
AnnotationLevel 1) SimpleDocStream ann
rest))
        SAnnPop _ -> String -> SimpleDocStream ann
forall a. HasCallStack => String -> a
error "Tried skipping spaces in unannotated data! Please report this as a bug in 'prettyprinter'."

data WhitespaceStrippingState
    = AnnotationLevel !Int
    | RecordedWhitespace [Int] !Int
      -- ^ [Newline with indentation i] Spaces
  deriving Typeable



-- $
-- >>> import qualified Data.Text.IO as T
-- >>> doc = "lorem" <> hardline <> hardline <> pretty "ipsum"
-- >>> go = T.putStrLn . renderStrict . removeTrailingWhitespace . layoutPretty defaultLayoutOptions
-- >>> go doc
-- lorem
-- <BLANKLINE>
-- ipsum



-- | Alter the document’s annotations.
--
-- This instance makes 'SimpleDocStream' more flexible (because it can be used in
-- 'Functor'-polymorphic values), but @'fmap'@ is much less readable compared to
-- using @'reAnnotateST'@ in code that only works for @'SimpleDocStream'@ anyway.
-- Consider using the latter when the type does not matter.
instance Functor SimpleDocStream where
    fmap :: (a -> b) -> SimpleDocStream a -> SimpleDocStream b
fmap = (a -> b) -> SimpleDocStream a -> SimpleDocStream b
forall a b. (a -> b) -> SimpleDocStream a -> SimpleDocStream b
reAnnotateS

-- | Collect all annotations from a document.
instance Foldable SimpleDocStream where
    foldMap :: (a -> m) -> SimpleDocStream a -> m
foldMap f :: a -> m
f = SimpleDocStream a -> m
go
      where
        go :: SimpleDocStream a -> m
go = \sds :: SimpleDocStream a
sds -> case SimpleDocStream a
sds of
            SFail             -> m
forall a. Monoid a => a
mempty
            SEmpty            -> m
forall a. Monoid a => a
mempty
            SChar _ rest :: SimpleDocStream a
rest      -> SimpleDocStream a -> m
go SimpleDocStream a
rest
            SText _ _ rest :: SimpleDocStream a
rest    -> SimpleDocStream a -> m
go SimpleDocStream a
rest
            SLine _ rest :: SimpleDocStream a
rest      -> SimpleDocStream a -> m
go SimpleDocStream a
rest
            SAnnPush ann :: a
ann rest :: SimpleDocStream a
rest -> a -> m
f a
ann m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` SimpleDocStream a -> m
go SimpleDocStream a
rest
            SAnnPop rest :: SimpleDocStream a
rest      -> SimpleDocStream a -> m
go SimpleDocStream a
rest

-- | Transform a document based on its annotations, possibly leveraging
-- 'Applicative' effects.
instance Traversable SimpleDocStream where
    traverse :: (a -> f b) -> SimpleDocStream a -> f (SimpleDocStream b)
traverse f :: a -> f b
f = SimpleDocStream a -> f (SimpleDocStream b)
go
      where
        go :: SimpleDocStream a -> f (SimpleDocStream b)
go = \sds :: SimpleDocStream a
sds -> case SimpleDocStream a
sds of
            SFail             -> SimpleDocStream b -> f (SimpleDocStream b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SimpleDocStream b
forall ann. SimpleDocStream ann
SFail
            SEmpty            -> SimpleDocStream b -> f (SimpleDocStream b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SimpleDocStream b
forall ann. SimpleDocStream ann
SEmpty
            SChar c :: Char
c rest :: SimpleDocStream a
rest      -> Char -> SimpleDocStream b -> SimpleDocStream b
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c   (SimpleDocStream b -> SimpleDocStream b)
-> f (SimpleDocStream b) -> f (SimpleDocStream b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleDocStream a -> f (SimpleDocStream b)
go SimpleDocStream a
rest
            SText l :: Int
l t :: Text
t rest :: SimpleDocStream a
rest    -> Int -> Text -> SimpleDocStream b -> SimpleDocStream b
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
l Text
t (SimpleDocStream b -> SimpleDocStream b)
-> f (SimpleDocStream b) -> f (SimpleDocStream b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleDocStream a -> f (SimpleDocStream b)
go SimpleDocStream a
rest
            SLine i :: Int
i rest :: SimpleDocStream a
rest      -> Int -> SimpleDocStream b -> SimpleDocStream b
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine Int
i   (SimpleDocStream b -> SimpleDocStream b)
-> f (SimpleDocStream b) -> f (SimpleDocStream b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleDocStream a -> f (SimpleDocStream b)
go SimpleDocStream a
rest
            SAnnPush ann :: a
ann rest :: SimpleDocStream a
rest -> b -> SimpleDocStream b -> SimpleDocStream b
forall ann. ann -> SimpleDocStream ann -> SimpleDocStream ann
SAnnPush  (b -> SimpleDocStream b -> SimpleDocStream b)
-> f b -> f (SimpleDocStream b -> SimpleDocStream b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
ann f (SimpleDocStream b -> SimpleDocStream b)
-> f (SimpleDocStream b) -> f (SimpleDocStream b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SimpleDocStream a -> f (SimpleDocStream b)
go SimpleDocStream a
rest
            SAnnPop rest :: SimpleDocStream a
rest      -> SimpleDocStream b -> SimpleDocStream b
forall ann. SimpleDocStream ann -> SimpleDocStream ann
SAnnPop   (SimpleDocStream b -> SimpleDocStream b)
-> f (SimpleDocStream b) -> f (SimpleDocStream b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleDocStream a -> f (SimpleDocStream b)
go SimpleDocStream a
rest

-- | Decide whether a 'SimpleDocStream' fits the constraints given, namely
--
--   - page width
--   - minimum nesting level to fit in
--   - width in which to fit the first line
newtype FittingPredicate ann
  = FittingPredicate (PageWidth
                   -> Int
                   -> Int
                   -> SimpleDocStream ann
                   -> Bool)
  deriving Typeable

-- | List of nesting level/document pairs yet to be laid out.
data LayoutPipeline ann =
      Nil
    | Cons !Int (Doc ann) (LayoutPipeline ann)
    | UndoAnn (LayoutPipeline ann)
  deriving Typeable

-- | Maximum number of characters that fit in one line. The layout algorithms
-- will try not to exceed the set limit by inserting line breaks when applicable
-- (e.g. via 'softline'').
data PageWidth

    = AvailablePerLine Int Double
    -- ^ Layouters should not exceed the specified space per line.
    --
    --   - The 'Int' is the number of characters, including whitespace, that
    --     fit in a line. A typical value is 80.
    --
    --   - The 'Double' is the ribbon with, i.e. the fraction of the total
    --     page width that can be printed on. This allows limiting the length
    --     of printable text per line. Values must be between 0 and 1, and
    --     0.4 to 1 is typical.

    | Unbounded
    -- ^ Layouters should not introduce line breaks on their own.

    deriving (PageWidth -> PageWidth -> Bool
(PageWidth -> PageWidth -> Bool)
-> (PageWidth -> PageWidth -> Bool) -> Eq PageWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageWidth -> PageWidth -> Bool
$c/= :: PageWidth -> PageWidth -> Bool
== :: PageWidth -> PageWidth -> Bool
$c== :: PageWidth -> PageWidth -> Bool
Eq, Eq PageWidth
Eq PageWidth =>
(PageWidth -> PageWidth -> Ordering)
-> (PageWidth -> PageWidth -> Bool)
-> (PageWidth -> PageWidth -> Bool)
-> (PageWidth -> PageWidth -> Bool)
-> (PageWidth -> PageWidth -> Bool)
-> (PageWidth -> PageWidth -> PageWidth)
-> (PageWidth -> PageWidth -> PageWidth)
-> Ord PageWidth
PageWidth -> PageWidth -> Bool
PageWidth -> PageWidth -> Ordering
PageWidth -> PageWidth -> PageWidth
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PageWidth -> PageWidth -> PageWidth
$cmin :: PageWidth -> PageWidth -> PageWidth
max :: PageWidth -> PageWidth -> PageWidth
$cmax :: PageWidth -> PageWidth -> PageWidth
>= :: PageWidth -> PageWidth -> Bool
$c>= :: PageWidth -> PageWidth -> Bool
> :: PageWidth -> PageWidth -> Bool
$c> :: PageWidth -> PageWidth -> Bool
<= :: PageWidth -> PageWidth -> Bool
$c<= :: PageWidth -> PageWidth -> Bool
< :: PageWidth -> PageWidth -> Bool
$c< :: PageWidth -> PageWidth -> Bool
compare :: PageWidth -> PageWidth -> Ordering
$ccompare :: PageWidth -> PageWidth -> Ordering
$cp1Ord :: Eq PageWidth
Ord, Int -> PageWidth -> ShowS
[PageWidth] -> ShowS
PageWidth -> String
(Int -> PageWidth -> ShowS)
-> (PageWidth -> String)
-> ([PageWidth] -> ShowS)
-> Show PageWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageWidth] -> ShowS
$cshowList :: [PageWidth] -> ShowS
show :: PageWidth -> String
$cshow :: PageWidth -> String
showsPrec :: Int -> PageWidth -> ShowS
$cshowsPrec :: Int -> PageWidth -> ShowS
Show, Typeable)

defaultPageWidth :: PageWidth
defaultPageWidth :: PageWidth
defaultPageWidth = Int -> Double -> PageWidth
AvailablePerLine 80 1

-- $ Test to avoid surprising behaviour
-- >>> Unbounded > AvailablePerLine maxBound 1
-- True

-- | Options to influence the layout algorithms.
newtype LayoutOptions = LayoutOptions { LayoutOptions -> PageWidth
layoutPageWidth :: PageWidth }
    deriving (LayoutOptions -> LayoutOptions -> Bool
(LayoutOptions -> LayoutOptions -> Bool)
-> (LayoutOptions -> LayoutOptions -> Bool) -> Eq LayoutOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutOptions -> LayoutOptions -> Bool
$c/= :: LayoutOptions -> LayoutOptions -> Bool
== :: LayoutOptions -> LayoutOptions -> Bool
$c== :: LayoutOptions -> LayoutOptions -> Bool
Eq, Eq LayoutOptions
Eq LayoutOptions =>
(LayoutOptions -> LayoutOptions -> Ordering)
-> (LayoutOptions -> LayoutOptions -> Bool)
-> (LayoutOptions -> LayoutOptions -> Bool)
-> (LayoutOptions -> LayoutOptions -> Bool)
-> (LayoutOptions -> LayoutOptions -> Bool)
-> (LayoutOptions -> LayoutOptions -> LayoutOptions)
-> (LayoutOptions -> LayoutOptions -> LayoutOptions)
-> Ord LayoutOptions
LayoutOptions -> LayoutOptions -> Bool
LayoutOptions -> LayoutOptions -> Ordering
LayoutOptions -> LayoutOptions -> LayoutOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LayoutOptions -> LayoutOptions -> LayoutOptions
$cmin :: LayoutOptions -> LayoutOptions -> LayoutOptions
max :: LayoutOptions -> LayoutOptions -> LayoutOptions
$cmax :: LayoutOptions -> LayoutOptions -> LayoutOptions
>= :: LayoutOptions -> LayoutOptions -> Bool
$c>= :: LayoutOptions -> LayoutOptions -> Bool
> :: LayoutOptions -> LayoutOptions -> Bool
$c> :: LayoutOptions -> LayoutOptions -> Bool
<= :: LayoutOptions -> LayoutOptions -> Bool
$c<= :: LayoutOptions -> LayoutOptions -> Bool
< :: LayoutOptions -> LayoutOptions -> Bool
$c< :: LayoutOptions -> LayoutOptions -> Bool
compare :: LayoutOptions -> LayoutOptions -> Ordering
$ccompare :: LayoutOptions -> LayoutOptions -> Ordering
$cp1Ord :: Eq LayoutOptions
Ord, Int -> LayoutOptions -> ShowS
[LayoutOptions] -> ShowS
LayoutOptions -> String
(Int -> LayoutOptions -> ShowS)
-> (LayoutOptions -> String)
-> ([LayoutOptions] -> ShowS)
-> Show LayoutOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutOptions] -> ShowS
$cshowList :: [LayoutOptions] -> ShowS
show :: LayoutOptions -> String
$cshow :: LayoutOptions -> String
showsPrec :: Int -> LayoutOptions -> ShowS
$cshowsPrec :: Int -> LayoutOptions -> ShowS
Show, Typeable)

-- | The default layout options, suitable when you just want some output, and
-- don’t particularly care about the details. Used by the 'Show' instance, for
-- example.
--
-- >>> defaultLayoutOptions
-- LayoutOptions {layoutPageWidth = AvailablePerLine 80 1.0}
defaultLayoutOptions :: LayoutOptions
defaultLayoutOptions :: LayoutOptions
defaultLayoutOptions = LayoutOptions :: PageWidth -> LayoutOptions
LayoutOptions { layoutPageWidth :: PageWidth
layoutPageWidth = PageWidth
defaultPageWidth }

-- | This is the default layout algorithm, and it is used by 'show', 'putDoc'
-- and 'hPutDoc'.
--
-- @'layoutPretty'@ commits to rendering something in a certain way if the next
-- element fits the layout constraints; in other words, it has one
-- 'SimpleDocStream' element lookahead when rendering. Consider using the
-- smarter, but a bit less performant, @'layoutSmart'@ algorithm if the results
-- seem to run off to the right before having lots of line breaks.
layoutPretty
    :: LayoutOptions
    -> Doc ann
    -> SimpleDocStream ann
layoutPretty :: LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty = FittingPredicate ann
-> LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann.
FittingPredicate ann
-> LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutWadlerLeijen
    ((PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool)
-> FittingPredicate ann
forall ann.
(PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool)
-> FittingPredicate ann
FittingPredicate (\_pWidth :: PageWidth
_pWidth _minNestingLevel :: Int
_minNestingLevel maxWidth :: Int
maxWidth sdoc :: SimpleDocStream ann
sdoc -> Int -> SimpleDocStream ann -> Bool
forall ann. Int -> SimpleDocStream ann -> Bool
fits Int
maxWidth SimpleDocStream ann
sdoc))
  where
    fits :: Int -- ^ Width in which to fit the first line
         -> SimpleDocStream ann
         -> Bool
    fits :: Int -> SimpleDocStream ann -> Bool
fits w :: Int
w _ | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0      = Bool
False
    fits _ SFail          = Bool
False
    fits _ SEmpty         = Bool
True
    fits w :: Int
w (SChar _ x :: SimpleDocStream ann
x)    = Int -> SimpleDocStream ann -> Bool
forall ann. Int -> SimpleDocStream ann -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) SimpleDocStream ann
x
    fits w :: Int
w (SText l :: Int
l _t :: Text
_t x :: SimpleDocStream ann
x) = Int -> SimpleDocStream ann -> Bool
forall ann. Int -> SimpleDocStream ann -> Bool
fits (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) SimpleDocStream ann
x
    fits _ SLine{}        = Bool
True
    fits w :: Int
w (SAnnPush _ x :: SimpleDocStream ann
x) = Int -> SimpleDocStream ann -> Bool
forall ann. Int -> SimpleDocStream ann -> Bool
fits Int
w SimpleDocStream ann
x
    fits w :: Int
w (SAnnPop x :: SimpleDocStream ann
x)    = Int -> SimpleDocStream ann -> Bool
forall ann. Int -> SimpleDocStream ann -> Bool
fits Int
w SimpleDocStream ann
x

-- | A layout algorithm with more lookahead than 'layoutPretty', that introduces
-- line breaks earlier if the content does not (or will not, rather) fit into
-- one line.
--
-- Consider the following python-ish document,
--
-- >>> let fun x = hang 2 ("fun(" <> softline' <> x) <> ")"
-- >>> let doc = (fun . fun . fun . fun . fun) (align (list ["abcdef", "ghijklm"]))
--
-- which we’ll be rendering using the following pipeline (where the layout
-- algorithm has been left open),
--
-- >>> import Data.Text.IO as T
-- >>> import Data.Text.Prettyprint.Doc.Render.Text
-- >>> let hr = pipe <> pretty (replicate (26-2) '-') <> pipe
-- >>> let go layouter x = (T.putStrLn . renderStrict . layouter (LayoutOptions (AvailablePerLine 26 1))) (vsep [hr, x, hr])
--
-- If we render this using 'layoutPretty' with a page width of 26 characters
-- per line, all the @fun@ calls fit into the first line so they will be put
-- there,
--
-- >>> go layoutPretty doc
-- |------------------------|
-- fun(fun(fun(fun(fun(
--                   [ abcdef
--                   , ghijklm ])))))
-- |------------------------|
--
-- Note that this exceeds the desired 26 character page width. The same
-- document, rendered with @'layoutSmart'@, fits the layout contstraints:
--
-- >>> go layoutSmart doc
-- |------------------------|
-- fun(
--   fun(
--     fun(
--       fun(
--         fun(
--           [ abcdef
--           , ghijklm ])))))
-- |------------------------|
--
-- The key difference between 'layoutPretty' and 'layoutSmart' is that the
-- latter will check the potential document until it encounters a line with the
-- same indentation or less than the start of the document. Any line encountered
-- earlier is assumed to belong to the same syntactic structure.
-- 'layoutPretty' checks only the first line.
--
-- Consider for example the question of whether the @A@s fit into the document
-- below:
--
-- > 1 A
-- > 2   A
-- > 3  A
-- > 4 B
-- > 5   B
--
-- 'layoutPretty' will check only line 1, ignoring whether e.g. line 2 might
-- already be too wide.
-- By contrast, 'layoutSmart' stops only once it reaches line 4, where the @B@
-- has the same indentation as the first @A@.
layoutSmart
    :: LayoutOptions
    -> Doc ann
    -> SimpleDocStream ann
layoutSmart :: LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart = FittingPredicate ann
-> LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann.
FittingPredicate ann
-> LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutWadlerLeijen ((PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool)
-> FittingPredicate ann
forall ann.
(PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool)
-> FittingPredicate ann
FittingPredicate PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
forall ann. PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits)
  where
    -- Why doesn't layoutSmart simply check the entire document?
    --
    -- 1. That would be very expensive.
    -- 2. In that case the layout of a particular part of a document would
    --    depend on the fit of completely unrelated parts of the same document.
    --    See https://github.com/quchen/prettyprinter/issues/83 for a related
    --    bug.
    fits :: PageWidth
         -> Int -- ^ Minimum nesting level to fit in
         -> Int -- ^ Width in which to fit the first line
         -> SimpleDocStream ann
         -> Bool
    fits :: PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits _ _ w :: Int
w _ | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0                    = Bool
False
    fits _ _ _ SFail                        = Bool
False
    fits _ _ _ SEmpty                       = Bool
True
    fits pw :: PageWidth
pw m :: Int
m w :: Int
w (SChar _ x :: SimpleDocStream ann
x)                 = PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
forall ann. PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits PageWidth
pw Int
m (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) SimpleDocStream ann
x
    fits pw :: PageWidth
pw m :: Int
m w :: Int
w (SText l :: Int
l _t :: Text
_t x :: SimpleDocStream ann
x)              = PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
forall ann. PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits PageWidth
pw Int
m (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) SimpleDocStream ann
x
    fits pw :: PageWidth
pw m :: Int
m _ (SLine i :: Int
i x :: SimpleDocStream ann
x)
      | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i, AvailablePerLine cpl :: Int
cpl _ <- PageWidth
pw = PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
forall ann. PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits PageWidth
pw Int
m (Int
cpl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) SimpleDocStream ann
x
      | Bool
otherwise                           = Bool
True
    fits pw :: PageWidth
pw m :: Int
m w :: Int
w (SAnnPush _ x :: SimpleDocStream ann
x)              = PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
forall ann. PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits PageWidth
pw Int
m Int
w SimpleDocStream ann
x
    fits pw :: PageWidth
pw m :: Int
m w :: Int
w (SAnnPop x :: SimpleDocStream ann
x)                 = PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
forall ann. PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits PageWidth
pw Int
m Int
w SimpleDocStream ann
x

-- | The Wadler/Leijen layout algorithm
layoutWadlerLeijen
    :: forall ann. FittingPredicate ann
    -> LayoutOptions
    -> Doc ann
    -> SimpleDocStream ann
layoutWadlerLeijen :: FittingPredicate ann
-> LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutWadlerLeijen
    (FittingPredicate fits :: PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits)
    LayoutOptions { layoutPageWidth :: LayoutOptions -> PageWidth
layoutPageWidth = PageWidth
pWidth }
    doc :: Doc ann
doc
  = Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best 0 0 (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons 0 Doc ann
doc LayoutPipeline ann
forall ann. LayoutPipeline ann
Nil)
  where

    -- * current column >= current nesting level
    -- * current column - current indentaion = number of chars inserted in line
    best
        :: Int -- Current nesting level
        -> Int -- Current column, i.e. "where the cursor is"
        -> LayoutPipeline ann -- Documents remaining to be handled (in order)
        -> SimpleDocStream ann
    best :: Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best !Int
_ !Int
_ Nil           = SimpleDocStream ann
forall ann. SimpleDocStream ann
SEmpty
    best nl :: Int
nl cc :: Int
cc (UndoAnn ds :: LayoutPipeline ann
ds)  = SimpleDocStream ann -> SimpleDocStream ann
forall ann. SimpleDocStream ann -> SimpleDocStream ann
SAnnPop (Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc LayoutPipeline ann
ds)
    best nl :: Int
nl cc :: Int
cc (Cons i :: Int
i d :: Doc ann
d ds :: LayoutPipeline ann
ds) = case Doc ann
d of
        Fail            -> SimpleDocStream ann
forall ann. SimpleDocStream ann
SFail
        Empty           -> Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc LayoutPipeline ann
ds
        Char c :: Char
c          -> let !cc' :: Int
cc' = Int
ccInt -> Int -> Int
forall a. Num a => a -> a -> a
+1 in Char -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c (Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc' LayoutPipeline ann
ds)
        Text l :: Int
l t :: Text
t        -> let !cc' :: Int
cc' = Int
ccInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l in Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
l Text
t (Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc' LayoutPipeline ann
ds)
        Line            -> Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine Int
i (Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
i Int
i LayoutPipeline ann
ds)
        FlatAlt x :: Doc ann
x _     -> Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i Doc ann
x LayoutPipeline ann
ds)
        Cat x :: Doc ann
x y :: Doc ann
y         -> Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i Doc ann
x (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i Doc ann
y LayoutPipeline ann
ds))
        Nest j :: Int
j x :: Doc ann
x        -> let !ij :: Int
ij = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j in Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
ij Doc ann
x LayoutPipeline ann
ds)
        Union x :: Doc ann
x y :: Doc ann
y       -> let x' :: SimpleDocStream ann
x' = Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i Doc ann
x LayoutPipeline ann
ds)
                               y' :: SimpleDocStream ann
y' = Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i Doc ann
y LayoutPipeline ann
ds)
                           in Int
-> Int
-> SimpleDocStream ann
-> SimpleDocStream ann
-> SimpleDocStream ann
selectNicer Int
nl Int
cc SimpleDocStream ann
x' SimpleDocStream ann
y'
        Column f :: Int -> Doc ann
f        -> Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i (Int -> Doc ann
f Int
cc) LayoutPipeline ann
ds)
        WithPageWidth f :: PageWidth -> Doc ann
f -> Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i (PageWidth -> Doc ann
f PageWidth
pWidth) LayoutPipeline ann
ds)
        Nesting f :: Int -> Doc ann
f       -> Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i (Int -> Doc ann
f Int
i) LayoutPipeline ann
ds)
        Annotated ann :: ann
ann x :: Doc ann
x -> ann -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. ann -> SimpleDocStream ann -> SimpleDocStream ann
SAnnPush ann
ann (Int -> Int -> LayoutPipeline ann -> SimpleDocStream ann
best Int
nl Int
cc (Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
forall ann.
Int -> Doc ann -> LayoutPipeline ann -> LayoutPipeline ann
Cons Int
i Doc ann
x (LayoutPipeline ann -> LayoutPipeline ann
forall ann. LayoutPipeline ann -> LayoutPipeline ann
UndoAnn LayoutPipeline ann
ds)))

    -- Select the better fitting of two documents:
    -- Choice A if it fits, otherwise choice B.
    --
    -- The fit of choice B is /not/ checked! It is ultimately the user's
    -- responsibility to provide an alternative that can fit the page even when
    -- choice A doesn't.
    selectNicer
        :: Int           -- ^ Current nesting level
        -> Int           -- ^ Current column
        -> SimpleDocStream ann -- ^ Choice A.
        -> SimpleDocStream ann -- ^ Choice B. Should fit more easily
                               --   (== be less wide) than choice A.
        -> SimpleDocStream ann -- ^ Choice A if it fits, otherwise B.
    selectNicer :: Int
-> Int
-> SimpleDocStream ann
-> SimpleDocStream ann
-> SimpleDocStream ann
selectNicer lineIndent :: Int
lineIndent currentColumn :: Int
currentColumn x :: SimpleDocStream ann
x y :: SimpleDocStream ann
y = case PageWidth
pWidth of
        AvailablePerLine lineLength :: Int
lineLength ribbonFraction :: Double
ribbonFraction
          | PageWidth -> Int -> Int -> SimpleDocStream ann -> Bool
fits PageWidth
pWidth Int
minNestingLevel Int
availableWidth SimpleDocStream ann
x -> SimpleDocStream ann
x
          where
            minNestingLevel :: Int
minNestingLevel =
                -- See the Note
                -- [Choosing the right minNestingLevel for consistent smart layouts]
                case SimpleDocStream ann -> Maybe Int
initialIndentation SimpleDocStream ann
y of
                    Just i :: Int
i ->
                        -- y could be a (less wide) hanging layout. If so, let's
                        -- check x a bit more thoroughly so we don't miss a potentially
                        -- better fitting y.
                        Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i Int
currentColumn
                    Nothing ->
                        -- y definitely isn't a hanging layout. Let's check x with the
                        -- same minNestingLevel that any subsequent lines with the same
                        -- indentation use.
                        Int
currentColumn
            availableWidth :: Int
availableWidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
columnsLeftInLine Int
columnsLeftInRibbon
              where
                columnsLeftInLine :: Int
columnsLeftInLine = Int
lineLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentColumn
                columnsLeftInRibbon :: Int
columnsLeftInRibbon = Int
lineIndent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ribbonWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentColumn
                ribbonWidth :: Int
ribbonWidth =
                    (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
lineLength (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round)
                        (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineLength Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ribbonFraction)
        Unbounded
          -- See the Note [Detecting failure with Unbounded page width].
          | Bool -> Bool
not (SimpleDocStream ann -> Bool
failsOnFirstLine SimpleDocStream ann
x) -> SimpleDocStream ann
x
        _ -> SimpleDocStream ann
y

    initialIndentation :: SimpleDocStream ann -> Maybe Int
    initialIndentation :: SimpleDocStream ann -> Maybe Int
initialIndentation sds :: SimpleDocStream ann
sds = case SimpleDocStream ann
sds of
        SLine i :: Int
i _    -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        SAnnPush _ s :: SimpleDocStream ann
s -> SimpleDocStream ann -> Maybe Int
initialIndentation SimpleDocStream ann
s
        SAnnPop s :: SimpleDocStream ann
s    -> SimpleDocStream ann -> Maybe Int
initialIndentation SimpleDocStream ann
s
        _            -> Maybe Int
forall a. Maybe a
Nothing

    failsOnFirstLine :: SimpleDocStream ann -> Bool
    failsOnFirstLine :: SimpleDocStream ann -> Bool
failsOnFirstLine = SimpleDocStream ann -> Bool
forall a. SimpleDocStream a -> Bool
go
      where
        go :: SimpleDocStream ann -> Bool
go sds :: SimpleDocStream ann
sds = case SimpleDocStream ann
sds of
            SFail        -> Bool
True
            SEmpty       -> Bool
False
            SChar _ s :: SimpleDocStream ann
s    -> SimpleDocStream ann -> Bool
go SimpleDocStream ann
s
            SText _ _ s :: SimpleDocStream ann
s  -> SimpleDocStream ann -> Bool
go SimpleDocStream ann
s
            SLine _ _    -> Bool
False
            SAnnPush _ s :: SimpleDocStream ann
s -> SimpleDocStream ann -> Bool
go SimpleDocStream ann
s
            SAnnPop s :: SimpleDocStream ann
s    -> SimpleDocStream ann -> Bool
go SimpleDocStream ann
s


{- Note [Choosing the right minNestingLevel for consistent smart layouts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this document:

    doc =
            "Groceries: "
        <>  align
                (cat
                    [ sep ["pommes", "de", "terre"]
                    , "apples"
                    , "Donaudampfschifffahrtskapitänskajütenmülleimer"
                    ]
                )

... and assume we want to fit it into 40 columns as nicely as possible:

    opts = LayoutOptions (AvailablePerLine 40 1)

We already have bad luck with the last item – it's longer than 40 characters
on its own!

We'd still like the first item, pommes de terre, to be laid out nicely, that is,
on one line, since it's not too wide. This is what we'd like to see:

    Groceries: pommes de terre
               apples
               Donaudampfschifffahrtskapitänskajütenmülleimer

Before #83 was fixed, that wasn't what we got! Instead we got this:

> renderIO stdout $ layoutSmart opts doc
Groceries: pommes
           de
           terre
           apples
           Donaudampfschifffahrtskapitänskajütenmülleimer

Why?

minNestingLevel was effectively defined as

    minNestingLevel = lineIndent

The lineIndent for "pommes de terre" is 0.

The FittingPredicate for layoutSmart will continue to check the rest of the
document until it finds a line where the indentation <= minNestingLevel.
In this case this meant that layoutSmart would traverse all the items,
and note that the last item, Donaudampfschifffahrtskapitänskajütenmülleimer,
doesn't fit into the available space! The "flatter" version of the document
has failed, so "pommes de terre" gets spread over several lines!

Obviously this would be an inconsistency with the layout of the other items.
Their lineIndent is 11 each, so for them, the FittingPredicate stops already
on the next line.

The obvious solution is to change the definition of minNestingLevel:

    minNestingLevel = currentColumn

This however breaks the "python-ish" document from the documentation for
layoutSmart:

    expected: |------------------------|
              fun(
                fun(
                  fun(
                    fun(
                      fun(
                        [ abcdef
                        , ghijklm ])))))
              |------------------------|

     but got: |------------------------|
              fun(
                fun(
                  fun(
                    fun(
                      fun([ abcdef
                          , ghijklm ])))))
              |------------------------|

We now accept the worse layout because the problematic last line has
the same indentation as the current column of "[ abcdef", so we don't check it!

The solution we went with in the end is a bit of a hack:

We check whether the alternative, "high" layout is a (potentially less wide)
hanging layout, and in that case pick its indentation as the minNestingLevel.

This way we achieve the optimal layout in both scenarios.

See https://github.com/quchen/prettyprinter/issues/83 for the bug that lead
to the current solution.


Note [Detecting failure with Unbounded page width]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To understand why it is sufficient to check the first line of the
SimpleDocStream, trace how an SFail ends up there:

1. We group a Doc containing a Line, producing a (Union x y) where
   x contains Fail.

2. In best, any Unions are handled recursively, rejecting any
   alternatives that would result in SFail.

So once a SimpleDocStream reaches selectNicer, any SFail in it must
appear before the first linebreak – any other SFail would have been
detected and rejected in a previous iteration.
-}



-- | @(layoutCompact x)@ lays out the document @x@ without adding any
-- indentation. Since no \'pretty\' printing is involved, this layouter is very
-- fast. The resulting output contains fewer characters than a prettyprinted
-- version and can be used for output that is read by other programs.
--
-- >>> let doc = hang 4 (vsep ["lorem", "ipsum", hang 4 (vsep ["dolor", "sit"])])
-- >>> doc
-- lorem
--     ipsum
--     dolor
--         sit
--
-- >>> let putDocCompact = renderIO System.IO.stdout . layoutCompact
-- >>> putDocCompact doc
-- lorem
-- ipsum
-- dolor
-- sit
layoutCompact :: Doc ann -> SimpleDocStream ann
layoutCompact :: Doc ann -> SimpleDocStream ann
layoutCompact doc :: Doc ann
doc = Int -> [Doc ann] -> SimpleDocStream ann
forall ann ann. Int -> [Doc ann] -> SimpleDocStream ann
scan 0 [Doc ann
doc]
  where
    scan :: Int -> [Doc ann] -> SimpleDocStream ann
scan _ [] = SimpleDocStream ann
forall ann. SimpleDocStream ann
SEmpty
    scan !Int
col (d :: Doc ann
d:ds :: [Doc ann]
ds) = case Doc ann
d of
        Fail            -> SimpleDocStream ann
forall ann. SimpleDocStream ann
SFail
        Empty           -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col [Doc ann]
ds
        Char c :: Char
c          -> Char -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c (Int -> [Doc ann] -> SimpleDocStream ann
scan (Int
colInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Doc ann]
ds)
        Text l :: Int
l t :: Text
t        -> let !col' :: Int
col' = Int
colInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l in Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
l Text
t (Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col' [Doc ann]
ds)
        FlatAlt x :: Doc ann
x _     -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        Line            -> Int -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Int -> SimpleDocStream ann -> SimpleDocStream ann
SLine 0 (Int -> [Doc ann] -> SimpleDocStream ann
scan 0 [Doc ann]
ds)
        Cat x :: Doc ann
x y :: Doc ann
y         -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:Doc ann
yDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        Nest _ x :: Doc ann
x        -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        Union _ y :: Doc ann
y       -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
yDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        Column f :: Int -> Doc ann
f        -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Int -> Doc ann
f Int
colDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        WithPageWidth f :: PageWidth -> Doc ann
f -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (PageWidth -> Doc ann
f PageWidth
Unbounded Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
ds)
        Nesting f :: Int -> Doc ann
f       -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Int -> Doc ann
f 0 Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
ds)
        Annotated _ x :: Doc ann
x   -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)

-- | @('show' doc)@ prettyprints document @doc@ with 'defaultLayoutOptions',
-- ignoring all annotations.
instance Show (Doc ann) where
    showsPrec :: Int -> Doc ann -> ShowS
showsPrec _ doc :: Doc ann
doc = SimpleDocStream ann -> ShowS
forall ann. SimpleDocStream ann -> ShowS
renderShowS (LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions Doc ann
doc)

-- | Render a 'SimpleDocStream' to a 'ShowS', useful to write 'Show' instances
-- based on the prettyprinter.
--
-- @
-- instance 'Show' MyType where
--     'showsPrec' _ = 'renderShowS' . 'layoutPretty' 'defaultLayoutOptions' . 'pretty'
-- @
renderShowS :: SimpleDocStream ann -> ShowS
renderShowS :: SimpleDocStream ann -> ShowS
renderShowS = \sds :: SimpleDocStream ann
sds -> case SimpleDocStream ann
sds of
    SFail        -> ShowS
forall void. void
panicUncaughtFail
    SEmpty       -> ShowS
forall a. a -> a
id
    SChar c :: Char
c x :: SimpleDocStream ann
x    -> Char -> ShowS
showChar Char
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> ShowS
forall ann. SimpleDocStream ann -> ShowS
renderShowS SimpleDocStream ann
x
    SText _l :: Int
_l t :: Text
t x :: SimpleDocStream ann
x -> String -> ShowS
showString (Text -> String
T.unpack Text
t) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> ShowS
forall ann. SimpleDocStream ann -> ShowS
renderShowS SimpleDocStream ann
x
    SLine i :: Int
i x :: SimpleDocStream ann
x    -> String -> ShowS
showString ('\n' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i ' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> ShowS
forall ann. SimpleDocStream ann -> ShowS
renderShowS SimpleDocStream ann
x
    SAnnPush _ x :: SimpleDocStream ann
x -> SimpleDocStream ann -> ShowS
forall ann. SimpleDocStream ann -> ShowS
renderShowS SimpleDocStream ann
x
    SAnnPop x :: SimpleDocStream ann
x    -> SimpleDocStream ann -> ShowS
forall ann. SimpleDocStream ann -> ShowS
renderShowS SimpleDocStream ann
x


-- | A utility for producing indentation etc.
--
-- >>> textSpaces 3
-- "   "
--
-- This produces much better Core than the equivalent
--
-- > T.replicate n " "
--
-- (See <https://github.com/quchen/prettyprinter/issues/131>.)
textSpaces :: Int -> Text
textSpaces :: Int -> Text
textSpaces n :: Int
n = Int -> Text -> Text
T.replicate Int
n (Char -> Text
T.singleton ' ')


-- $setup
--
-- (Definitions for the doctests)
--
-- >>> :set -XOverloadedStrings
-- >>> import Data.Text.Prettyprint.Doc.Render.Text
-- >>> import Data.Text.Prettyprint.Doc.Symbols.Ascii
-- >>> import Data.Text.Prettyprint.Doc.Util as Util
-- >>> import Test.QuickCheck.Modifiers