-- | Render Unison.Server.Doc and embedded source to Html
module Unison.Server.Doc.AsHtml where

import Control.Monad.State.Class (MonadState)
import Control.Monad.State.Class qualified as State
import Control.Monad.Trans.State (evalStateT)
import Control.Monad.Writer.Class (MonadWriter)
import Control.Monad.Writer.Class qualified as Writer
import Control.Monad.Writer.Lazy (runWriterT)
import Data.Char qualified as Char
import Data.Foldable
import Data.List (intersperse)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Text qualified as Text
import Lucid
import Lucid qualified as L
import Lucid.Base qualified as LB
import Unison.Codebase.Editor.DisplayObject (DisplayObject (..))
import Unison.Name (Name)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Server.Doc
import Unison.Server.Doc qualified as Doc
import Unison.Server.Syntax (SyntaxText)
import Unison.Server.Syntax qualified as Syntax
import Unison.Syntax.Name qualified as Name (toText)

data NamedLinkHref
  = Href Text
  | DocLinkHref Name
  | ReferenceHref Text
  | InvalidHref

data EmbeddedSource
  = EmbeddedSource SyntaxText SyntaxText
  | Builtin SyntaxText

embeddedSource :: Ref (UnisonHash, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource :: Ref (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource Ref (Text, DisplayObject SyntaxText Src)
ref =
  let embeddedSource' :: (a, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource' (a
_, DisplayObject SyntaxText Src
displayObj) =
        case DisplayObject SyntaxText Src
displayObj of
          BuiltinObject SyntaxText
s -> EmbeddedSource -> Maybe EmbeddedSource
forall a. a -> Maybe a
Just (SyntaxText -> EmbeddedSource
Builtin SyntaxText
s)
          UserObject (Src SyntaxText
sum SyntaxText
det) -> EmbeddedSource -> Maybe EmbeddedSource
forall a. a -> Maybe a
Just (SyntaxText -> SyntaxText -> EmbeddedSource
EmbeddedSource SyntaxText
sum SyntaxText
det)
          MissingObject ShortHash
_ -> Maybe EmbeddedSource
forall a. Maybe a
Nothing
   in case Ref (Text, DisplayObject SyntaxText Src)
ref of
        Term (Text, DisplayObject SyntaxText Src)
s -> (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
forall {a}.
(a, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource' (Text, DisplayObject SyntaxText Src)
s
        Type (Text, DisplayObject SyntaxText Src)
s -> (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
forall {a}.
(a, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource' (Text, DisplayObject SyntaxText Src)
s

inlineCode :: [Text] -> Html () -> Html ()
inlineCode :: [Text] -> Html () -> Html ()
inlineCode [Text]
classNames =
  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
code_ [[Text] -> Attribute
classes_ (Text
"inline-code" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
classNames)]

codeBlock :: [Attribute] -> Html () -> Html ()
codeBlock :: [Attribute] -> Html () -> Html ()
codeBlock [Attribute]
attrs =
  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
pre_ [Attribute]
attrs (Html () -> Html ()) -> (Html () -> Html ()) -> Html () -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
code_ []

normalizeHref :: Map Referent Name -> Doc -> NamedLinkHref
normalizeHref :: Map Referent Name -> Doc -> NamedLinkHref
normalizeHref Map Referent Name
docNamesByRef = NamedLinkHref -> Doc -> NamedLinkHref
go NamedLinkHref
InvalidHref
  where
    go :: NamedLinkHref -> Doc -> NamedLinkHref
go NamedLinkHref
href Doc
doc =
      case Doc
doc of
        Word Text
w ->
          case NamedLinkHref
href of
            NamedLinkHref
InvalidHref ->
              Text -> NamedLinkHref
Href Text
w
            Href Text
h ->
              Text -> NamedLinkHref
Href (Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w)
            ReferenceHref Text
_ ->
              NamedLinkHref
href
            DocLinkHref Name
_ ->
              NamedLinkHref
href
        Group Doc
d_ ->
          NamedLinkHref -> Doc -> NamedLinkHref
go NamedLinkHref
href Doc
d_
        Join [Doc]
ds ->
          (NamedLinkHref -> Doc -> NamedLinkHref)
-> NamedLinkHref -> [Doc] -> NamedLinkHref
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' NamedLinkHref -> Doc -> NamedLinkHref
go NamedLinkHref
href [Doc]
ds
        Special (Link SyntaxText
syntax) ->
          case SyntaxText -> Maybe Text
Syntax.firstReference SyntaxText
syntax of
            Just Text
r ->
              -- Convert references to docs to names, so we can construct links
              -- matching the file structure being generated from all the docs
              case Text -> Maybe Referent
Referent.fromText Text
r Maybe Referent -> (Referent -> Maybe Name) -> Maybe Name
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Referent -> Map Referent Name -> Maybe Name)
-> Map Referent Name -> Referent -> Maybe Name
forall a b c. (a -> b -> c) -> b -> a -> c
flip Referent -> Map Referent Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map Referent Name
docNamesByRef of
                Just Name
n ->
                  Name -> NamedLinkHref
DocLinkHref Name
n
                Maybe Name
Nothing ->
                  Text -> NamedLinkHref
ReferenceHref Text
r
            Maybe Text
Nothing -> NamedLinkHref
InvalidHref
        Doc
_ ->
          NamedLinkHref
href

data IsFolded
  = IsFolded Bool [Html ()] [Html ()]
  | Disabled (Html ())

foldedToHtml :: [Attribute] -> IsFolded -> Html ()
foldedToHtml :: [Attribute] -> IsFolded -> Html ()
foldedToHtml [Attribute]
attrs IsFolded
isFolded =
  case IsFolded
isFolded of
    Disabled Html ()
summary ->
      [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
details_ [Attribute]
attrs (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Html () -> Html ()
forall arg result. Term arg result => arg -> result
summary_ Html ()
summary
    IsFolded Bool
isFolded [Html ()]
summary [Html ()]
details ->
      let attrsWithOpen :: [Attribute]
attrsWithOpen =
            if Bool
isFolded
              then [Attribute]
attrs
              else Text -> Attribute
open_ Text
"open" Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: [Attribute]
attrs
       in [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
details_ [Attribute]
attrsWithOpen (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
            [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
summary_ [Text -> Attribute
class_ Text
"folded-content folded-summary"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Html ()] -> Html ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Html ()]
summary
            [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"folded-content folded-details"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Html ()] -> Html ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Html ()]
details

foldedToHtmlSource :: Bool -> EmbeddedSource -> Html ()
foldedToHtmlSource :: Bool -> EmbeddedSource -> Html ()
foldedToHtmlSource Bool
isFolded EmbeddedSource
source =
  case EmbeddedSource
source of
    Builtin SyntaxText
summary ->
      [Attribute] -> IsFolded -> Html ()
foldedToHtml
        [Text -> Attribute
class_ Text
"folded rich source"]
        ( Html () -> IsFolded
Disabled
            ( [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_
                [Text -> Attribute
class_ Text
"builtin-summary"]
                (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                  [Attribute] -> Html () -> Html ()
codeBlock [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Html ()
Syntax.toHtml SyntaxText
summary
                  Html () -> Html ()
badge (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
strong_ [] Html ()
"Built-in"
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [] Html ()
"provided by the Unison runtime"
            )
        )
    EmbeddedSource SyntaxText
summary SyntaxText
details ->
      [Attribute] -> IsFolded -> Html ()
foldedToHtml
        [Text -> Attribute
class_ Text
"folded rich source"]
        ( Bool -> [Html ()] -> [Html ()] -> IsFolded
IsFolded
            Bool
isFolded
            [[Attribute] -> Html () -> Html ()
codeBlock [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Html ()
Syntax.toHtml SyntaxText
summary]
            [[Attribute] -> Html () -> Html ()
codeBlock [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Html ()
Syntax.toHtml SyntaxText
details]
        )

-- | Merge adjacent Word elements in a list to 1 element with a string of words
-- separated by space— useful for rendering to the dom without creating dom
-- elements for each and every word in the doc, but instead rely on textNodes
mergeWords :: Text -> [Doc] -> [Doc]
mergeWords :: Text -> [Doc] -> [Doc]
mergeWords Text
sep = (Doc -> [Doc] -> [Doc]) -> [Doc] -> [Doc] -> [Doc]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> [Doc] -> [Doc]
merge_ []
  where
    merge_ :: Doc -> [Doc] -> [Doc]
    merge_ :: Doc -> [Doc] -> [Doc]
merge_ Doc
d [Doc]
acc =
      case (Doc
d, [Doc]
acc) of
        (Word Text
w, Word Text
w_ : [Doc]
rest) ->
          Text -> Doc
forall specialForm. Text -> DocG specialForm
Word (Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w_) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
rest
        (Doc, [Doc])
_ ->
          Doc
d Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
acc

-- | Merge down Doc to Text by merging Paragraphs and Words.
-- Used for things like extract an src of an image. I.e something that has to
-- be a Text and not a Doc
toText :: Text -> Doc -> Text
toText :: Text -> Doc -> Text
toText Text
sep Doc
doc =
  case Doc
doc of
    Paragraph [Doc]
ds ->
      [Doc] -> Text
listToText [Doc]
ds
    Group Doc
d ->
      Text -> Doc -> Text
toText Text
sep Doc
d
    Join [Doc]
ds ->
      [Doc] -> Text
listToText [Doc]
ds
    Bold Doc
d ->
      Text -> Doc -> Text
toText Text
sep Doc
d
    Italic Doc
d ->
      Text -> Doc -> Text
toText Text
sep Doc
d
    Strikethrough Doc
d ->
      Text -> Doc -> Text
toText Text
sep Doc
d
    Blockquote Doc
d ->
      Text -> Doc -> Text
toText Text
sep Doc
d
    Section Doc
d [Doc]
ds ->
      Text -> Doc -> Text
toText Text
sep Doc
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Text
listToText [Doc]
ds
    UntitledSection [Doc]
ds ->
      [Doc] -> Text
listToText [Doc]
ds
    Column [Doc]
ds ->
      [Doc] -> Text
listToText [Doc]
ds
    Word Text
w ->
      Text
w
    Doc
_ ->
      Text
""
  where
    isEmpty :: Text -> Bool
isEmpty Text
s =
      Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
Text.empty

    listToText :: [Doc] -> Text
listToText =
      Text -> [Text] -> Text
Text.intercalate Text
sep
        ([Text] -> Text) -> ([Doc] -> [Text]) -> [Doc] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isEmpty)
        ([Text] -> [Text]) -> ([Doc] -> [Text]) -> [Doc] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Text) -> [Doc] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc -> Text
toText Text
sep)

data SideContent
  = FrontMatterContent (Map Text [Text])
  | TooltipContent (Html ())

newtype FrontMatterData = FrontMatterData (Map Text [Text])

toHtml :: Map Referent Name -> Doc -> (FrontMatterData, Html ())
toHtml :: Map Referent Name -> Doc -> (FrontMatterData, Html ())
toHtml Map Referent Name
docNamesByRef Doc
document =
  ( Map Text [Text] -> FrontMatterData
FrontMatterData Map Text [Text]
frontMatterContent,
    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
article_ [Text -> Attribute
class_ Text
"unison-doc"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
      Html ()
content
      [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"tooltips", Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ Text
"display: none;"] Html ()
tooltips
  )
  where
    tooltips :: Html ()
tooltips =
      (Html () -> SideContent -> Html ())
-> Html () -> Seq SideContent -> Html ()
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Html () -> SideContent -> Html ()
go Html ()
forall a. Monoid a => a
mempty Seq SideContent
sideContent
      where
        go :: Html () -> SideContent -> Html ()
go Html ()
acc (FrontMatterContent Map Text [Text]
_) = Html ()
acc
        go Html ()
acc (TooltipContent Html ()
html) = Html ()
acc Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> Html ()
html

    frontMatterContent :: Map Text [Text]
frontMatterContent =
      (Map Text [Text] -> SideContent -> Map Text [Text])
-> Map Text [Text] -> Seq SideContent -> Map Text [Text]
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Text [Text] -> SideContent -> Map Text [Text]
go Map Text [Text]
forall a. Monoid a => a
mempty Seq SideContent
sideContent
      where
        go :: Map Text [Text] -> SideContent -> Map Text [Text]
go Map Text [Text]
acc (FrontMatterContent Map Text [Text]
fm) = Map Text [Text]
acc Map Text [Text] -> Map Text [Text] -> Map Text [Text]
forall a. Semigroup a => a -> a -> a
<> Map Text [Text]
fm
        go Map Text [Text]
acc (TooltipContent Html ()
_) = Map Text [Text]
acc

    (Html ()
_ :: Html (), (Html ()
content, Seq SideContent
sideContent) :: (Html (), Seq SideContent)) =
      WriterT (Seq SideContent) ((,) (Html ())) (Html ())
-> (Html (), (Html (), Seq SideContent))
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (StateT Int (WriterT (Seq SideContent) ((,) (Html ()))) (Html ())
-> Int -> WriterT (Seq SideContent) ((,) (Html ())) (Html ())
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Nat
-> Doc
-> StateT Int (WriterT (Seq SideContent) ((,) (Html ()))) (Html ())
forall (m :: * -> *).
(MonadState Int m, MonadWriter (Seq SideContent) m) =>
Nat -> Doc -> m (Html ())
toHtml_ Nat
1 Doc
document) Int
0)

    toHtml_ ::
      forall m.
      (MonadState Int m, MonadWriter (Seq SideContent) m) =>
      Nat ->
      Doc ->
      m (Html ())
    toHtml_ :: forall (m :: * -> *).
(MonadState Int m, MonadWriter (Seq SideContent) m) =>
Nat -> Doc -> m (Html ())
toHtml_ Nat
sectionLevel Doc
doc =
      let -- Make it simple to retain the sectionLevel when recurring.
          -- the Section variant increments it locally
          currentSectionLevelToHtml ::
            (MonadState Int m, MonadWriter (Seq SideContent) m) =>
            Doc ->
            m (Html ())
          currentSectionLevelToHtml :: (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
currentSectionLevelToHtml =
            Nat -> Doc -> m (Html ())
forall (m :: * -> *).
(MonadState Int m, MonadWriter (Seq SideContent) m) =>
Nat -> Doc -> m (Html ())
toHtml_ Nat
sectionLevel

          renderSequence :: (a -> m (Html ())) -> [a] -> m (Html ())
          renderSequence :: forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence a -> m (Html ())
f [a]
xs =
            [Html ()] -> Html ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Html ()] -> Html ()) -> m [Html ()] -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (Html ())) -> [a] -> m [Html ()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> m (Html ())
f [a]
xs

          sectionContentToHtml ::
            (MonadState Int m, MonadWriter (Seq SideContent) m) =>
            (Doc -> m (Html ())) ->
            Doc ->
            m (Html ())
          sectionContentToHtml :: (MonadState Int m, MonadWriter (Seq SideContent) m) =>
(Doc -> m (Html ())) -> Doc -> m (Html ())
sectionContentToHtml Doc -> m (Html ())
renderer Doc
doc_ =
            -- Block elements can't be children for <p> elements
            case Doc
doc_ of
              Paragraph [CodeBlock {}] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Blockquote Doc
_] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Doc
Blankline] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Doc
SectionBreak] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Callout {}] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Table [[Doc]]
_] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Folded {}] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [BulletedList [Doc]
_] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [NumberedList {}] -> Doc -> m (Html ())
renderer Doc
doc_
              -- Paragraph [Section _ _] -> renderer doc_
              Paragraph [Image {}] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Special (Source [Ref (Text, DisplayObject SyntaxText Src)]
_)] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Special (FoldedSource [Ref (Text, DisplayObject SyntaxText Src)]
_)] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Special (ExampleBlock SyntaxText
_)] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Special (Signature [SyntaxText]
_)] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Special Eval {}] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Special (Embed SyntaxText
_)] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [UntitledSection [Doc]
ds] ->
                (Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence ((MonadState Int m, MonadWriter (Seq SideContent) m) =>
(Doc -> m (Html ())) -> Doc -> m (Html ())
(Doc -> m (Html ())) -> Doc -> m (Html ())
sectionContentToHtml Doc -> m (Html ())
renderer) [Doc]
ds
              Paragraph [Column [Doc]
_] -> Doc -> m (Html ())
renderer Doc
doc_
              Paragraph [Doc]
_ -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
p_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Doc -> m (Html ())
renderer Doc
doc_
              Doc
_ ->
                Doc -> m (Html ())
renderer Doc
doc_
       in case Doc
doc of
            Tooltip Doc
triggerContent Doc
tooltipContent -> do
              Int
tooltipNo <- m Int
forall s (m :: * -> *). MonadState s m => m s
State.get
              let tooltipId :: Text
tooltipId = Text
"tooltip-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
tooltipNo)
              Int -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (Int
tooltipNo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              Html ()
tooltip <-
                [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"tooltip-content", Text -> Attribute
id_ Text
tooltipId]
                  (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
tooltipContent
              Seq SideContent -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell (SideContent -> Seq SideContent
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SideContent -> Seq SideContent) -> SideContent -> Seq SideContent
forall a b. (a -> b) -> a -> b
$ Html () -> SideContent
TooltipContent Html ()
tooltip)

              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_
                [ Text -> Attribute
class_ Text
"tooltip-trigger",
                  Text -> Text -> Attribute
data_ Text
"tooltip-content-id" Text
tooltipId
                ]
                (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
triggerContent
            Word Text
word ->
              Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"word"] (Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
L.toHtml Text
word)
            Code Doc
code ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"rich source inline-code"] (Html () -> Html ()) -> (Html () -> Html ()) -> Html () -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Html () -> Html ()
inlineCode [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
code
            CodeBlock Text
lang Doc
code ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text
"rich source code " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
textToClass Text
lang] (Html () -> Html ()) -> (Html () -> Html ()) -> Html () -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Html () -> Html ()
codeBlock [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
code
            Bold Doc
d ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
strong_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
d
            Italic Doc
d ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"italic"] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
d
            Strikethrough Doc
d ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"strikethrough"] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
d
            Style Text
cssclass_ Doc
d ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> Text
textToClass Text
cssclass_] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
d
            Anchor Text
id' Doc
d ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
id_ Text
id', Text -> Attribute
href_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id'] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
d
            Blockquote Doc
d ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
blockquote_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
d
            Doc
Blankline ->
              Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                ( [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                    [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
br_ []
                    [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
br_ []
                )
            Doc
Linebreak ->
              Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
br_ []
            Doc
SectionBreak ->
              Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
hr_ []
            Aside Doc
d ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_
                [Text -> Attribute
class_ Text
"aside-anchor"]
                (Html () -> Html ()) -> (Html () -> Html ()) -> Html () -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
aside_ []
                (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
d
            Callout Maybe Doc
icon Doc
content -> do
              Html ()
callout <- (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
content
              Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$
                [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Attribute
cls] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                  Html ()
ico
                  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"callout-content"] Html ()
callout
              where
                (Attribute
cls :: Attribute, Html ()
ico :: Html ()) =
                  case Maybe Doc
icon of
                    Just Doc
emoji ->
                      ( Text -> Attribute
class_ Text
"callout callout-with-icon",
                        [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"callout-icon"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
L.toHtml (Text -> Html ()) -> (Doc -> Text) -> Doc -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc -> Text
toText Text
"" (Doc -> Html ()) -> Doc -> Html ()
forall a b. (a -> b) -> a -> b
$ Doc
emoji
                      )
                    Maybe Doc
Nothing ->
                      (Text -> Attribute
class_ Text
"callout", Html ()
"")
            Table [[Doc]]
rows ->
              let cellToHtml :: Doc -> m (Html ())
cellToHtml Doc
c =
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
td_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
c

                  rowToHtml :: [Doc] -> m (Html ())
rowToHtml [Doc]
cells =
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence Doc -> m (Html ())
cellToHtml (Text -> [Doc] -> [Doc]
mergeWords Text
" " [Doc]
cells)

                  rows_ :: m (Html ())
rows_ =
                    ([Doc] -> m (Html ())) -> [[Doc]] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence [Doc] -> m (Html ())
rowToHtml [[Doc]]
rows
               in [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
table_ [] (Html () -> Html ()) -> (Html () -> Html ()) -> Html () -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
tbody_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Html ())
rows_
            Folded Bool
isFolded Doc
summary Doc
details -> do
              Html ()
summary' <- (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
summary
              Html ()
details' <- (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
details

              Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$
                [Attribute] -> IsFolded -> Html ()
foldedToHtml [Text -> Attribute
class_ Text
"folded"] (IsFolded -> Html ()) -> IsFolded -> Html ()
forall a b. (a -> b) -> a -> b
$
                  Bool -> [Html ()] -> [Html ()] -> IsFolded
IsFolded
                    Bool
isFolded
                    [Html ()
summary']
                    -- We include the summary in the details slot to make it
                    -- symmetric with code folding, which currently always
                    -- includes the type signature in the details portion
                    [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [] Html ()
summary', Html ()
details']
            Paragraph [Doc]
docs ->
              case [Doc]
docs of
                [Doc
d] ->
                  (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
d
                [Doc]
ds ->
                  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"span"]
                    (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc
forall specialForm. Text -> DocG specialForm
Word Text
" ") (Text -> [Doc] -> [Doc]
mergeWords Text
" " [Doc]
ds)))
            BulletedList [Doc]
items ->
              let itemToHtml :: Doc -> m (Html ())
itemToHtml Doc
i =
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
li_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
i
               in [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
ul_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence Doc -> m (Html ())
itemToHtml (Text -> [Doc] -> [Doc]
mergeWords Text
" " [Doc]
items)
            NumberedList Nat
startNum [Doc]
items ->
              let itemToHtml :: Doc -> m (Html ())
itemToHtml Doc
i =
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
li_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
i
               in [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
ol_ [Text -> Attribute
start_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Nat -> String
forall a. Show a => a -> String
show Nat
startNum]
                    (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence Doc -> m (Html ())
itemToHtml (Text -> [Doc] -> [Doc]
mergeWords Text
" " [Doc]
items)
            Section Doc
title [Doc]
docs -> do
              let sectionId :: Text
sectionId =
                    Text -> Text
Text.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                      (Char -> Bool) -> Text -> Text
Text.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char -> Bool
Char.isAlphaNum Char
c) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                        Text -> Doc -> Text
toText Text
"-" Doc
title

              Html ()
titleEl <-
                Nat -> Text -> Html () -> Html ()
h Nat
sectionLevel Text
sectionId (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
title

              Html ()
docs' <- (Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence ((MonadState Int m, MonadWriter (Seq SideContent) m) =>
(Doc -> m (Html ())) -> Doc -> m (Html ())
(Doc -> m (Html ())) -> Doc -> m (Html ())
sectionContentToHtml (Nat -> Doc -> m (Html ())
forall (m :: * -> *).
(MonadState Int m, MonadWriter (Seq SideContent) m) =>
Nat -> Doc -> m (Html ())
toHtml_ (Nat
sectionLevel Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
1))) [Doc]
docs

              Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
section_ [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Html ()
titleEl Html () -> Html () -> Html ()
forall a b.
HtmlT Identity a -> HtmlT Identity b -> HtmlT Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Html ()
docs'
            NamedLink Doc
label Doc
href ->
              case Map Referent Name -> Doc -> NamedLinkHref
normalizeHref Map Referent Name
docNamesByRef Doc
href of
                Href Text
h ->
                  -- Fragments (starting with a #) are links internal to the page
                  if Text -> Text -> Bool
Text.isPrefixOf Text
"#" Text
h
                    then [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
class_ Text
"named-link", Text -> Attribute
href_ Text
h] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
label
                    else [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
class_ Text
"named-link", Text -> Attribute
href_ Text
h, Text -> Attribute
rel_ Text
"noopener", Text -> Attribute
target_ Text
"_blank"] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
label
                DocLinkHref Name
name ->
                  let href :: Text
href = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"." Text
"/" (Name -> Text
Name.toText Name
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".html"
                   in [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
class_ Text
"named-link doc-link", Text -> Attribute
href_ Text
href] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
label
                ReferenceHref Text
ref ->
                  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"named-link", Text -> Text -> Attribute
data_ Text
"ref" Text
ref, Text -> Text -> Attribute
data_ Text
"ref-type" Text
"term"] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
label
                NamedLinkHref
InvalidHref ->
                  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"named-link invalid-href"] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
label
            Image Doc
altText Doc
src Maybe Doc
caption ->
              let altAttr :: [Attribute]
altAttr =
                    [Text -> Attribute
alt_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> Doc -> Text
toText Text
" " Doc
altText]

                  image :: Html ()
image =
                    [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
img_ ([Attribute]
altAttr [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++ [Text -> Attribute
src_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> Doc -> Text
toText Text
"" Doc
src])

                  imageWithCaption :: Doc -> m (Html ())
imageWithCaption Doc
c = do
                    Html ()
caption' <- (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
c

                    Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$
                      [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"image-with-caption"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                        Html ()
image
                        [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"caption"] Html ()
caption'
               in m (Html ()) -> (Doc -> m (Html ())) -> Maybe Doc -> m (Html ())
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html ()
image) Doc -> m (Html ())
imageWithCaption Maybe Doc
caption
            Special RenderedSpecialForm
specialForm ->
              case RenderedSpecialForm
specialForm of
                Source [Ref (Text, DisplayObject SyntaxText Src)]
sources ->
                  let sources' :: [Html ()]
sources' =
                        (Ref (Text, DisplayObject SyntaxText Src) -> Maybe (Html ()))
-> [Ref (Text, DisplayObject SyntaxText Src)] -> [Html ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                          ((EmbeddedSource -> Html ())
-> Maybe EmbeddedSource -> Maybe (Html ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> EmbeddedSource -> Html ()
foldedToHtmlSource Bool
False) (Maybe EmbeddedSource -> Maybe (Html ()))
-> (Ref (Text, DisplayObject SyntaxText Src)
    -> Maybe EmbeddedSource)
-> Ref (Text, DisplayObject SyntaxText Src)
-> Maybe (Html ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource)
                          [Ref (Text, DisplayObject SyntaxText Src)]
sources
                   in Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"folded-sources"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Html ()] -> Html ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Html ()]
sources'
                FoldedSource [Ref (Text, DisplayObject SyntaxText Src)]
sources ->
                  let sources' :: [Html ()]
sources' =
                        (Ref (Text, DisplayObject SyntaxText Src) -> Maybe (Html ()))
-> [Ref (Text, DisplayObject SyntaxText Src)] -> [Html ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                          ((EmbeddedSource -> Html ())
-> Maybe EmbeddedSource -> Maybe (Html ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> EmbeddedSource -> Html ()
foldedToHtmlSource Bool
True) (Maybe EmbeddedSource -> Maybe (Html ()))
-> (Ref (Text, DisplayObject SyntaxText Src)
    -> Maybe EmbeddedSource)
-> Ref (Text, DisplayObject SyntaxText Src)
-> Maybe (Html ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource)
                          [Ref (Text, DisplayObject SyntaxText Src)]
sources
                   in Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"folded-sources"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Html ()] -> Html ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Html ()]
sources'
                Example SyntaxText
syntax ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"source rich example-inline"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Html () -> Html ()
inlineCode [] (SyntaxText -> Html ()
Syntax.toHtml SyntaxText
syntax)
                ExampleBlock SyntaxText
syntax ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"source rich example"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
codeBlock [] (SyntaxText -> Html ()
Syntax.toHtml SyntaxText
syntax)
                Link SyntaxText
syntax ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Html () -> Html ()
inlineCode [Text
"rich", Text
"source"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Html ()
Syntax.toHtml SyntaxText
syntax)
                Signature [SyntaxText]
signatures ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    ( [Attribute] -> Html () -> Html ()
codeBlock
                        [Text -> Attribute
class_ Text
"rich source signatures"]
                        ( (SyntaxText -> Html ()) -> [SyntaxText] -> Html ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
                            ([Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"signature"] (Html () -> Html ())
-> (SyntaxText -> Html ()) -> SyntaxText -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxText -> Html ()
Syntax.toHtml)
                            [SyntaxText]
signatures
                        )
                    )
                SignatureInline SyntaxText
sig ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Html () -> Html ()
inlineCode [Text
"rich", Text
"source", Text
"signature-inline"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Html ()
Syntax.toHtml SyntaxText
sig)
                Eval SyntaxText
source SyntaxText
result ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"source rich eval"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
                      [Attribute] -> Html () -> Html ()
codeBlock [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
                        [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                          SyntaxText -> Html ()
Syntax.toHtml SyntaxText
source
                          [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"result"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                            Html ()
"⧨"
                            [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Html ()
Syntax.toHtml SyntaxText
result
                EvalInline SyntaxText
source SyntaxText
result ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$
                    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"source rich eval-inline"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
                      [Text] -> Html () -> Html ()
inlineCode [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
                        [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                          SyntaxText -> Html ()
Syntax.toHtml SyntaxText
source
                          [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"result"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
                            Html ()
"⧨"
                            SyntaxText -> Html ()
Syntax.toHtml SyntaxText
result
                Video [MediaSource]
sources Map Text Text
attrs ->
                  let source :: MediaSource -> HtmlT m ()
source (MediaSource Text
s Maybe Text
Nothing) =
                        [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
source_ [Text -> Attribute
src_ Text
s]
                      source (MediaSource Text
s (Just Text
m)) =
                        [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
source_ [Text -> Attribute
src_ Text
s, Text -> Attribute
type_ Text
m]

                      attrs' :: [Attribute]
attrs' = ((Text, Text) -> [Attribute]) -> [(Text, Text)] -> [Attribute]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, Text) -> [Attribute]
forall {a}. (Eq a, IsString a) => (a, Text) -> [Attribute]
go (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attrs)
                        where
                          go :: (a, Text) -> [Attribute]
go (a
"poster", Text
p) = [Text -> Text -> Attribute
LB.makeAttribute Text
"poster" Text
p]
                          go (a
"autoplay", Text
"true") = [Text -> Text -> Attribute
LB.makeAttribute Text
"autoplay" Text
"autoplay"]
                          go (a
"loop", Text
"true") = [Text -> Attribute
loop_ Text
"loop"]
                          go (a
"controls", Text
"true") = [Text -> Attribute
loop_ Text
"controls"]
                          go (a
"muted", Text
"true") = [Text -> Text -> Attribute
LB.makeAttribute Text
"muted" Text
"muted"]
                          go (a, Text)
_ = []
                   in Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
video_ [Attribute]
attrs' (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ (MediaSource -> Html ()) -> [MediaSource] -> Html ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MediaSource -> Html ()
forall {m :: * -> *}. Applicative m => MediaSource -> HtmlT m ()
source [MediaSource]
sources
                Doc.FrontMatter Map Text [Text]
fm -> do
                  Seq SideContent -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell (SideContent -> Seq SideContent
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SideContent -> Seq SideContent) -> SideContent -> Seq SideContent
forall a b. (a -> b) -> a -> b
$ Map Text [Text] -> SideContent
FrontMatterContent Map Text [Text]
fm)
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html ()
forall a. Monoid a => a
mempty
                LaTeXInline Text
latex ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"source rich embed latex-inline"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
codeBlock [] (Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
L.toHtml Text
latex)
                Svg Text
svg ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
iframe_ [Text -> Attribute
class_ Text
"embed svg", Text -> Attribute
sandbox_ Text
"true", Text -> Attribute
srcdoc_ Text
svg] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [HtmlT Identity Any] -> Html ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ []
                Embed SyntaxText
syntax ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"source rich embed"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
codeBlock [] (SyntaxText -> Html ()
Syntax.toHtml SyntaxText
syntax)
                EmbedInline SyntaxText
syntax ->
                  Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"source rich embed-inline"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Html () -> Html ()
inlineCode [] (SyntaxText -> Html ()
Syntax.toHtml SyntaxText
syntax)
                RenderError (InvalidTerm SyntaxText
err) -> Html () -> m (Html ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Html ()
Syntax.toHtml SyntaxText
err
            Join [Doc]
docs ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"join"] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml (Text -> [Doc] -> [Doc]
mergeWords Text
" " [Doc]
docs)
            UntitledSection [Doc]
docs ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
section_ [] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence ((MonadState Int m, MonadWriter (Seq SideContent) m) =>
(Doc -> m (Html ())) -> Doc -> m (Html ())
(Doc -> m (Html ())) -> Doc -> m (Html ())
sectionContentToHtml (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml) [Doc]
docs
            Column [Doc]
docs ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
ul_
                [Text -> Attribute
class_ Text
"column"]
                (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Doc -> m (Html ())) -> [Doc] -> m (Html ())
forall a. (a -> m (Html ())) -> [a] -> m (Html ())
renderSequence
                  ((Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
li_ []) (m (Html ()) -> m (Html ()))
-> (Doc -> m (Html ())) -> Doc -> m (Html ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml)
                  (Text -> [Doc] -> [Doc]
mergeWords Text
" " [Doc]
docs)
            Group Doc
content ->
              [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"group"] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonadState Int m, MonadWriter (Seq SideContent) m) =>
Doc -> m (Html ())
Doc -> m (Html ())
currentSectionLevelToHtml Doc
content

-- HELPERS --------------------------------------------------------------------

-- | Unison Doc allows endlessly deep section nesting with
-- titles, but HTML only supports to h1-h6, so we clamp
-- the sectionLevel when converting
h :: Nat -> Text -> (Html () -> Html ())
h :: Nat -> Text -> Html () -> Html ()
h Nat
n Text
anchorId =
  case Nat
n of
    Nat
1 -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h1_ [Text -> Attribute
id_ Text
anchorId]
    Nat
2 -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h2_ [Text -> Attribute
id_ Text
anchorId]
    Nat
3 -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h3_ [Text -> Attribute
id_ Text
anchorId]
    Nat
4 -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h4_ [Text -> Attribute
id_ Text
anchorId]
    Nat
5 -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h5_ [Text -> Attribute
id_ Text
anchorId]
    Nat
6 -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h6_ [Text -> Attribute
id_ Text
anchorId]
    Nat
_ -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h6_ [Text -> Attribute
id_ Text
anchorId]

badge :: Html () -> Html ()
badge :: Html () -> Html ()
badge =
  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"badge"]

textToClass :: Text -> Text
textToClass :: Text -> Text
textToClass =
  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
" " Text
"__"