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

    {-# OPTIONS_GHC -fno-warn-deprecations #-}

    #include "version-compatibility-macros.h"

    -- | This module shows how to write a custom prettyprinter backend, based on
    -- directly converting a 'SimpleDocStream' to an output format using a stack
    -- machine. For a tree serialization approach, which may be more suitable for
    -- certain output formats, see
    -- "Prettyprinter.Render.Tutorials.TreeRenderingTutorial".
    --
    -- Rendering to ANSI terminal with colors is an important use case for stack
    -- machine based rendering.
    --
    -- The module is written to be readable top-to-bottom in both Haddock and raw
    -- source form.
    module Prettyprinter.Render.Tutorials.StackMachineTutorial
        {-# DEPRECATED "Writing your own stack machine is probably more efficient and customizable; also consider using »renderSimplyDecorated(A)« instead" #-}
        where

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

    import Prettyprinter
    import Prettyprinter.Internal
    import Prettyprinter.Render.Util.Panic
    import Prettyprinter.Render.Util.StackMachine

    #if !(APPLICATIVE_MONAD)
    import Control.Applicative
    #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 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
    -- final 'TL.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 ANSI terminal
    -- rendering, where on popping we need to regenerate the previous style,
    -- requiring a pop (discard current style) followed by a peek (regenerate
    -- previous style).

    -- | The 'StackMachine' type defines a stack machine suitable for many rendering
    -- needs. It has two auxiliary parameters: the type of the end result, and the
    -- type of the document’s annotations.
    --
    -- Most 'StackMachine' creations will look like this definition: a recursive
    -- walk through the 'SimpleDocStream', pushing styles on the stack and popping
    -- them off again, and writing raw output.
    --
    -- The equivalent to this in the tree based rendering approach is
    -- 'Prettyprinter.Render.Tutorials.TreeRenderingTutorial.renderTree'.
    renderStackMachine :: SimpleDocStream SimpleHtml -> StackMachine TLB.Builder SimpleHtml ()
    renderStackMachine :: SimpleDocStream SimpleHtml -> StackMachine Builder SimpleHtml ()
    renderStackMachine = \SimpleDocStream SimpleHtml
    sds -> case SimpleDocStream SimpleHtml
    sds of
        SimpleDocStream SimpleHtml
    SFail -> StackMachine Builder SimpleHtml ()
    forall void. void
    panicUncaughtFail
        SimpleDocStream SimpleHtml
    SEmpty -> () -> StackMachine Builder SimpleHtml ()
    forall a. a -> StackMachine Builder SimpleHtml a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        SChar Char
    c SimpleDocStream SimpleHtml
    x -> do
            Builder -> StackMachine Builder SimpleHtml ()
    forall output style. output -> StackMachine output style ()
    writeOutput (Char -> Builder
    TLB.singleton Char
    c)
            SimpleDocStream SimpleHtml -> StackMachine Builder SimpleHtml ()
    renderStackMachine SimpleDocStream SimpleHtml
    x
        SText Int
    _l Text
    t SimpleDocStream SimpleHtml
    x -> do
            Builder -> StackMachine Builder SimpleHtml ()
    forall output style. output -> StackMachine output style ()
    writeOutput (Text -> Builder
    TLB.fromText Text
    t)
            SimpleDocStream SimpleHtml -> StackMachine Builder SimpleHtml ()
    renderStackMachine SimpleDocStream SimpleHtml
    x
        SLine Int
    i SimpleDocStream SimpleHtml
    x -> do
            Builder -> StackMachine Builder SimpleHtml ()
    forall output style. output -> StackMachine output style ()
    writeOutput (Char -> Builder
    TLB.singleton Char
    '\n')
            Builder -> StackMachine Builder SimpleHtml ()
    forall output style. output -> StackMachine output style ()
    writeOutput (Text -> Builder
    TLB.fromText (Int -> Text
    textSpaces Int
    i))
            SimpleDocStream SimpleHtml -> StackMachine Builder SimpleHtml ()
    renderStackMachine SimpleDocStream SimpleHtml
    x
        SAnnPush SimpleHtml
    s SimpleDocStream SimpleHtml
    x -> do
            SimpleHtml -> StackMachine Builder SimpleHtml ()
    forall output style.
    Monoid output =>
    style -> StackMachine output style ()
    pushStyle SimpleHtml
    s
            Builder -> StackMachine Builder SimpleHtml ()
    forall output style. output -> StackMachine output style ()
    writeOutput ((Builder, Builder) -> Builder
    forall a b. (a, b) -> a
    fst (SimpleHtml -> (Builder, Builder)
    htmlTag SimpleHtml
    s))
            SimpleDocStream SimpleHtml -> StackMachine Builder SimpleHtml ()
    renderStackMachine SimpleDocStream SimpleHtml
    x
        SAnnPop SimpleDocStream SimpleHtml
    x -> do
            SimpleHtml
    s <- StackMachine Builder SimpleHtml SimpleHtml
    forall output style.
    Monoid output =>
    StackMachine output style style
    unsafePopStyle
            Builder -> StackMachine Builder SimpleHtml ()
    forall output style. output -> StackMachine output style ()
    writeOutput ((Builder, Builder) -> Builder
    forall a b. (a, b) -> b
    snd (SimpleHtml -> (Builder, Builder)
    htmlTag SimpleHtml
    s))
            SimpleDocStream SimpleHtml -> StackMachine Builder SimpleHtml ()
    renderStackMachine SimpleDocStream SimpleHtml
    x

    -- | Convert a 'SimpleHtml' annotation to a pair of opening and closing tags.
    -- This is where the translation of style to raw output happens.
    htmlTag :: SimpleHtml -> (TLB.Builder, TLB.Builder)
    htmlTag :: SimpleHtml -> (Builder, Builder)
    htmlTag = \SimpleHtml
    sh -> case SimpleHtml
    sh of
        SimpleHtml
    Bold      -> (Builder
    "<strong>", Builder
    "</strong>")
        SimpleHtml
    Italics   -> (Builder
    "<em>", Builder
    "</em>")
        Color Color
    c   -> (Builder
    "<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
    "</span>")
        SimpleHtml
    Paragraph -> (Builder
    "<p>", Builder
    "</p>")
        SimpleHtml
    Headline  -> (Builder
    "<h1>", Builder
    "</h1>")
      where
        hexCode :: Color -> TLB.Builder
        hexCode :: Color -> Builder
    hexCode = \Color
    c -> case Color
    c of
            Color
    Red   -> Builder
    "#f00"
            Color
    Green -> Builder
    "#0f0"
            Color
    Blue  -> Builder
    "#00f"

    -- | We can now wrap our stack machine definition from 'renderStackMachine' in a
    -- nicer interface; on successful conversion, we run the builder to give us the
    -- final 'TL.Text', and before we do that we check that the style stack is empty
    -- (i.e. there are no unmatched style applications) after the machine is run.
    --
    -- This function does only a bit of plumbing around 'renderStackMachine', and is
    -- the main API function of a stack machine renderer. The tree renderer
    -- equivalent to this is
    -- 'Prettyprinter.Render.Tutorials.TreeRenderingTutorial.render'.
    render :: SimpleDocStream SimpleHtml -> TL.Text
    render :: SimpleDocStream SimpleHtml -> Text
    render SimpleDocStream SimpleHtml
    doc
      = let (Builder
    resultBuilder, [SimpleHtml]
    remainingStyles) = [SimpleHtml]
    -> StackMachine Builder SimpleHtml () -> (Builder, [SimpleHtml])
    forall styles output a.
    [styles] -> StackMachine output styles a -> (output, [styles])
    execStackMachine [] (SimpleDocStream SimpleHtml -> StackMachine Builder SimpleHtml ()
    renderStackMachine SimpleDocStream SimpleHtml
    doc)
        in if [SimpleHtml] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SimpleHtml]
    remainingStyles
            then Builder -> Text
    TLB.toLazyText Builder
    resultBuilder
            else [Char] -> Text
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "There are "
                        [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([SimpleHtml] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SimpleHtml]
    remainingStyles)
                        [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    " unpaired styles! Please report this as a bug.")

    -- * 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>