{-# 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
-- "Prettyprinter.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 Prettyprinter.Render.Tutorials.TreeRenderingTutorial 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.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 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
-- 'Prettyprinter.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
-- 'Prettyprinter.Render.Tutorials.StackMachineTutorial.renderStackMachine'
-- in the stack machine rendering tutorial.
renderTree :: SimpleDocTree SimpleHtml -> TLB.Builder
renderTree :: SimpleDocTree SimpleHtml -> Builder
renderTree SimpleDocTree SimpleHtml
sds = case SimpleDocTree SimpleHtml
sds of
    SimpleDocTree SimpleHtml
STEmpty -> Builder
forall a. Monoid a => a
mempty
    STChar Char
c -> Char -> Builder
TLB.singleton Char
c
    STText Int
_ Text
t -> Text -> Builder
TLB.fromText Text
t
    STLine Int
i -> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText (Int -> Text
textSpaces Int
i)
    STAnn SimpleHtml
ann SimpleDocTree SimpleHtml
content -> SimpleHtml -> Builder -> Builder
encloseInTagFor SimpleHtml
ann (SimpleDocTree SimpleHtml -> Builder
renderTree SimpleDocTree SimpleHtml
content)
    STConcat [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 SimpleHtml
sh = case SimpleHtml
sh of
    SimpleHtml
Bold      -> \Builder
x -> Builder
"<strong>" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</strong>"
    SimpleHtml
Italics   -> \Builder
x -> Builder
"<em>" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</em>"
    Color Color
c   -> \Builder
x -> 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 -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</span>"
    SimpleHtml
Paragraph -> \Builder
x -> Builder
"<p>" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</p>"
    SimpleHtml
Headline  -> \Builder
x -> Builder
"<h1>" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> 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"

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