{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
#include "version-compatibility-macros.h"
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
data SimpleHtml = Bold | Italics | Color Color | Paragraph | Headline
data Color = Red | Green | Blue
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)
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
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
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"