diff options
author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2011-01-04 11:13:08 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2011-01-04 11:13:08 +0100 |
commit | 0969fe41c7c94c34e5663ed231ecbb9e2c4bc051 (patch) | |
tree | 2f272db6a4057d8d880416e342f88ccf881377fe /src/Hakyll/Web/RelativizeUrls.hs | |
parent | e395b0af9a969b8a1d93ad0d9f0554841beb9298 (diff) | |
download | hakyll-0969fe41c7c94c34e5663ed231ecbb9e2c4bc051.tar.gz |
Add relativize URL's functionality
Diffstat (limited to 'src/Hakyll/Web/RelativizeUrls.hs')
-rw-r--r-- | src/Hakyll/Web/RelativizeUrls.hs | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/src/Hakyll/Web/RelativizeUrls.hs b/src/Hakyll/Web/RelativizeUrls.hs new file mode 100644 index 0000000..2a3b98f --- /dev/null +++ b/src/Hakyll/Web/RelativizeUrls.hs @@ -0,0 +1,29 @@ +module Hakyll.Web.RelativizeUrls + ( relativizeUrls + ) where + +import Data.List (isPrefixOf) +import qualified Data.Set as S + +import Text.HTML.TagSoup + +-- | Relativize URL's in HTML +-- +relativizeUrls :: String -- ^ Path to the site root + -> String -- ^ HTML to relativize + -> String -- ^ Resulting HTML +relativizeUrls root = renderTags . map relativizeUrls' . parseTags + where + relativizeUrls' (TagOpen s a) = TagOpen s $ map (relativizeUrlsAttrs root) a + relativizeUrls' x = x + +-- | Relativize URL's in attributes +-- +relativizeUrlsAttrs :: String -- ^ Path to the site root + -> Attribute String -- ^ Attribute to relativize + -> Attribute String -- ^ Resulting attribute +relativizeUrlsAttrs root (key, value) + | key `S.member` urls && "/" `isPrefixOf` value = (key, root ++ value) + | otherwise = (key, value) + where + urls = S.fromList ["src", "href"] |