{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} #include "version-compatibility-macros.h" -- | This module shows how to write a custom prettyprinter backend, based on -- directly converting a 'SimpleDoc' to an output format using a stack machine. -- For a tree serialization approach, which may be more suitable for certain -- output formats, see -- "Data.Text.Prettyprint.Doc.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 Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial ( module Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial ) where import qualified Data.Text as T 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.Render.Util.Panic import Data.Text.Prettyprint.Doc.Render.Util.StackMachine #if !(APPLICATIVE_MONAD) import Control.Applicative #endif -- $standalone-text -- -- = The type of available markup -- -- 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 -- $standalone-text -- -- == Conveinence definitions bold, italics, paragraph, headline :: Doc SimpleHtml -> Doc SimpleHtml bold = annotate Bold italics = annotate Italics paragraph = annotate Paragraph headline = annotate Headline color :: Color -> Doc SimpleHtml -> Doc SimpleHtml color c = annotate (Color c) -- $standalone-text -- -- = The rendering algorithm -- -- With the annotation definitions out of the way, we can now define a -- conversion function from 'SimpleDoc' annotated with our 'SimpleHtml' to the -- final 'TL.Text' representation. -- | 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 'SimpleDoc', 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 -- 'Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial.renderTree'. renderStackMachine :: SimpleDoc SimpleHtml -> StackMachine TLB.Builder SimpleHtml () renderStackMachine = \case SFail -> panicUncaughtFail SEmpty -> pure () SChar c x -> do writeOutput (TLB.singleton c) renderStackMachine x SText _l t x -> do writeOutput (TLB.fromText t) renderStackMachine x SLine i x -> do writeOutput (TLB.singleton '\n' ) writeOutput (TLB.fromText (T.replicate i " ")) renderStackMachine x SAnnPush s x -> do pushStyle s writeOutput (fst (htmlTag s)) renderStackMachine x SAnnPop x -> do s <- unsafePopStyle writeOutput (snd (htmlTag s)) renderStackMachine 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 = \case Bold -> ("", "") Italics -> ("", "") Color c -> (" hexCode c <> "\">", "") Paragraph -> ("
", "
") Headline -> ("This is a paragraph,
--and this text is bold.