diff options
Diffstat (limited to 'src/Hakyll/Web/Urls.hs')
-rw-r--r-- | src/Hakyll/Web/Urls.hs | 56 |
1 files changed, 56 insertions, 0 deletions
diff --git a/src/Hakyll/Web/Urls.hs b/src/Hakyll/Web/Urls.hs new file mode 100644 index 0000000..52e9413 --- /dev/null +++ b/src/Hakyll/Web/Urls.hs @@ -0,0 +1,56 @@ +-- | Provides utilities to manipulate URL's +-- +module Hakyll.Web.Urls + ( withUrls + , toUrl + , toSiteRoot + , isExternal + ) where + +import Data.List (isPrefixOf) +import System.FilePath (splitPath, takeDirectory, joinPath) +import qualified Data.Set as S + +import Text.HTML.TagSoup (Tag (..), renderTags, parseTags) + +-- | Apply a function to each URL on a webpage +-- +withUrls :: (String -> String) -> String -> String +withUrls f = renderTags . map tag . parseTags + where + tag (TagOpen s a) = TagOpen s $ map attr a + tag x = x + attr (k, v) = (k, if k `S.member` refs then f v else v) + refs = S.fromList ["src", "href"] + +-- | Convert a filepath to an URL starting from the site root +-- +-- Example: +-- +-- > toUrl "foo/bar.html" +-- +-- Result: +-- +-- > "/foo/bar.html" +-- +toUrl :: FilePath -> String +toUrl ('/' : xs) = '/' : xs +toUrl url = '/' : url + +-- | 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 _ = True + +-- | Check if an URL links to an external HTTP(S) source +-- +isExternal :: String -> Bool +isExternal url = any (flip isPrefixOf url) ["http://", "https://"] |