    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE UndecidableInstances       #-}
    module Commonmark.Html
      ( Html
      , htmlInline
      , htmlBlock
      , htmlText
      , htmlRaw
      , addAttribute
      , renderHtml
      , escapeURI
      , escapeHtml
      )
    where

    import           Commonmark.Types
    import           Commonmark.Entity (lookupEntity)
    import           Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import           Data.Text.Lazy.Builder (Builder, fromText, toLazyText,
                                             singleton)
    import           Data.Text.Encoding   (encodeUtf8)
    import qualified Data.ByteString.Char8 as B
    import qualified Data.Set as Set
    import           Text.Printf          (printf)
    import           Unicode.Char         (ord, isAlphaNum, isAscii)
    import           Unicode.Char.General.Compat (isSpace)
    import           Data.Maybe           (fromMaybe)

    data ElementType =
        InlineElement
      | BlockElement

    data Html a =
        HtmlElement !ElementType {-# UNPACK #-} !Text [Attribute] (Maybe (Html a))
      | HtmlText {-# UNPACK #-} !Text
      | HtmlRaw {-# UNPACK #-} !Text
      | HtmlNull
      | HtmlConcat !(Html a) !(Html a)

    instance Show (Html a) where
      show :: Html a -> String
    show = Text -> String
    TL.unpack (Text -> String) -> (Html a -> Text) -> Html a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html a -> Text
    forall a. Html a -> Text
    renderHtml

    instance Semigroup (Html a) where
      Html a
    x <> :: Html a -> Html a -> Html a
    <> Html a
    HtmlNull                = Html a
    x
      Html a
    HtmlNull <> Html a
    x                = Html a
    x
      HtmlText Text
    t1 <> HtmlText Text
    t2   = Text -> Html a
    forall a. Text -> Html a
    HtmlText (Text
    t1 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t2)
      HtmlRaw Text
    t1 <> HtmlRaw Text
    t2     = Text -> Html a
    forall a. Text -> Html a
    HtmlRaw (Text
    t1 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t2)
      Html a
    x <> Html a
    y                       = Html a -> Html a -> Html a
    forall a. Html a -> Html a -> Html a
    HtmlConcat Html a
    x Html a
    y

    instance Monoid (Html a) where
      mempty :: Html a
    mempty = Html a
    forall a. Html a
    HtmlNull
      mappend :: Html a -> Html a -> Html a
    mappend = Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance HasAttributes (Html a) where
      addAttributes :: Attributes -> Html a -> Html a
    addAttributes Attributes
    attrs Html a
    x = (Attribute -> Html a -> Html a) -> Html a -> Attributes -> Html a
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute Html a
    x Attributes
    attrs

    instance ToPlainText (Html a) where
      toPlainText :: Html a -> Text
    toPlainText Html a
    h =
        case Html a
    h of
          HtmlElement ElementType
    InlineElement Text
    "span" Attributes
    attr (Just Html a
    x)
            -> case Text -> Attributes -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "data-emoji" Attributes
    attr of
                  Just Text
    alias -> Text
    ":" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    alias Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ":"
                  Maybe Text
    Nothing    -> Html a -> Text
    forall a. ToPlainText a => a -> Text
    toPlainText Html a
    x
          HtmlElement ElementType
    _ Text
    _ Attributes
    _ (Just Html a
    x) -> Html a -> Text
    forall a. ToPlainText a => a -> Text
    toPlainText Html a
    x
          HtmlElement ElementType
    _ Text
    _ Attributes
    attrs Maybe (Html a)
    Nothing
                                     -> Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    forall a. Monoid a => a
    mempty (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Attributes -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "alt" Attributes
    attrs
          HtmlText Text
    t                 -> Text
    t
          HtmlConcat Html a
    x Html a
    y             -> Html a -> Text
    forall a. ToPlainText a => a -> Text
    toPlainText Html a
    x Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Html a -> Text
    forall a. ToPlainText a => a -> Text
    toPlainText Html a
    y
          Html a
    _                          -> Text
    forall a. Monoid a => a
    mempty

    -- This instance mirrors what is expected in the spec tests.
    instance Rangeable (Html a) => IsInline (Html a) where
      lineBreak :: Html a
    lineBreak = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "br" Maybe (Html a)
    forall a. Maybe a
    Nothing Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Html a
    forall a. Html a
    nl
      softBreak :: Html a
    softBreak = Html a
    forall a. Html a
    nl
      str :: Text -> Html a
    str Text
    t = Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    t
      entity :: Text -> Html a
    entity Text
    t = case Text -> Maybe Text
    lookupEntity (Int -> Text -> Text
    T.drop Int
    1 Text
    t) of
                       Just Text
    t' -> Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    t'
                       Maybe Text
    Nothing -> Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    t
      escapedChar :: Char -> Html a
    escapedChar Char
    c = Text -> Html a
    forall a. Text -> Html a
    htmlText (Char -> Text
    T.singleton Char
    c)
      emph :: Html a -> Html a
    emph Html a
    ils = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "em" (Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just Html a
    ils)
      strong :: Html a -> Html a
    strong Html a
    ils = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "strong" (Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just Html a
    ils)
      link :: Text -> Text -> Html a -> Html a
    link Text
    target Text
    title Html a
    ils =
        Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "href", Text -> Text
    escapeURI Text
    target) (Html a -> Html a) -> (Html a -> Html a) -> Html a -> Html a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (if Text -> Bool
    T.null Text
    title
            then Html a -> Html a
    forall a. a -> a
    id
            else Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "title", Text
    title)) (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
        Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "a" (Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just Html a
    ils)
      image :: Text -> Text -> Html a -> Html a
    image Text
    target Text
    title Html a
    ils =
        Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "src", Text -> Text
    escapeURI Text
    target) (Html a -> Html a) -> (Html a -> Html a) -> Html a -> Html a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "alt", Html a -> Text
    forall a. ToPlainText a => a -> Text
    toPlainText Html a
    ils) (Html a -> Html a) -> (Html a -> Html a) -> Html a -> Html a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (if Text -> Bool
    T.null Text
    title
            then Html a -> Html a
    forall a. a -> a
    id
            else Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "title", Text
    title)) (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
        Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "img" Maybe (Html a)
    forall a. Maybe a
    Nothing
      code :: Text -> Html a
    code Text
    t = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "code" (Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    t))
      rawInline :: Format -> Text -> Html a
    rawInline Format
    f Text
    t
        | Format
    f Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Format
    Format Text
    "html" = Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    t
        | Bool
    otherwise          = Html a
    forall a. Monoid a => a
    mempty

    instance IsInline (Html a) => IsBlock (Html a) (Html a) where
      paragraph :: Html a -> Html a
    paragraph Html a
    ils = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "p" (Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just Html a
    ils)
      plain :: Html a -> Html a
    plain Html a
    ils = Html a
    ils Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Html a
    forall a. Html a
    nl
      thematicBreak :: Html a
    thematicBreak = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "hr" Maybe (Html a)
    forall a. Maybe a
    Nothing
      blockQuote :: Html a -> Html a
    blockQuote Html a
    bs = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "blockquote" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a
    forall a. Html a
    nl Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Html a
    bs)
      codeBlock :: Text -> Text -> Html a
    codeBlock Text
    info Text
    t =
        Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "pre" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
    forall a b. (a -> b) -> a -> b
    $
        (if Text -> Bool
    T.null Text
    lang
            then Html a -> Html a
    forall a. a -> a
    id
            else Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class", Text
    "language-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    lang)) (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
        Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "code" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    t)
        where lang :: Text
    lang = (Char -> Bool) -> Text -> Text
    T.takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace) Text
    info
      heading :: Int -> Html a -> Html a
    heading Int
    level Html a
    ils = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    h (Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just Html a
    ils)
        where h :: Text
    h = case Int
    level of
                       Int
    1 -> Text
    "h1"
                       Int
    2 -> Text
    "h2"
                       Int
    3 -> Text
    "h3"
                       Int
    4 -> Text
    "h4"
                       Int
    5 -> Text
    "h5"
                       Int
    6 -> Text
    "h6"
                       Int
    _ -> Text
    "p"
      rawBlock :: Format -> Text -> Html a
    rawBlock Format
    f Text
    t
        | Format
    f Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Format
    Format Text
    "html" = Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    t
        | Bool
    otherwise          = Html a
    forall a. Monoid a => a
    mempty
      referenceLinkDefinition :: Text -> Attribute -> Html a
    referenceLinkDefinition Text
    _ Attribute
    _ = Html a
    forall a. Monoid a => a
    mempty
      list :: ListType -> ListSpacing -> [Html a] -> Html a
    list (BulletList Char
    _) ListSpacing
    lSpacing [Html a]
    items =
        Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "ul" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a
    forall a. Html a
    nl Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> [Html a] -> Html a
    forall a. Monoid a => [a] -> a
    mconcat ((Html a -> Html a) -> [Html a] -> [Html a]
    forall a b. (a -> b) -> [a] -> [b]
    map Html a -> Html a
    forall {a}. Html a -> Html a
    li [Html a]
    items))
       where li :: Html a -> Html a
    li Html a
    x = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "li" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $
                       Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just ((if ListSpacing
    lSpacing ListSpacing -> ListSpacing -> Bool
    forall a. Eq a => a -> a -> Bool
    == ListSpacing
    TightList
                                 then Html a
    forall a. Monoid a => a
    mempty
                                 else Html a
    forall a. Html a
    nl) Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Html a
    x)
      list (OrderedList Int
    startnum EnumeratorType
    enumtype DelimiterType
    _delimtype) ListSpacing
    lSpacing [Html a]
    items =
        (if Int
    startnum Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    1
            then Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "start", String -> Text
    T.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    startnum))
            else Html a -> Html a
    forall a. a -> a
    id) (Html a -> Html a) -> (Html a -> Html a) -> Html a -> Html a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (case EnumeratorType
    enumtype of
           EnumeratorType
    Decimal  -> Html a -> Html a
    forall a. a -> a
    id
           EnumeratorType
    UpperAlpha -> Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "type", Text
    "A")
           EnumeratorType
    LowerAlpha -> Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "type", Text
    "a")
           EnumeratorType
    UpperRoman -> Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "type", Text
    "I")
           EnumeratorType
    LowerRoman -> Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "type", Text
    "i"))
        (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "ol" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $
          Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a
    forall a. Html a
    nl Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> [Html a] -> Html a
    forall a. Monoid a => [a] -> a
    mconcat ((Html a -> Html a) -> [Html a] -> [Html a]
    forall a b. (a -> b) -> [a] -> [b]
    map Html a -> Html a
    forall {a}. Html a -> Html a
    li [Html a]
    items))
       where li :: Html a -> Html a
    li Html a
    x = Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "li" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $
                       Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just ((if ListSpacing
    lSpacing ListSpacing -> ListSpacing -> Bool
    forall a. Eq a => a -> a -> Bool
    == ListSpacing
    TightList
                                 then Html a
    forall a. Monoid a => a
    mempty
                                 else Html a
    forall a. Html a
    nl) Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Html a
    x)

    nl :: Html a
    nl :: forall a. Html a
    nl = Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    "\n"

    instance Rangeable (Html ()) where
      ranged :: SourceRange -> Html () -> Html ()
    ranged SourceRange
    _ Html ()
    x = Html ()
    x

    instance Rangeable (Html SourceRange) where
      ranged :: SourceRange -> Html SourceRange -> Html SourceRange
    ranged SourceRange
    sr Html SourceRange
    x = Attribute -> Html SourceRange -> Html SourceRange
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "data-sourcepos", String -> Text
    T.pack (SourceRange -> String
    forall a. Show a => a -> String
    show SourceRange
    sr)) Html SourceRange
    x

    htmlInline :: Text -> Maybe (Html a) -> Html a
    htmlInline :: forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    tagname = ElementType -> Text -> Attributes -> Maybe (Html a) -> Html a
    forall a.
    ElementType -> Text -> Attributes -> Maybe (Html a) -> Html a
    HtmlElement ElementType
    InlineElement Text
    tagname []

    htmlBlock :: Text -> Maybe (Html a) -> Html a
    htmlBlock :: forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    tagname Maybe (Html a)
    mbcontents = ElementType -> Text -> Attributes -> Maybe (Html a) -> Html a
    forall a.
    ElementType -> Text -> Attributes -> Maybe (Html a) -> Html a
    HtmlElement ElementType
    BlockElement Text
    tagname [] Maybe (Html a)
    mbcontents

    htmlText :: Text -> Html a
    htmlText :: forall a. Text -> Html a
    htmlText = Text -> Html a
    forall a. Text -> Html a
    HtmlText

    htmlRaw :: Text -> Html a
    htmlRaw :: forall a. Text -> Html a
    htmlRaw = Text -> Html a
    forall a. Text -> Html a
    HtmlRaw

    addAttribute :: Attribute -> Html a -> Html a
    addAttribute :: forall a. Attribute -> Html a -> Html a
    addAttribute Attribute
    attr (HtmlElement ElementType
    eltType Text
    tagname Attributes
    attrs Maybe (Html a)
    mbcontents) =
      ElementType -> Text -> Attributes -> Maybe (Html a) -> Html a
    forall a.
    ElementType -> Text -> Attributes -> Maybe (Html a) -> Html a
    HtmlElement ElementType
    eltType Text
    tagname (Attribute -> Attributes -> Attributes
    incorporateAttribute Attribute
    attr Attributes
    attrs) Maybe (Html a)
    mbcontents
    addAttribute Attribute
    attr (HtmlText Text
    t)
      = Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute Attribute
    attr (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $ ElementType -> Text -> Attributes -> Maybe (Html a) -> Html a
    forall a.
    ElementType -> Text -> Attributes -> Maybe (Html a) -> Html a
    HtmlElement ElementType
    InlineElement Text
    "span" [] (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Text -> Html a
    forall a. Text -> Html a
    HtmlText Text
    t)
    addAttribute Attribute
    _ Html a
    elt = Html a
    elt

    incorporateAttribute :: Attribute -> [Attribute] -> [Attribute]
    incorporateAttribute :: Attribute -> Attributes -> Attributes
    incorporateAttribute (Text
    k, Text
    v) Attributes
    as =
      case Text -> Attributes -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    k' Attributes
    as of
        Maybe Text
    Nothing            -> (Text
    k', Text
    v) Attribute -> Attributes -> Attributes
    forall a. a -> [a] -> [a]
    : Attributes
    as
        Just Text
    v'            -> (if Text
    k' Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "class"
                                  then (Text
    "class", Text
    v Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    v')
                                  else (Text
    k', Text
    v')) Attribute -> Attributes -> Attributes
    forall a. a -> [a] -> [a]
    :
                              (Attribute -> Bool) -> Attributes -> Attributes
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(Text
    x, Text
    _) -> Text
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    k') Attributes
    as
     where
      k' :: Text
    k' = if Text
    k Text -> Set Text -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Text
    html5Attributes
                Bool -> Bool -> Bool
    || Text
    "data-" Text -> Text -> Bool
    `T.isPrefixOf` Text
    k
              then Text
    k
              else Text
    "data-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    k

    html5Attributes :: Set.Set Text
    html5Attributes :: Set Text
    html5Attributes = [Text] -> Set Text
    forall a. Ord a => [a] -> Set a
    Set.fromList
      [ Text
    "abbr"
      , Text
    "accept"
      , Text
    "accept-charset"
      , Text
    "accesskey"
      , Text
    "action"
      , Text
    "allow"
      , Text
    "allowfullscreen"
      , Text
    "allowpaymentrequest"
      , Text
    "allowusermedia"
      , Text
    "alt"
      , Text
    "as"
      , Text
    "async"
      , Text
    "autocapitalize"
      , Text
    "autocomplete"
      , Text
    "autofocus"
      , Text
    "autoplay"
      , Text
    "charset"
      , Text
    "checked"
      , Text
    "cite"
      , Text
    "class"
      , Text
    "color"
      , Text
    "cols"
      , Text
    "colspan"
      , Text
    "content"
      , Text
    "contenteditable"
      , Text
    "controls"
      , Text
    "coords"
      , Text
    "crossorigin"
      , Text
    "data"
      , Text
    "datetime"
      , Text
    "decoding"
      , Text
    "default"
      , Text
    "defer"
      , Text
    "dir"
      , Text
    "dirname"
      , Text
    "disabled"
      , Text
    "download"
      , Text
    "draggable"
      , Text
    "enctype"
      , Text
    "enterkeyhint"
      , Text
    "for"
      , Text
    "form"
      , Text
    "formaction"
      , Text
    "formenctype"
      , Text
    "formmethod"
      , Text
    "formnovalidate"
      , Text
    "formtarget"
      , Text
    "headers"
      , Text
    "height"
      , Text
    "hidden"
      , Text
    "high"
      , Text
    "href"
      , Text
    "hreflang"
      , Text
    "http-equiv"
      , Text
    "id"
      , Text
    "imagesizes"
      , Text
    "imagesrcset"
      , Text
    "inputmode"
      , Text
    "integrity"
      , Text
    "is"
      , Text
    "ismap"
      , Text
    "itemid"
      , Text
    "itemprop"
      , Text
    "itemref"
      , Text
    "itemscope"
      , Text
    "itemtype"
      , Text
    "kind"
      , Text
    "label"
      , Text
    "lang"
      , Text
    "list"
      , Text
    "loading"
      , Text
    "loop"
      , Text
    "low"
      , Text
    "manifest"
      , Text
    "max"
      , Text
    "maxlength"
      , Text
    "media"
      , Text
    "method"
      , Text
    "min"
      , Text
    "minlength"
      , Text
    "multiple"
      , Text
    "muted"
      , Text
    "name"
      , Text
    "nomodule"
      , Text
    "nonce"
      , Text
    "novalidate"
      , Text
    "onabort"
      , Text
    "onafterprint"
      , Text
    "onauxclick"
      , Text
    "onbeforeprint"
      , Text
    "onbeforeunload"
      , Text
    "onblur"
      , Text
    "oncancel"
      , Text
    "oncanplay"
      , Text
    "oncanplaythrough"
      , Text
    "onchange"
      , Text
    "onclick"
      , Text
    "onclose"
      , Text
    "oncontextmenu"
      , Text
    "oncopy"
      , Text
    "oncuechange"
      , Text
    "oncut"
      , Text
    "ondblclick"
      , Text
    "ondrag"
      , Text
    "ondragend"
      , Text
    "ondragenter"
      , Text
    "ondragexit"
      , Text
    "ondragleave"
      , Text
    "ondragover"
      , Text
    "ondragstart"
      , Text
    "ondrop"
      , Text
    "ondurationchange"
      , Text
    "onemptied"
      , Text
    "onended"
      , Text
    "onerror"
      , Text
    "onfocus"
      , Text
    "onhashchange"
      , Text
    "oninput"
      , Text
    "oninvalid"
      , Text
    "onkeydown"
      , Text
    "onkeypress"
      , Text
    "onkeyup"
      , Text
    "onlanguagechange"
      , Text
    "onload"
      , Text
    "onloadeddata"
      , Text
    "onloadedmetadata"
      , Text
    "onloadend"
      , Text
    "onloadstart"
      , Text
    "onmessage"
      , Text
    "onmessageerror"
      , Text
    "onmousedown"
      , Text
    "onmouseenter"
      , Text
    "onmouseleave"
      , Text
    "onmousemove"
      , Text
    "onmouseout"
      , Text
    "onmouseover"
      , Text
    "onmouseup"
      , Text
    "onoffline"
      , Text
    "ononline"
      , Text
    "onpagehide"
      , Text
    "onpageshow"
      , Text
    "onpaste"
      , Text
    "onpause"
      , Text
    "onplay"
      , Text
    "onplaying"
      , Text
    "onpopstate"
      , Text
    "onprogress"
      , Text
    "onratechange"
      , Text
    "onrejectionhandled"
      , Text
    "onreset"
      , Text
    "onresize"
      , Text
    "onscroll"
      , Text
    "onsecuritypolicyviolation"
      , Text
    "onseeked"
      , Text
    "onseeking"
      , Text
    "onselect"
      , Text
    "onstalled"
      , Text
    "onstorage"
      , Text
    "onsubmit"
      , Text
    "onsuspend"
      , Text
    "ontimeupdate"
      , Text
    "ontoggle"
      , Text
    "onunhandledrejection"
      , Text
    "onunload"
      , Text
    "onvolumechange"
      , Text
    "onwaiting"
      , Text
    "onwheel"
      , Text
    "open"
      , Text
    "optimum"
      , Text
    "pattern"
      , Text
    "ping"
      , Text
    "placeholder"
      , Text
    "playsinline"
      , Text
    "poster"
      , Text
    "preload"
      , Text
    "readonly"
      , Text
    "referrerpolicy"
      , Text
    "rel"
      , Text
    "required"
      , Text
    "reversed"
      , Text
    "role"
      , Text
    "rows"
      , Text
    "rowspan"
      , Text
    "sandbox"
      , Text
    "scope"
      , Text
    "selected"
      , Text
    "shape"
      , Text
    "size"
      , Text
    "sizes"
      , Text
    "slot"
      , Text
    "span"
      , Text
    "spellcheck"
      , Text
    "src"
      , Text
    "srcdoc"
      , Text
    "srclang"
      , Text
    "srcset"
      , Text
    "start"
      , Text
    "step"
      , Text
    "style"
      , Text
    "tabindex"
      , Text
    "target"
      , Text
    "title"
      , Text
    "translate"
      , Text
    "type"
      , Text
    "typemustmatch"
      , Text
    "updateviacache"
      , Text
    "usemap"
      , Text
    "value"
      , Text
    "width"
      , Text
    "workertype"
      , Text
    "wrap"
      ]

    renderHtml :: Html a -> TL.Text
    renderHtml :: forall a. Html a -> Text
    renderHtml = {-# SCC renderHtml #-} Builder -> Text
    toLazyText (Builder -> Text) -> (Html a -> Builder) -> Html a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html a -> Builder
    forall a. Html a -> Builder
    toBuilder

    toBuilder :: Html a -> Builder
    toBuilder :: forall a. Html a -> Builder
    toBuilder Html a
    HtmlNull = Builder
    forall a. Monoid a => a
    mempty
    toBuilder (HtmlConcat Html a
    x Html a
    y) = Html a -> Builder
    forall a. Html a -> Builder
    toBuilder Html a
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Html a -> Builder
    forall a. Html a -> Builder
    toBuilder Html a
    y
    toBuilder (HtmlRaw Text
    t) = Text -> Builder
    fromText Text
    t
    toBuilder (HtmlText Text
    t) = Text -> Builder
    escapeHtml Text
    t
    toBuilder (HtmlElement ElementType
    eltType Text
    tagname Attributes
    attrs Maybe (Html a)
    mbcontents) =
      Builder
    "<" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    fromText Text
    tagname Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ((Attribute -> Builder) -> Attributes -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map Attribute -> Builder
    toAttr Attributes
    attrs) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    filling Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    nl'
      where
        toAttr :: Attribute -> Builder
    toAttr (Text
    x,Text
    y) = Builder
    " " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    fromText Text
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    "=\"" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    escapeHtml Text
    y Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    "\""
        nl' :: Builder
    nl' = case ElementType
    eltType of
               ElementType
    BlockElement -> Builder
    "\n"
               ElementType
    _            -> Builder
    forall a. Monoid a => a
    mempty
        filling :: Builder
    filling = case Maybe (Html a)
    mbcontents of
                     Maybe (Html a)
    Nothing   -> Builder
    " />"
                     Just Html a
    cont -> Builder
    ">" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Html a -> Builder
    forall a. Html a -> Builder
    toBuilder Html a
    cont Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    "</" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                                  Text -> Builder
    fromText Text
    tagname Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    ">"

    escapeHtml :: Text -> Builder
    escapeHtml :: Text -> Builder
    escapeHtml Text
    t =
      case Text -> Maybe (Char, Text)
    T.uncons Text
    post of
        Just (Char
    c, Text
    rest) -> Text -> Builder
    fromText Text
    pre Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    escapeHtmlChar Char
    c Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    escapeHtml Text
    rest
        Maybe (Char, Text)
    Nothing        -> Text -> Builder
    fromText Text
    pre
     where
      (Text
    pre,Text
    post)        = (Char -> Bool) -> Text -> Attribute
    T.break Char -> Bool
    needsEscaping Text
    t
      needsEscaping :: Char -> Bool
    needsEscaping Char
    '<' = Bool
    True
      needsEscaping Char
    '>' = Bool
    True
      needsEscaping Char
    '&' = Bool
    True
      needsEscaping Char
    '"' = Bool
    True
      needsEscaping Char
    _   = Bool
    False

    escapeHtmlChar :: Char -> Builder
    escapeHtmlChar :: Char -> Builder
    escapeHtmlChar Char
    '<' = Builder
    "&lt;"
    escapeHtmlChar Char
    '>' = Builder
    "&gt;"
    escapeHtmlChar Char
    '&' = Builder
    "&amp;"
    escapeHtmlChar Char
    '"' = Builder
    "&quot;"
    escapeHtmlChar Char
    c   = Char -> Builder
    singleton Char
    c

    escapeURI :: Text -> Text
    escapeURI :: Text -> Text
    escapeURI = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Text) -> String -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Text
    escapeURIChar (String -> [Text]) -> (Text -> String) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    B.unpack (ByteString -> String) -> (Text -> ByteString) -> Text -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ByteString
    encodeUtf8

    escapeURIChar :: Char -> Text
    escapeURIChar :: Char -> Text
    escapeURIChar Char
    c
      | Char -> Bool
    isEscapable Char
    c = Char -> Text
    T.singleton Char
    '%' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (String -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02X" (Char -> Int
    ord Char
    c))
      | Bool
    otherwise     = Char -> Text
    T.singleton Char
    c
      where isEscapable :: Char -> Bool
    isEscapable Char
    d = Bool -> Bool
    not (Char -> Bool
    isAscii Char
    d Bool -> Bool -> Bool
    && Char -> Bool
    isAlphaNum Char
    d)
                         Bool -> Bool -> Bool
    && Char
    d Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Char
    '%',Char
    '/',Char
    '?',Char
    ':',Char
    '@',Char
    '-',Char
    '.',Char
    '_',Char
    '~',Char
    '&',
                                         Char
    '#',Char
    '!',Char
    '$',Char
    '\'',Char
    '(',Char
    ')',Char
    '*',Char
    '+',Char
    ',',
                                         Char
    ';',Char
    '=']