    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE OverloadedStrings #-}

    #include "version-compatibility-macros.h"

    -- | This module shows how to write a custom prettyprinter backend, based on a
    -- tree representation of a 'SimpleDocStream'.  For a stack machine approach, which
    -- may be more suitable for certain output formats, see
    -- "Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial".
    --
    -- Rendering to HTML, particularly using libraries such as blaze-html or lucid,
    -- is one important use case of tree-based rendering.
    --
    -- The module is written to be readable top-to-bottom in both Haddock and raw
    -- source form.
    module Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial where

    import qualified Data.Text.Lazy         as TL
    import qualified Data.Text.Lazy.Builder as TLB

    import Data.Text.Prettyprint.Doc
    import Data.Text.Prettyprint.Doc.Internal
    import Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree

    #if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)
    import Data.Foldable (foldMap)
    #endif
    #if !(SEMIGROUP_MONOID_SUPERCLASS)
    import Data.Semigroup
    #endif

    -- * The type of available markup
    --
    -- $standalone-text
    --
    -- First, we define a set of valid annotations must be defined, with the goal of
    -- defining a @'Doc' 'SimpleHtml'@. We will later define how to convert this to
    -- the output format ('TL.Text').

    data SimpleHtml = Bold | Italics | Color Color | Paragraph | Headline
    data Color = Red | Green | Blue

    -- ** Convenience definitions

    bold, italics, paragraph, headline :: Doc SimpleHtml -> Doc SimpleHtml
    bold :: Doc SimpleHtml -> Doc SimpleHtml
    bold = SimpleHtml -> Doc SimpleHtml -> Doc SimpleHtml
    forall ann. ann -> Doc ann -> Doc ann
    annotate SimpleHtml
    Bold
    italics :: Doc SimpleHtml -> Doc SimpleHtml
    italics = SimpleHtml -> Doc SimpleHtml -> Doc SimpleHtml
    forall ann. ann -> Doc ann -> Doc ann
    annotate SimpleHtml
    Italics
    paragraph :: Doc SimpleHtml -> Doc SimpleHtml
    paragraph = SimpleHtml -> Doc SimpleHtml -> Doc SimpleHtml
    forall ann. ann -> Doc ann -> Doc ann
    annotate SimpleHtml
    Paragraph
    headline :: Doc SimpleHtml -> Doc SimpleHtml
    headline = SimpleHtml -> Doc SimpleHtml -> Doc SimpleHtml
    forall ann. ann -> Doc ann -> Doc ann
    annotate SimpleHtml
    Headline

    color :: Color -> Doc SimpleHtml -> Doc SimpleHtml
    color :: Color -> Doc SimpleHtml -> Doc SimpleHtml
    color c :: Color
    c = SimpleHtml -> Doc SimpleHtml -> Doc SimpleHtml
    forall ann. ann -> Doc ann -> Doc ann
    annotate (Color -> SimpleHtml
    Color Color
    c)

    -- * The rendering algorithm
    --
    -- $standalone-text
    --
    -- With the annotation definitions out of the way, we can now define a
    -- conversion function from 'SimpleDocStream' (annotated with our 'SimpleHtml')
    -- to the tree-shaped 'SimpleDocTree', which is easily convertible to a
    -- HTML/'Text' representation.
    --
    -- There are two ways to render this; the simpler one is just using
    -- 'renderSimplyDecorated'. However, some output formats require more
    -- complicated functionality, so we explore this explicitly with a simple
    -- example below. An example for something more complicated is e.g. an XHTML
    -- renderer, where a newline may not simply be a newline character followed by a
    -- certain number of spaces, but e.g. involve adding a @<br/>@ tag.

    -- | To render the HTML, we first convert the 'SimpleDocStream' to the
    -- 'SimpleDocTree' format, which makes enveloping sub-documents in markup
    -- easier.
    --
    -- This function is the entry main API function of the renderer; as such, it is
    -- only glue for the internal functions. This is similar to
    -- 'Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial.render' from
    -- the stack machine tutorial in its purpose.
    render :: SimpleDocStream SimpleHtml -> TL.Text
    render :: SimpleDocStream SimpleHtml -> Text
    render = Builder -> Text
    TLB.toLazyText (Builder -> Text)
    -> (SimpleDocStream SimpleHtml -> Builder)
    -> SimpleDocStream SimpleHtml
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SimpleDocTree SimpleHtml -> Builder
    renderTree (SimpleDocTree SimpleHtml -> Builder)
    -> (SimpleDocStream SimpleHtml -> SimpleDocTree SimpleHtml)
    -> SimpleDocStream SimpleHtml
    -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SimpleDocStream SimpleHtml -> SimpleDocTree SimpleHtml
    forall ann. SimpleDocStream ann -> SimpleDocTree ann
    treeForm

    -- | Render a 'SimpleDocTree' to a 'TLB.Builder'; this is the workhorse of the
    -- tree-based rendering approach, and equivalent to
    -- 'Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial.renderStackMachine'
    -- in the stack machine rendering tutorial.
    renderTree :: SimpleDocTree SimpleHtml -> TLB.Builder
    renderTree :: SimpleDocTree SimpleHtml -> Builder
    renderTree sds :: SimpleDocTree SimpleHtml
    sds = case SimpleDocTree SimpleHtml
    sds of
        STEmpty -> Builder
    forall a. Monoid a => a
    mempty
        STChar c :: Char
    c -> Char -> Builder
    TLB.singleton Char
    c
        STText _ t :: Text
    t -> Text -> Builder
    TLB.fromText Text
    t
        STLine i :: Int
    i -> "\n" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    TLB.fromText (Int -> Text
    textSpaces Int
    i)
        STAnn ann :: SimpleHtml
    ann content :: SimpleDocTree SimpleHtml
    content -> SimpleHtml -> Builder -> Builder
    encloseInTagFor SimpleHtml
    ann (SimpleDocTree SimpleHtml -> Builder
    renderTree SimpleDocTree SimpleHtml
    content)
        STConcat contents :: [SimpleDocTree SimpleHtml]
    contents -> (SimpleDocTree SimpleHtml -> Builder)
    -> [SimpleDocTree SimpleHtml] -> Builder
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap SimpleDocTree SimpleHtml -> Builder
    renderTree [SimpleDocTree SimpleHtml]
    contents

    -- | Convert a 'SimpleHtml' to a function that encloses a 'TLB.Builder' in HTML
    -- tags. This is where the translation of style to raw output happens.
    encloseInTagFor :: SimpleHtml -> TLB.Builder -> TLB.Builder
    encloseInTagFor :: SimpleHtml -> Builder -> Builder
    encloseInTagFor sh :: SimpleHtml
    sh = case SimpleHtml
    sh of
        Bold      -> \x :: Builder
    x -> "<strong>" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> "</strong>"
        Italics   -> \x :: Builder
    x -> "<em>" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> "</em>"
        Color c :: Color
    c   -> \x :: Builder
    x -> "<span style=\"color: " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Color -> Builder
    hexCode Color
    c Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> "\">" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> "</span>"
        Paragraph -> \x :: Builder
    x -> "<p>" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> "</p>"
        Headline  -> \x :: Builder
    x -> "<h1>" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> "</h1>"
      where
        hexCode :: Color -> TLB.Builder
        hexCode :: Color -> Builder
    hexCode c :: Color
    c = case Color
    c of
            Red   -> "#f00"
            Green -> "#0f0"
            Blue  -> "#00f"

    -- * Example invocation
    --
    -- $standalone-text
    --
    -- We can now render an example document using our definitions:
    --
    -- >>> :set -XOverloadedStrings
    -- >>> import qualified Data.Text.Lazy.IO as TL
    -- >>> :{
    -- >>> let go = TL.putStrLn . render . layoutPretty defaultLayoutOptions
    -- >>> in go (vsep
    -- >>>     [ headline "Example document"
    -- >>>     , paragraph ("This is a" <+> color Red "paragraph" <> comma)
    -- >>>     , paragraph ("and" <+> bold "this text is bold.")
    -- >>>     ])
    -- >>> :}
    -- <h1>Example document</h1>
    -- <p>This is a <span style="color: #f00">paragraph</span>,</p>
    -- <p>and <strong>this text is bold.</strong></p>