    {-# OPTIONS_HADDOCK hide #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Text.XHtml.internals
    -- Copyright   :  (c) Andy Gill, and the Oregon Graduate Institute of
    --                Science and Technology, 1999-2001,
    --                (c) Bjorn Bringert, 2004-2006
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Chris Dornan <chris@chrisdornan.com>
    -- Stability   :  Stable
    -- Portability :  Portable
    --
    -- Internals of the XHTML combinator library.
    -----------------------------------------------------------------------------
    module Text.XHtml.Internals where

    import Data.Char
    import qualified Data.Semigroup as Sem
    import qualified Data.Monoid as Mon

    infixr 2 +++  -- combining Html
    infixr 7 <<   -- nesting Html
    infixl 8 !    -- adding optional arguments

    --
    -- * Data types
    --

    -- | A important property of Html is that all strings inside the
    -- structure are already in Html friendly format.
    data HtmlElement
          = HtmlString String
            -- ^ ..just..plain..normal..text... but using &copy; and &amb;, etc.
          | HtmlTag {
                  HtmlElement -> String
    markupTag      :: String,
                  HtmlElement -> [HtmlAttr]
    markupAttrs    :: [HtmlAttr],
                  HtmlElement -> Html
    markupContent  :: Html
                  }
            -- ^ tag with internal markup

    -- | Attributes with name and value.
    data HtmlAttr = HtmlAttr String String

    htmlAttrPair :: HtmlAttr -> (String,String)
    htmlAttrPair :: HtmlAttr -> (String, String)
    htmlAttrPair (HtmlAttr String
    n String
    v) = (String
    n,String
    v)

    newtype Html = Html { Html -> [HtmlElement]
    getHtmlElements :: [HtmlElement] }

    --
    -- * Classes
    --

    instance Show Html where
          showsPrec :: Int -> Html -> ShowS
    showsPrec Int
    _ Html
    html = String -> ShowS
    showString (Html -> String
    forall html. HTML html => html -> String
    renderHtmlFragment Html
    html)
          showList :: [Html] -> ShowS
    showList [Html]
    htmls   = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id ((Html -> ShowS) -> [Html] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map Html -> ShowS
    forall a. Show a => a -> ShowS
    shows [Html]
    htmls)

    instance Show HtmlAttr where
          showsPrec :: Int -> HtmlAttr -> ShowS
    showsPrec Int
    _ (HtmlAttr String
    str String
    val) =
                  String -> ShowS
    showString String
    str ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                  String -> ShowS
    showString String
    "=" ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                  String -> ShowS
    forall a. Show a => a -> ShowS
    shows String
    val

    -- | @since 3000.2.2
    instance Sem.Semigroup Html where
        <> :: Html -> Html -> Html
    (<>) = Html -> Html -> Html
    forall a b. (HTML a, HTML b) => a -> b -> Html
    (+++)

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

    -- | HTML is the class of things that can be validly put
    -- inside an HTML tag. So this can be one or more 'Html' elements,
    -- or a 'String', for example.
    class HTML a where
          toHtml     :: a -> Html
          toHtmlFromList :: [a] -> Html

          toHtmlFromList [a]
    xs = [HtmlElement] -> Html
    Html ([[HtmlElement]] -> [HtmlElement]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [HtmlElement]
    x | (Html [HtmlElement]
    x) <- (a -> Html) -> [a] -> [Html]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Html
    forall a. HTML a => a -> Html
    toHtml [a]
    xs])

    instance HTML Html where
          toHtml :: Html -> Html
    toHtml Html
    a    = Html
    a

    instance HTML Char where
          toHtml :: Char -> Html
    toHtml       Char
    a = String -> Html
    forall a. HTML a => a -> Html
    toHtml [Char
    a]
          toHtmlFromList :: String -> Html
    toHtmlFromList []  = [HtmlElement] -> Html
    Html []
          toHtmlFromList String
    str = [HtmlElement] -> Html
    Html [String -> HtmlElement
    HtmlString (ShowS
    stringToHtmlString String
    str)]

    instance (HTML a) => HTML [a] where
          toHtml :: [a] -> Html
    toHtml [a]
    xs = [a] -> Html
    forall a. HTML a => [a] -> Html
    toHtmlFromList [a]
    xs

    instance HTML a => HTML (Maybe a) where
          toHtml :: Maybe a -> Html
    toHtml = Html -> (a -> Html) -> Maybe a -> Html
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Html
    noHtml a -> Html
    forall a. HTML a => a -> Html
    toHtml

    class ADDATTRS a where
          (!) :: a -> [HtmlAttr] -> a

    -- | CHANGEATTRS is a more expressive alternative to ADDATTRS
    class CHANGEATTRS a where
          changeAttrs :: a -> ([HtmlAttr]->[HtmlAttr]) -> a

    instance (ADDATTRS b) => ADDATTRS (a -> b) where
          a -> b
    fn ! :: (a -> b) -> [HtmlAttr] -> a -> b
    ! [HtmlAttr]
    attr        = \ a
    arg -> a -> b
    fn a
    arg b -> [HtmlAttr] -> b
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [HtmlAttr]
    attr

    instance (CHANGEATTRS b) => CHANGEATTRS (a -> b) where
          changeAttrs :: (a -> b) -> ([HtmlAttr] -> [HtmlAttr]) -> a -> b
    changeAttrs a -> b
    fn [HtmlAttr] -> [HtmlAttr]
    f = \ a
    arg -> b -> ([HtmlAttr] -> [HtmlAttr]) -> b
    forall a. CHANGEATTRS a => a -> ([HtmlAttr] -> [HtmlAttr]) -> a
    changeAttrs (a -> b
    fn a
    arg) [HtmlAttr] -> [HtmlAttr]
    f

    instance ADDATTRS Html where
          (Html [HtmlElement]
    htmls) ! :: Html -> [HtmlAttr] -> Html
    ! [HtmlAttr]
    attr = [HtmlElement] -> Html
    Html ((HtmlElement -> HtmlElement) -> [HtmlElement] -> [HtmlElement]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> HtmlElement
    addAttrs [HtmlElement]
    htmls)
            where
                  addAttrs :: HtmlElement -> HtmlElement
    addAttrs (html :: HtmlElement
    html@(HtmlTag { markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs = [HtmlAttr]
    attrs }) )
                                = HtmlElement
    html { markupAttrs = attrs ++ attr }
                  addAttrs HtmlElement
    html = HtmlElement
    html

    instance CHANGEATTRS Html where
          changeAttrs :: Html -> ([HtmlAttr] -> [HtmlAttr]) -> Html
    changeAttrs (Html [HtmlElement]
    htmls) [HtmlAttr] -> [HtmlAttr]
    f = [HtmlElement] -> Html
    Html ((HtmlElement -> HtmlElement) -> [HtmlElement] -> [HtmlElement]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> HtmlElement
    addAttrs [HtmlElement]
    htmls)
            where
                  addAttrs :: HtmlElement -> HtmlElement
    addAttrs (html :: HtmlElement
    html@(HtmlTag { markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs = [HtmlAttr]
    attrs }) )
                                = HtmlElement
    html { markupAttrs = f attrs }
                  addAttrs HtmlElement
    html = HtmlElement
    html

    --
    -- * Html primitives and basic combinators
    --

    -- | Put something inside an HTML element.
    (<<) :: (HTML a) =>
            (Html -> b) -- ^ Parent
         -> a -- ^ Child
         -> b
    Html -> b
    fn << :: forall a b. HTML a => (Html -> b) -> a -> b
    << a
    arg = Html -> b
    fn (a -> Html
    forall a. HTML a => a -> Html
    toHtml a
    arg)

    concatHtml :: (HTML a) => [a] -> Html
    concatHtml :: forall a. HTML a => [a] -> Html
    concatHtml [a]
    as = [HtmlElement] -> Html
    Html ([[HtmlElement]] -> [HtmlElement]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((a -> [HtmlElement]) -> [a] -> [[HtmlElement]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Html -> [HtmlElement]
    getHtmlElements(Html -> [HtmlElement]) -> (a -> Html) -> a -> [HtmlElement]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .a -> Html
    forall a. HTML a => a -> Html
    toHtml) [a]
    as))

    -- | Create a piece of HTML which is the concatenation
    --   of two things which can be made into HTML.
    (+++) :: (HTML a,HTML b) => a -> b -> Html
    a
    a +++ :: forall a b. (HTML a, HTML b) => a -> b -> Html
    +++ b
    b = [HtmlElement] -> Html
    Html (Html -> [HtmlElement]
    getHtmlElements (a -> Html
    forall a. HTML a => a -> Html
    toHtml a
    a) [HtmlElement] -> [HtmlElement] -> [HtmlElement]
    forall a. [a] -> [a] -> [a]
    ++ Html -> [HtmlElement]
    getHtmlElements (b -> Html
    forall a. HTML a => a -> Html
    toHtml b
    b))

    -- | An empty piece of HTML.
    noHtml :: Html
    noHtml :: Html
    noHtml = [HtmlElement] -> Html
    Html []

    -- | Checks whether the given piece of HTML is empty.
    isNoHtml :: Html -> Bool
    isNoHtml :: Html -> Bool
    isNoHtml (Html [HtmlElement]
    xs) = [HtmlElement] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HtmlElement]
    xs

    -- | Constructs an element with a custom name.
    tag :: String -- ^ Element name
        -> Html -- ^ Element contents
        -> Html
    tag :: String -> Html -> Html
    tag String
    str       Html
    htmls = [HtmlElement] -> Html
    Html [
          HtmlTag {
                  markupTag :: String
    markupTag = String
    str,
                  markupAttrs :: [HtmlAttr]
    markupAttrs = [],
                  markupContent :: Html
    markupContent = Html
    htmls }]

    -- | Constructs an element with a custom name, and
    --   without any children.
    itag :: String -> Html
    itag :: String -> Html
    itag String
    str = String -> Html -> Html
    tag String
    str Html
    noHtml

    emptyAttr :: String -> HtmlAttr
    emptyAttr :: String -> HtmlAttr
    emptyAttr String
    s = String -> String -> HtmlAttr
    HtmlAttr String
    s String
    s

    intAttr :: String -> Int -> HtmlAttr
    intAttr :: String -> Int -> HtmlAttr
    intAttr String
    s Int
    i = String -> String -> HtmlAttr
    HtmlAttr String
    s (Int -> String
    forall a. Show a => a -> String
    show Int
    i)

    strAttr :: String -> String -> HtmlAttr
    strAttr :: String -> String -> HtmlAttr
    strAttr String
    s String
    t = String -> String -> HtmlAttr
    HtmlAttr String
    s (ShowS
    stringToHtmlString String
    t)

    htmlAttr :: String -> Html -> HtmlAttr
    htmlAttr :: String -> Html -> HtmlAttr
    htmlAttr String
    s Html
    t = String -> String -> HtmlAttr
    HtmlAttr String
    s (Html -> String
    forall a. Show a => a -> String
    show Html
    t)

    {-
    foldHtml :: (String -> [HtmlAttr] -> [a] -> a)
          -> (String -> a)
          -> Html
          -> a
    foldHtml f g (HtmlTag str attr fmls)
          = f str attr (map (foldHtml f g) fmls)
    foldHtml f g (HtmlString  str)
          = g str

    -}

    -- | Processing Strings into Html friendly things.
    stringToHtmlString :: String -> String
    stringToHtmlString :: ShowS
    stringToHtmlString = (Char -> String) -> ShowS
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Char -> String
    fixChar
        where
          fixChar :: Char -> String
    fixChar Char
    '<' = String
    "&lt;"
          fixChar Char
    '>' = String
    "&gt;"
          fixChar Char
    '&' = String
    "&amp;"
          fixChar Char
    '"' = String
    "&quot;"
          fixChar Char
    c | Char -> Int
    ord Char
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0x80 = [Char
    c]
          fixChar Char
    c = String
    "&#" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Char -> Int
    ord Char
    c) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ";"

    -- | This is not processed for special chars.
    -- use stringToHtml or lineToHtml instead, for user strings,
    -- because they understand special chars, like @'<'@.
    primHtml :: String -> Html
    primHtml :: String -> Html
    primHtml String
    x | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    x    = [HtmlElement] -> Html
    Html []
               | Bool
    otherwise = [HtmlElement] -> Html
    Html [String -> HtmlElement
    HtmlString String
    x]

    --
    -- * Html Rendering
    --

    mkHtml :: HTML html => html -> Html
    mkHtml :: forall a. HTML a => a -> Html
    mkHtml = (String -> Html -> Html
    tag String
    "html" (Html -> Html) -> [HtmlAttr] -> Html -> Html
    forall a. ADDATTRS a => a -> [HtmlAttr] -> a
    ! [String -> String -> HtmlAttr
    strAttr String
    "xmlns" String
    "http://www.w3.org/1999/xhtml"] (Html -> Html) -> html -> Html
    forall a b. HTML a => (Html -> b) -> a -> b
    <<)

    -- | Output the HTML without adding newlines or spaces within the markup.
    --   This should be the most time and space efficient way to
    --   render HTML, though the ouput is quite unreadable.
    showHtmlInternal :: HTML html =>
                        String -- ^ DOCTYPE declaration
                     -> html -> String
    showHtmlInternal :: forall html. HTML html => String -> html -> String
    showHtmlInternal String
    docType html
    theHtml =
        String
    docType String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Html -> String
    forall html. HTML html => html -> String
    showHtmlFragment (html -> Html
    forall a. HTML a => a -> Html
    mkHtml html
    theHtml)

    -- | Outputs indented HTML. Because space matters in
    --   HTML, the output is quite messy.
    renderHtmlInternal :: HTML html =>
                          String  -- ^ DOCTYPE declaration
                       -> html -> String
    renderHtmlInternal :: forall html. HTML html => String -> html -> String
    renderHtmlInternal String
    docType html
    theHtml =
          String
    docType String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Html -> String
    forall html. HTML html => html -> String
    renderHtmlFragment (html -> Html
    forall a. HTML a => a -> Html
    mkHtml html
    theHtml) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"

    -- | Outputs indented HTML, with indentation inside elements.
    --   This can change the meaning of the HTML document, and
    --   is mostly useful for debugging the HTML output.
    --   The implementation is inefficient, and you are normally
    --   better off using 'showHtml' or 'renderHtml'.
    prettyHtmlInternal :: HTML html =>
                          String -- ^ DOCTYPE declaration
                       -> html -> String
    prettyHtmlInternal :: forall html. HTML html => String -> html -> String
    prettyHtmlInternal String
    docType html
    theHtml =
        String
    docType String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Html -> String
    forall html. HTML html => html -> String
    prettyHtmlFragment (html -> Html
    forall a. HTML a => a -> Html
    mkHtml html
    theHtml)

    -- | Render a piece of HTML without adding a DOCTYPE declaration
    --   or root element. Does not add any extra whitespace.
    showHtmlFragment :: HTML html => html -> String
    showHtmlFragment :: forall html. HTML html => html -> String
    showHtmlFragment html
    h =
        ((ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id ([ShowS] -> ShowS) -> [ShowS] -> ShowS
    forall a b. (a -> b) -> a -> b
    $ (HtmlElement -> ShowS) -> [HtmlElement] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> ShowS
    showHtml' ([HtmlElement] -> [ShowS]) -> [HtmlElement] -> [ShowS]
    forall a b. (a -> b) -> a -> b
    $ Html -> [HtmlElement]
    getHtmlElements (Html -> [HtmlElement]) -> Html -> [HtmlElement]
    forall a b. (a -> b) -> a -> b
    $ html -> Html
    forall a. HTML a => a -> Html
    toHtml html
    h) String
    ""

    -- | Render a piece of indented HTML without adding a DOCTYPE declaration
    --   or root element. Only adds whitespace where it does not change
    --   the meaning of the document.
    renderHtmlFragment :: HTML html => html -> String
    renderHtmlFragment :: forall html. HTML html => html -> String
    renderHtmlFragment html
    h =
        ((ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id ([ShowS] -> ShowS) -> [ShowS] -> ShowS
    forall a b. (a -> b) -> a -> b
    $ (HtmlElement -> ShowS) -> [HtmlElement] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> HtmlElement -> ShowS
    renderHtml' Int
    0) ([HtmlElement] -> [ShowS]) -> [HtmlElement] -> [ShowS]
    forall a b. (a -> b) -> a -> b
    $ Html -> [HtmlElement]
    getHtmlElements (Html -> [HtmlElement]) -> Html -> [HtmlElement]
    forall a b. (a -> b) -> a -> b
    $ html -> Html
    forall a. HTML a => a -> Html
    toHtml html
    h) String
    ""

    -- | Render a piece of indented HTML without adding a DOCTYPE declaration
    --   or a root element.
    --   The indentation is done inside elements.
    --   This can change the meaning of the HTML document, and
    --   is mostly useful for debugging the HTML output.
    --   The implementation is inefficient, and you are normally
    --   better off using 'showHtmlFragment' or 'renderHtmlFragment'.
    prettyHtmlFragment :: HTML html => html -> String
    prettyHtmlFragment :: forall html. HTML html => html -> String
    prettyHtmlFragment =
        [String] -> String
    unlines ([String] -> String) -> (html -> [String]) -> html -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String])
    -> (html -> [[String]]) -> html -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HtmlElement -> [String]) -> [HtmlElement] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> [String]
    prettyHtml' ([HtmlElement] -> [[String]])
    -> (html -> [HtmlElement]) -> html -> [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html -> [HtmlElement]
    getHtmlElements (Html -> [HtmlElement]) -> (html -> Html) -> html -> [HtmlElement]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . html -> Html
    forall a. HTML a => a -> Html
    toHtml

    -- | Show a single HTML element, without adding whitespace.
    showHtml' :: HtmlElement -> ShowS
    showHtml' :: HtmlElement -> ShowS
    showHtml' (HtmlString String
    str) = String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) String
    str
    showHtml'(HtmlTag { markupTag :: HtmlElement -> String
    markupTag = String
    name,
                        markupContent :: HtmlElement -> Html
    markupContent = Html
    html,
                        markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs = [HtmlAttr]
    attrs })
        = if Html -> Bool
    isNoHtml Html
    html Bool -> Bool -> Bool
    && String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    name [String]
    validHtmlITags
          then Bool -> String -> [HtmlAttr] -> String -> ShowS
    renderTag Bool
    True String
    name [HtmlAttr]
    attrs String
    ""
          else (Bool -> String -> [HtmlAttr] -> String -> ShowS
    renderTag Bool
    False String
    name [HtmlAttr]
    attrs String
    ""
                ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id ((HtmlElement -> ShowS) -> [HtmlElement] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> ShowS
    showHtml' (Html -> [HtmlElement]
    getHtmlElements Html
    html))
                ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> ShowS
    renderEndTag String
    name String
    "")

    renderHtml' :: Int -> HtmlElement -> ShowS
    renderHtml' :: Int -> HtmlElement -> ShowS
    renderHtml' Int
    _ (HtmlString String
    str) = String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) String
    str
    renderHtml' Int
    n (HtmlTag
                  { markupTag :: HtmlElement -> String
    markupTag = String
    name,
                    markupContent :: HtmlElement -> Html
    markupContent = Html
    html,
                    markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs = [HtmlAttr]
    attrs })
          = if Html -> Bool
    isNoHtml Html
    html Bool -> Bool -> Bool
    && String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    name [String]
    validHtmlITags
            then Bool -> String -> [HtmlAttr] -> String -> ShowS
    renderTag Bool
    True String
    name [HtmlAttr]
    attrs (Int -> String
    nl Int
    n)
            else (Bool -> String -> [HtmlAttr] -> String -> ShowS
    renderTag Bool
    False String
    name [HtmlAttr]
    attrs (Int -> String
    nl Int
    n)
                 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id ((HtmlElement -> ShowS) -> [HtmlElement] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> HtmlElement -> ShowS
    renderHtml' (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2)) (Html -> [HtmlElement]
    getHtmlElements Html
    html))
                 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> ShowS
    renderEndTag String
    name (Int -> String
    nl Int
    n))
        where
          nl :: Int -> String
    nl Int
    n' = String
    "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8) Char
    '\t'
                  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    8) Char
    ' '

    prettyHtml' :: HtmlElement -> [String]
    prettyHtml' :: HtmlElement -> [String]
    prettyHtml' (HtmlString String
    str) = [String
    str]
    prettyHtml' (HtmlTag
                  { markupTag :: HtmlElement -> String
    markupTag = String
    name,
                    markupContent :: HtmlElement -> Html
    markupContent = Html
    html,
                    markupAttrs :: HtmlElement -> [HtmlAttr]
    markupAttrs = [HtmlAttr]
    attrs })
          = if Html -> Bool
    isNoHtml Html
    html Bool -> Bool -> Bool
    && String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    name [String]
    validHtmlITags
            then
             [ShowS
    rmNL (Bool -> String -> [HtmlAttr] -> String -> ShowS
    renderTag Bool
    True String
    name [HtmlAttr]
    attrs String
    "" String
    "")]
            else
             [ShowS
    rmNL (Bool -> String -> [HtmlAttr] -> String -> ShowS
    renderTag Bool
    False String
    name [HtmlAttr]
    attrs String
    "" String
    "")] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
              [String] -> [String]
    shift ([[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((HtmlElement -> [String]) -> [HtmlElement] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map HtmlElement -> [String]
    prettyHtml' (Html -> [HtmlElement]
    getHtmlElements Html
    html))) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
             [ShowS
    rmNL (String -> String -> ShowS
    renderEndTag String
    name String
    "" String
    "")]
      where
          shift :: [String] -> [String]
    shift = ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    x -> String
    "   " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    x)
          rmNL :: ShowS
    rmNL = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n')

    -- | Show a start tag
    renderTag :: Bool       -- ^ 'True' if the empty tag shorthand should be used
              -> String     -- ^ Tag name
              -> [HtmlAttr] -- ^ Attributes
              -> String     -- ^ Whitespace to add after attributes
              -> ShowS
    renderTag :: Bool -> String -> [HtmlAttr] -> String -> ShowS
    renderTag Bool
    empty String
    name [HtmlAttr]
    attrs String
    nl String
    r
          = String
    "<" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    shownAttrs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    nl String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    close String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    r
      where
          close :: String
    close = if Bool
    empty then String
    " />" else String
    ">"

          shownAttrs :: String
    shownAttrs = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [Char
    ' 'Char -> ShowS
    forall a. a -> [a] -> [a]
    :HtmlAttr -> String
    showPair HtmlAttr
    attr | HtmlAttr
    attr <- [HtmlAttr]
    attrs ]

          showPair :: HtmlAttr -> String
          showPair :: HtmlAttr -> String
    showPair (HtmlAttr String
    key String
    val)
                  = String
    key String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "=\"" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    val  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""

    -- | Show an end tag
    renderEndTag :: String -- ^ Tag name
                 -> String -- ^ Whitespace to add after tag name
                 -> ShowS
    renderEndTag :: String -> String -> ShowS
    renderEndTag String
    name String
    nl String
    r = String
    "</" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    nl String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ">" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    r

    -- | The names of all elements which can represented using the empty tag
    --   short-hand.
    validHtmlITags :: [String]
    validHtmlITags :: [String]
    validHtmlITags = [
                      String
    "area",
                      String
    "base",
                      String
    "basefont",
                      String
    "br",
                      String
    "col",
                      String
    "frame",
                      String
    "hr",
                      String
    "img",
                      String
    "input",
                      String
    "isindex",
                      String
    "link",
                      String
    "meta",
                      String
    "param"
                     ]