    --------------------------------------------------------------------------------
    -- | Provides utilities to manipulate HTML pages
    module Hakyll.Web.Html
        ( -- * Generic
          withTags
        , withTagList

          -- * Headers
        , demoteHeaders

          -- * Url manipulation
        , getUrls
        , withUrls
        , toUrl
        , toSiteRoot
        , isExternal

          -- * Stripping/escaping
        , stripTags
        , escapeHtml
        ) where

    --------------------------------------------------------------------------------
    import           Data.Char                       (digitToInt, intToDigit,
                                                      isDigit, toLower)
    import           Data.List                       (isPrefixOf)
    import qualified Data.Set                        as S
    import           System.FilePath                 (joinPath, splitPath,
                                                      takeDirectory)
    import           Text.Blaze.Html                 (toHtml)
    import           Text.Blaze.Html.Renderer.String (renderHtml)
    import qualified Text.HTML.TagSoup               as TS
    import           Network.URI                     (isUnreserved, escapeURIString)

    --------------------------------------------------------------------------------
    import           Hakyll.Core.Util.String         (removeWinPathSeparator)

    --------------------------------------------------------------------------------
    -- | Map over all tags in the document
    withTags :: (TS.Tag String -> TS.Tag String) -> String -> String
    withTags :: (Tag String -> Tag String) -> String -> String
    withTags = ([Tag String] -> [Tag String]) -> String -> String
    withTagList (([Tag String] -> [Tag String]) -> String -> String)
    -> ((Tag String -> Tag String) -> [Tag String] -> [Tag String])
    -> (Tag String -> Tag String)
    -> String
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tag String -> Tag String) -> [Tag String] -> [Tag String]
    forall a b. (a -> b) -> [a] -> [b]
    map

    -- | Map over all tags (as list) in the document
    withTagList :: ([TS.Tag String] -> [TS.Tag String]) -> String -> String
    withTagList :: ([Tag String] -> [Tag String]) -> String -> String
    withTagList f :: [Tag String] -> [Tag String]
    f = [Tag String] -> String
    renderTags' ([Tag String] -> String)
    -> (String -> [Tag String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Tag String] -> [Tag String]
    f ([Tag String] -> [Tag String])
    -> (String -> [Tag String]) -> String -> [Tag String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [Tag String]
    parseTags'

    --------------------------------------------------------------------------------
    -- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc.
    demoteHeaders :: String -> String
    demoteHeaders :: String -> String
    demoteHeaders = (Tag String -> Tag String) -> String -> String
    withTags ((Tag String -> Tag String) -> String -> String)
    -> (Tag String -> Tag String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ \tag :: Tag String
    tag -> case Tag String
    tag of
        TS.TagOpen t :: String
    t a :: [Attribute String]
    a -> String -> [Attribute String] -> Tag String
    forall str. str -> [Attribute str] -> Tag str
    TS.TagOpen (String -> String
    demote String
    t) [Attribute String]
    a
        TS.TagClose t :: String
    t  -> String -> Tag String
    forall str. str -> Tag str
    TS.TagClose (String -> String
    demote String
    t)
        t :: Tag String
    t              -> Tag String
    t
      where
        demote :: String -> String
    demote t :: String
    t@['h', n :: Char
    n]
            | Char -> Bool
    isDigit Char
    n = ['h', Int -> Char
    intToDigit (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min 6 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    digitToInt Char
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1)]
            | Bool
    otherwise = String
    t
        demote t :: String
    t        = String
    t

    --------------------------------------------------------------------------------
    isUrlAttribute :: String -> Bool
    isUrlAttribute :: String -> Bool
    isUrlAttribute = (String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["src", "href", "data", "poster", "srcset"])

    --------------------------------------------------------------------------------
    getUrls :: [TS.Tag String] -> [String]
    getUrls :: [Tag String] -> [String]
    getUrls tags :: [Tag String]
    tags = [String
    v | TS.TagOpen _ as :: [Attribute String]
    as <- [Tag String]
    tags, (k :: String
    k, v :: String
    v) <- [Attribute String]
    as, String -> Bool
    isUrlAttribute String
    k]

    --------------------------------------------------------------------------------
    -- | Apply a function to each URL on a webpage
    withUrls :: (String -> String) -> String -> String
    withUrls :: (String -> String) -> String -> String
    withUrls f :: String -> String
    f = (Tag String -> Tag String) -> String -> String
    withTags Tag String -> Tag String
    tag
      where
        tag :: Tag String -> Tag String
    tag (TS.TagOpen s :: String
    s a :: [Attribute String]
    a) = String -> [Attribute String] -> Tag String
    forall str. str -> [Attribute str] -> Tag str
    TS.TagOpen String
    s ([Attribute String] -> Tag String)
    -> [Attribute String] -> Tag String
    forall a b. (a -> b) -> a -> b
    $ (Attribute String -> Attribute String)
    -> [Attribute String] -> [Attribute String]
    forall a b. (a -> b) -> [a] -> [b]
    map Attribute String -> Attribute String
    attr [Attribute String]
    a
        tag x :: Tag String
    x                = Tag String
    x
        attr :: Attribute String -> Attribute String
    attr (k :: String
    k, v :: String
    v)          = (String
    k, if String -> Bool
    isUrlAttribute String
    k then String -> String
    f String
    v else String
    v)

    --------------------------------------------------------------------------------
    -- | Customized TagSoup renderer. The default TagSoup renderer escape CSS
    -- within style tags, and doesn't properly minimize.
    renderTags' :: [TS.Tag String] -> String
    renderTags' :: [Tag String] -> String
    renderTags' = RenderOptions String -> [Tag String] -> String
    forall str. StringLike str => RenderOptions str -> [Tag str] -> str
    TS.renderTagsOptions RenderOptions :: forall str.
    (str -> str) -> (str -> Bool) -> (str -> Bool) -> RenderOptions str
    TS.RenderOptions
        { optRawTag :: String -> Bool
    TS.optRawTag   = (String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["script", "style"]) (String -> Bool) -> (String -> String) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower
        , optMinimize :: String -> Bool
    TS.optMinimize = (String -> Set String -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set String
    minimize) (String -> Bool) -> (String -> String) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower
        , optEscape :: String -> String
    TS.optEscape   = String -> String
    forall a. a -> a
    id
        }
      where
        -- A list of elements which must be minimized
        minimize :: Set String
    minimize = [String] -> Set String
    forall a. Ord a => [a] -> Set a
    S.fromList
            [ "area", "br", "col", "embed", "hr", "img", "input", "meta", "link"
            , "param"
            ]

    --------------------------------------------------------------------------------
    -- | Customized TagSoup parser: do not decode any entities.
    parseTags' :: String -> [TS.Tag String]
    parseTags' :: String -> [Tag String]
    parseTags' = ParseOptions String -> String -> [Tag String]
    forall str. StringLike str => ParseOptions str -> str -> [Tag str]
    TS.parseTagsOptions (ParseOptions String
    forall str. StringLike str => ParseOptions str
    TS.parseOptions :: TS.ParseOptions String)
        { optEntityData :: (String, Bool) -> [Tag String]
    TS.optEntityData   = \(str :: String
    str, b :: Bool
    b) -> [String -> Tag String
    forall str. str -> Tag str
    TS.TagText (String -> Tag String) -> String -> Tag String
    forall a b. (a -> b) -> a -> b
    $ "&" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [';' | Bool
    b]]
        , optEntityAttrib :: (String, Bool) -> (String, [Tag String])
    TS.optEntityAttrib = \(str :: String
    str, b :: Bool
    b) -> ("&" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [';' | Bool
    b], [])
        }

    --------------------------------------------------------------------------------
    -- | Convert a filepath to an URL starting from the site root
    --
    -- Example:
    --
    -- > toUrl "foo/bar.html"
    --
    -- Result:
    --
    -- > "/foo/bar.html"
    --
    -- This also sanitizes the URL, e.g. converting spaces into '%20'
    toUrl :: FilePath -> String
    toUrl :: String -> String
    toUrl url :: String
    url = case (String -> String
    removeWinPathSeparator String
    url) of
        ('/' : xs :: String
    xs) -> '/' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    sanitize String
    xs
        xs :: String
    xs         -> '/' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    sanitize String
    xs
      where
        -- Everything but unreserved characters should be escaped as we are
        -- sanitising the path therefore reserved characters which have a
        -- meaning in URI does not appear. Special casing for `/`, because it has
        -- a special meaning in FilePath as well as in URI.
        sanitize :: String -> String
    sanitize = (Char -> Bool) -> String -> String
    escapeURIString (\c :: Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '/' Bool -> Bool -> Bool
    || Char -> Bool
    isUnreserved Char
    c)

    --------------------------------------------------------------------------------
    -- | Get the relative url to the site root, for a given (absolute) url
    toSiteRoot :: String -> String
    toSiteRoot :: String -> String
    toSiteRoot = String -> String
    removeWinPathSeparator (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    emptyException (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    joinPath
               ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    forall b. b -> String
    parent ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    relevant ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    splitPath (String -> [String]) -> (String -> String) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    takeDirectory
      where
        parent :: b -> String
    parent            = String -> b -> String
    forall a b. a -> b -> a
    const ".."
        emptyException :: String -> String
    emptyException [] = "."
        emptyException x :: String
    x  = String
    x
        relevant :: String -> Bool
    relevant "."      = Bool
    False
        relevant "/"      = Bool
    False
        relevant "./"     = Bool
    False
        relevant _        = Bool
    True

    --------------------------------------------------------------------------------
    -- | Check if an URL links to an external HTTP(S) source
    isExternal :: String -> Bool
    isExternal :: String -> Bool
    isExternal url :: String
    url = (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((String -> String -> Bool) -> String -> String -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf String
    url) ["http://", "https://", "//"]

    --------------------------------------------------------------------------------
    -- | Strip all HTML tags from a string
    --
    -- Example:
    --
    -- > stripTags "<p>foo</p>"
    --
    -- Result:
    --
    -- > "foo"
    --
    -- This also works for incomplete tags
    --
    -- Example:
    --
    -- > stripTags "<p>foo</p"
    --
    -- Result:
    --
    -- > "foo"
    stripTags :: String -> String
    stripTags :: String -> String
    stripTags []         = []
    stripTags ('<' : xs :: String
    xs) = String -> String
    stripTags (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop 1 (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '>') String
    xs
    stripTags (x :: Char
    x : xs :: String
    xs)   = Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    stripTags String
    xs

    --------------------------------------------------------------------------------
    -- | HTML-escape a string
    --
    -- Example:
    --
    -- > escapeHtml "Me & Dean"
    --
    -- Result:
    --
    -- > "Me &amp; Dean"
    escapeHtml :: String -> String
    escapeHtml :: String -> String
    escapeHtml = Html -> String
    renderHtml (Html -> String) -> (String -> Html) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Html
    forall a. ToMarkup a => a -> Html
    toHtml