    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ViewPatterns      #-}
    {- |
       Module      : Text.Pandoc.XML
       Copyright   : Copyright (C) 2006-2020 John MacFarlane
       License     : GNU GPL, version 2 or above

       Maintainer  : John MacFarlane <jgm@berkeley.edu>
       Stability   : alpha
       Portability : portable

    Functions for escaping and formatting XML.
    -}
    module Text.Pandoc.XML ( escapeCharForXML,
                             escapeStringForXML,
                             inTags,
                             selfClosingTag,
                             inTagsSimple,
                             inTagsIndented,
                             toEntities,
                             toHtml5Entities,
                             fromEntities,
                             html4Attributes,
                             html5Attributes,
                             rdfaAttributes ) where

    import Data.Char (isAscii, isSpace, ord)
    import Data.Text (Text)
    import qualified Data.Text as T
    import Text.HTML.TagSoup.Entity (lookupEntity, htmlEntities)
    import Text.DocLayout
    import Text.Printf (printf)
    import qualified Data.Map as M
    import Data.String
    import qualified Data.Set as Set

    -- | Escape one character as needed for XML.
    escapeCharForXML :: Char -> Text
    escapeCharForXML :: Char -> Text
    escapeCharForXML x :: Char
    x = case Char
    x of
                           '&' -> "&amp;"
                           '<' -> "&lt;"
                           '>' -> "&gt;"
                           '"' -> "&quot;"
                           c :: Char
    c   -> Char -> Text
    T.singleton Char
    c

    -- | Escape string as needed for XML.  Entity references are not preserved.
    escapeStringForXML :: Text -> Text
    escapeStringForXML :: Text -> Text
    escapeStringForXML = (Char -> Text) -> Text -> Text
    T.concatMap Char -> Text
    escapeCharForXML (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> Text -> Text
    T.filter Char -> Bool
    isLegalXMLChar
      where isLegalXMLChar :: Char -> Bool
    isLegalXMLChar c :: Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\t' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\n' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\r' Bool -> Bool -> Bool
    ||
                               (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= '\x20' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= '\xD7FF') Bool -> Bool -> Bool
    ||
                               (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= '\xE000' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= '\xFFFD') Bool -> Bool -> Bool
    ||
                               (Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= '\x10000' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= '\x10FFFF')
      -- see https://www.w3.org/TR/xml/#charsets

    -- | Escape newline characters as &#10;
    escapeNls :: Text -> Text
    escapeNls :: Text -> Text
    escapeNls = (Char -> Text) -> Text -> Text
    T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ \x :: Char
    x -> case Char
    x of
      '\n' -> "&#10;"
      c :: Char
    c    -> Char -> Text
    T.singleton Char
    c

    -- | Return a text object with a string of formatted XML attributes.
    attributeList :: (HasChars a, IsString a) => [(Text, Text)] -> Doc a
    attributeList :: [(Text, Text)] -> Doc a
    attributeList = [Doc a] -> Doc a
    forall a. [Doc a] -> Doc a
    hcat ([Doc a] -> Doc a)
    -> ([(Text, Text)] -> [Doc a]) -> [(Text, Text)] -> Doc a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, Text) -> Doc a) -> [(Text, Text)] -> [Doc a]
    forall a b. (a -> b) -> [a] -> [b]
    map
      (\(a :: Text
    a, b :: Text
    b) -> String -> Doc a
    forall a. HasChars a => String -> Doc a
    text (Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    escapeStringForXML Text
    a Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "=\"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
      Text -> Text
    escapeNls (Text -> Text
    escapeStringForXML Text
    b) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "\""))

    -- | Put the supplied contents between start and end tags of tagType,
    --   with specified attributes and (if specified) indentation.
    inTags :: (HasChars a, IsString a)
          => Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags :: Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags isIndented :: Bool
    isIndented tagType :: Text
    tagType attribs :: [(Text, Text)]
    attribs contents :: Doc a
    contents =
      let openTag :: Doc a
    openTag = Char -> Doc a
    forall a. HasChars a => Char -> Doc a
    char '<' Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc a
    forall a. HasChars a => String -> Doc a
    text (Text -> String
    T.unpack Text
    tagType) Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> [(Text, Text)] -> Doc a
    forall a. (HasChars a, IsString a) => [(Text, Text)] -> Doc a
    attributeList [(Text, Text)]
    attribs Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <>
                    Char -> Doc a
    forall a. HasChars a => Char -> Doc a
    char '>'
          closeTag :: Doc a
    closeTag  = String -> Doc a
    forall a. HasChars a => String -> Doc a
    text "</" Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc a
    forall a. HasChars a => String -> Doc a
    text (Text -> String
    T.unpack Text
    tagType) Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Char -> Doc a
    forall a. HasChars a => Char -> Doc a
    char '>'
      in  if Bool
    isIndented
             then Doc a
    openTag Doc a -> Doc a -> Doc a
    forall a. Doc a -> Doc a -> Doc a
    $$ Int -> Doc a -> Doc a
    forall a. IsString a => Int -> Doc a -> Doc a
    nest 2 Doc a
    contents Doc a -> Doc a -> Doc a
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc a
    closeTag
             else Doc a
    openTag Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    contents Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    closeTag

    -- | Return a self-closing tag of tagType with specified attributes
    selfClosingTag :: (HasChars a, IsString a)
                   => Text -> [(Text, Text)] -> Doc a
    selfClosingTag :: Text -> [(Text, Text)] -> Doc a
    selfClosingTag tagType :: Text
    tagType attribs :: [(Text, Text)]
    attribs =
      Char -> Doc a
    forall a. HasChars a => Char -> Doc a
    char '<' Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc a
    forall a. HasChars a => String -> Doc a
    text (Text -> String
    T.unpack Text
    tagType) Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> [(Text, Text)] -> Doc a
    forall a. (HasChars a, IsString a) => [(Text, Text)] -> Doc a
    attributeList [(Text, Text)]
    attribs Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc a
    forall a. HasChars a => String -> Doc a
    text " />"

    -- | Put the supplied contents between start and end tags of tagType.
    inTagsSimple :: (HasChars a, IsString a)
                 => Text -> Doc a -> Doc a
    inTagsSimple :: Text -> Doc a -> Doc a
    inTagsSimple tagType :: Text
    tagType = Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    False Text
    tagType []

    -- | Put the supplied contents in indented block btw start and end tags.
    inTagsIndented :: (HasChars a, IsString a)
                   => Text -> Doc a -> Doc a
    inTagsIndented :: Text -> Doc a -> Doc a
    inTagsIndented tagType :: Text
    tagType = Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    True Text
    tagType []

    -- | Escape all non-ascii characters using numerical entities.
    toEntities :: Text -> Text
    toEntities :: Text -> Text
    toEntities = (Char -> Text) -> Text -> Text
    T.concatMap Char -> Text
    go
      where go :: Char -> Text
    go c :: Char
    c | Char -> Bool
    isAscii Char
    c = Char -> Text
    T.singleton Char
    c
                 | Bool
    otherwise = String -> Text
    T.pack (String -> Int -> String
    forall r. PrintfType r => String -> r
    printf "&#x%X;" (Char -> Int
    ord Char
    c))

    -- | Escape all non-ascii characters using HTML5 entities, falling
    -- back to numerical entities.
    toHtml5Entities :: Text -> Text
    toHtml5Entities :: Text -> Text
    toHtml5Entities = (Char -> Text) -> Text -> Text
    T.concatMap Char -> Text
    go
      where go :: Char -> Text
    go c :: Char
    c | Char -> Bool
    isAscii Char
    c = Char -> Text
    T.singleton Char
    c
                 | Bool
    otherwise =
                     case Char -> Map Char Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Char
    c Map Char Text
    html5EntityMap of
                       Just t :: Text
    t  -> Char -> Text
    T.singleton '&' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Char -> Text
    T.singleton ';'
                       Nothing -> String -> Text
    T.pack ("&#" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Char -> Int
    ord Char
    c) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ";")

    html5EntityMap :: M.Map Char Text
    html5EntityMap :: Map Char Text
    html5EntityMap = ((String, String) -> Map Char Text -> Map Char Text)
    -> Map Char Text -> [(String, String)] -> Map Char Text
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (String, String) -> Map Char Text -> Map Char Text
    forall k. Ord k => (String, [k]) -> Map k Text -> Map k Text
    go Map Char Text
    forall a. Monoid a => a
    mempty [(String, String)]
    htmlEntities
      where go :: (String, [k]) -> Map k Text -> Map k Text
    go (ent :: String
    ent, s :: [k]
    s) entmap :: Map k Text
    entmap =
             case [k]
    s of
               [c :: k
    c] -> (Text -> Text -> Text) -> k -> Text -> Map k Text -> Map k Text
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith
                       (\new :: Text
    new old :: Text
    old -> if Text -> Int
    T.length Text
    new Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Text -> Int
    T.length Text
    old
                                       then Text
    old
                                       else Text
    new) k
    c Text
    ent' Map k Text
    entmap
                 where ent' :: Text
    ent' = (Char -> Bool) -> Text -> Text
    T.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=';') (String -> Text
    T.pack String
    ent)
               _   -> Map k Text
    entmap

    -- Unescapes XML entities
    fromEntities :: Text -> Text
    fromEntities :: Text -> Text
    fromEntities = String -> Text
    T.pack (String -> Text) -> (Text -> String) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    fromEntities'

    fromEntities' :: Text -> String
    fromEntities' :: Text -> String
    fromEntities' (Text -> Maybe (Char, Text)
    T.uncons -> Just ('&', xs :: Text
    xs)) =
      case String -> Maybe String
    lookupEntity (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    ent' of
            Just c :: String
    c  -> String
    c String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    fromEntities' Text
    rest
            Nothing -> "&" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    fromEntities' Text
    xs
        where (ent :: Text
    ent, rest :: Text
    rest) = case (Char -> Bool) -> Text -> (Text, Text)
    T.break (\c :: Char
    c -> Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ';') Text
    xs of
                              (zs :: Text
    zs,Text -> Maybe (Char, Text)
    T.uncons -> Just (';',ys :: Text
    ys)) -> (Text
    zs,Text
    ys)
                              (zs :: Text
    zs, ys :: Text
    ys) -> (Text
    zs,Text
    ys)
              ent' :: Text
    ent'
                | Just ys :: Text
    ys <- Text -> Text -> Maybe Text
    T.stripPrefix "#X" Text
    ent = "#x" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ys  -- workaround tagsoup bug
                | Just ('#', _) <- Text -> Maybe (Char, Text)
    T.uncons Text
    ent     = Text
    ent
                | Bool
    otherwise                         = Text
    ent Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ";"
    fromEntities' t :: Text
    t = case Text -> Maybe (Char, Text)
    T.uncons Text
    t of
      Just (x :: Char
    x, xs :: Text
    xs) -> Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : Text -> String
    fromEntities' Text
    xs
      Nothing      -> ""

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

    -- See https://en.wikipedia.org/wiki/RDFa, https://www.w3.org/TR/rdfa-primer/
    rdfaAttributes :: Set.Set Text
    rdfaAttributes :: Set Text
    rdfaAttributes = [Text] -> Set Text
    forall a. Ord a => [a] -> Set a
    Set.fromList
      [ "about"
      , "rel"
      , "rev"
      , "src"
      , "href"
      , "resource"
      , "property"
      , "content"
      , "datatype"
      , "typeof"
      , "vocab"
      , "prefix"
      ]

    html4Attributes :: Set.Set Text
    html4Attributes :: Set Text
    html4Attributes = [Text] -> Set Text
    forall a. Ord a => [a] -> Set a
    Set.fromList
      [ "abbr"
      , "accept"
      , "accept-charset"
      , "accesskey"
      , "action"
      , "align"
      , "alink"
      , "alt"
      , "archive"
      , "axis"
      , "background"
      , "bgcolor"
      , "border"
      , "cellpadding"
      , "cellspacing"
      , "char"
      , "charoff"
      , "charset"
      , "checked"
      , "cite"
      , "class"
      , "classid"
      , "clear"
      , "code"
      , "codebase"
      , "codetype"
      , "color"
      , "cols"
      , "colspan"
      , "compact"
      , "content"
      , "coords"
      , "data"
      , "datetime"
      , "declare"
      , "defer"
      , "dir"
      , "disabled"
      , "enctype"
      , "face"
      , "for"
      , "frame"
      , "frameborder"
      , "headers"
      , "height"
      , "href"
      , "hreflang"
      , "hspace"
      , "http-equiv"
      , "id"
      , "ismap"
      , "label"
      , "lang"
      , "language"
      , "link"
      , "longdesc"
      , "marginheight"
      , "marginwidth"
      , "maxlength"
      , "media"
      , "method"
      , "multiple"
      , "name"
      , "nohref"
      , "noresize"
      , "noshade"
      , "nowrap"
      , "object"
      , "onblur"
      , "onchange"
      , "onclick"
      , "ondblclick"
      , "onfocus"
      , "onkeydown"
      , "onkeypress"
      , "onkeyup"
      , "onload"
      , "onmousedown"
      , "onmousemove"
      , "onmouseout"
      , "onmouseover"
      , "onmouseup"
      , "onreset"
      , "onselect"
      , "onsubmit"
      , "onunload"
      , "profile"
      , "prompt"
      , "readonly"
      , "rel"
      , "rev"
      , "rows"
      , "rowspan"
      , "rules"
      , "scheme"
      , "scope"
      , "scrolling"
      , "selected"
      , "shape"
      , "size"
      , "span"
      , "src"
      , "standby"
      , "start"
      , "style"
      , "summary"
      , "tabindex"
      , "target"
      , "text"
      , "title"
      , "usemap"
      , "valign"
      , "value"
      , "valuetype"
      , "version"
      , "vlink"
      , "vspace"
      , "width"
      ]