--------------------------------------------------------------------------------
-- | This module exposes a function which can relativize URL's on a webpage.
--
-- This means that one can deploy the resulting site on
-- @http:\/\/example.com\/@, but also on @http:\/\/example.com\/some-folder\/@
-- without having to change anything (simply copy over the files).
--
-- To use it, you should use absolute URL's from the site root everywhere. For
-- example, use
--
-- > <img src="/images/lolcat.png" alt="Funny zomgroflcopter" />
--
-- in a blogpost. When running this through the relativize URL's module, this
-- will result in (suppose your blogpost is located at @\/posts\/foo.html@:
--
-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />
module Hakyll.Web.Html.RelativizeUrls
    ( relativizeUrls
    , relativizeUrlsWith
    ) where


--------------------------------------------------------------------------------
import           Data.List            (isPrefixOf)


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler
import           Hakyll.Core.Item
import           Hakyll.Web.Html


--------------------------------------------------------------------------------
-- | Compiler form of 'relativizeUrls' which automatically picks the right root
-- path
relativizeUrls :: Item String -> Compiler (Item String)
relativizeUrls :: Item String -> Compiler (Item String)
relativizeUrls Item String
item = do
    Maybe String
route <- Identifier -> Compiler (Maybe String)
getRoute (Identifier -> Compiler (Maybe String))
-> Identifier -> Compiler (Maybe String)
forall a b. (a -> b) -> a -> b
$ Item String -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item String
item
    Item String -> Compiler (Item String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item String -> Compiler (Item String))
-> Item String -> Compiler (Item String)
forall a b. (a -> b) -> a -> b
$ case Maybe String
route of
        Maybe String
Nothing -> Item String
item
        Just String
r  -> (String -> String) -> Item String -> Item String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
relativizeUrlsWith (String -> String -> String) -> String -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
toSiteRoot String
r) Item String
item


--------------------------------------------------------------------------------
-- | Relativize URL's in HTML
relativizeUrlsWith :: String  -- ^ Path to the site root
                   -> String  -- ^ HTML to relativize
                   -> String  -- ^ Resulting HTML
relativizeUrlsWith :: String -> String -> String
relativizeUrlsWith String
root = (String -> String) -> String -> String
withUrls String -> String
rel
  where
    isRel :: String -> Bool
isRel String
x = String
"/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"//" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x)
    rel :: String -> String
rel String
x   = if String -> Bool
isRel String
x then String
root String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x else String
x