diff options
author | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-12-25 22:49:17 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-12-25 22:49:29 +0100 |
commit | 69ffbe03563cdbc7be6b826e2def2fc797442792 (patch) | |
tree | 3792ce42ee2e9983876f9177533201dd712b76d1 /src/Hakyll/Web/Html/RelativizeUrls.hs | |
parent | 2ae11c9d7f3138fe9e8397059c641e1962ede197 (diff) | |
download | hakyll-69ffbe03563cdbc7be6b826e2def2fc797442792.tar.gz |
Add demoteHeaders, refactor a bit
Diffstat (limited to 'src/Hakyll/Web/Html/RelativizeUrls.hs')
-rw-r--r-- | src/Hakyll/Web/Html/RelativizeUrls.hs | 52 |
1 files changed, 52 insertions, 0 deletions
diff --git a/src/Hakyll/Web/Html/RelativizeUrls.hs b/src/Hakyll/Web/Html/RelativizeUrls.hs new file mode 100644 index 0000000..33b0c2c --- /dev/null +++ b/src/Hakyll/Web/Html/RelativizeUrls.hs @@ -0,0 +1,52 @@ +-------------------------------------------------------------------------------- +-- | 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 = do + route <- getRoute $ itemIdentifier item + return $ case route of + Nothing -> item + Just r -> fmap (relativizeUrlsWith $ toSiteRoot r) item + + +-------------------------------------------------------------------------------- +-- | Relativize URL's in HTML +relativizeUrlsWith :: String -- ^ Path to the site root + -> String -- ^ HTML to relativize + -> String -- ^ Resulting HTML +relativizeUrlsWith root = withUrls rel + where + isRel x = "/" `isPrefixOf` x && not ("//" `isPrefixOf` x) + rel x = if isRel x then root ++ x else x |