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

          -- * 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.Posix           (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)

    --------------------------------------------------------------------------------
    -- | Map over all tags in the document
    withTags :: (TS.Tag String -> TS.Tag String) -> String -> String
    withTags f = renderTags' . map f . parseTags'

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

    --------------------------------------------------------------------------------
    isUrlAttribute :: String -> Bool
    isUrlAttribute = (`elem` ["src", "href", "data", "poster"])

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

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

    --------------------------------------------------------------------------------
    -- | Customized TagSoup renderer. The default TagSoup renderer escape CSS
    -- within style tags, and doesn't properly minimize.
    renderTags' :: [TS.Tag String] -> String
    renderTags' = TS.renderTagsOptions TS.RenderOptions
        { TS.optRawTag   = (`elem` ["script", "style"]) . map toLower
        , TS.optMinimize = (`S.member` minimize) . map toLower
        , TS.optEscape   = id
        }
      where
        -- A list of elements which must be minimized
        minimize = 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' = TS.parseTagsOptions (TS.parseOptions :: TS.ParseOptions String)
        { TS.optEntityData   = \(str, b) -> [TS.TagText $ "&" ++ str ++ [';' | b]]
        , TS.optEntityAttrib = \(str, b) -> ("&" ++ str ++ [';' | 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 url = case url of
        ('/' : xs) -> '/' : sanitize xs
        xs         -> '/' : sanitize 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 = escapeURIString (\c -> c == '/' || isUnreserved c)

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

    --------------------------------------------------------------------------------
    -- | Check if an URL links to an external HTTP(S) source
    isExternal :: String -> Bool
    isExternal url = any (flip isPrefixOf 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 []         = []
    stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs
    stripTags (x : xs)   = x : stripTags xs

    --------------------------------------------------------------------------------
    -- | HTML-escape a string
    --
    -- Example:
    --
    -- > escapeHtml "Me & Dean"
    --
    -- Result:
    --
    -- > "Me &amp; Dean"
    escapeHtml :: String -> String
    escapeHtml = renderHtml . toHtml