summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Web/Feed.hs2
-rw-r--r--src/Hakyll/Web/Page.hs2
-rw-r--r--src/Hakyll/Web/Tags.hs2
-rw-r--r--src/Hakyll/Web/Urls.hs56
-rw-r--r--src/Hakyll/Web/Urls/Relativize.hs (renamed from src/Hakyll/Web/RelativizeUrls.hs)23
-rw-r--r--src/Hakyll/Web/Util/Url.hs35
6 files changed, 63 insertions, 57 deletions
diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs
index 27246a2..cd71029 100644
--- a/src/Hakyll/Web/Feed.hs
+++ b/src/Hakyll/Web/Feed.hs
@@ -33,7 +33,7 @@ import Hakyll.Web.Page
import Hakyll.Web.Page.Metadata
import Hakyll.Web.Template
import Hakyll.Web.Template.Read.Hakyll (readTemplate)
-import Hakyll.Web.Util.Url
+import Hakyll.Web.Urls
import Paths_hakyll
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 6c219b4..e92bb14 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -78,7 +78,7 @@ import Hakyll.Web.Page.Read
import Hakyll.Web.Page.Metadata
import Hakyll.Web.Pandoc
import Hakyll.Web.Template
-import Hakyll.Web.Util.Url
+import Hakyll.Web.Urls
-- | Create a page from a body, without metadata
--
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index 6ae47fa..c8e45c9 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/src/Hakyll/Web/Tags.hs
@@ -55,7 +55,7 @@ import qualified Text.Blaze.Html5.Attributes as A
import Hakyll.Web.Page
import Hakyll.Web.Page.Metadata
-import Hakyll.Web.Util.Url
+import Hakyll.Web.Urls
import Hakyll.Core.Writable
import Hakyll.Core.Identifier
import Hakyll.Core.Compiler
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://"]
diff --git a/src/Hakyll/Web/RelativizeUrls.hs b/src/Hakyll/Web/Urls/Relativize.hs
index 06b4ae2..f4b7a6c 100644
--- a/src/Hakyll/Web/RelativizeUrls.hs
+++ b/src/Hakyll/Web/Urls/Relativize.hs
@@ -14,7 +14,7 @@
--
-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />
--
-module Hakyll.Web.RelativizeUrls
+module Hakyll.Web.Urls.Relativize
( relativizeUrlsCompiler
, relativizeUrls
) where
@@ -23,13 +23,10 @@ import Prelude hiding (id)
import Control.Category (id)
import Control.Arrow ((&&&), (>>^))
import Data.List (isPrefixOf)
-import qualified Data.Set as S
-
-import Text.HTML.TagSoup
import Hakyll.Core.Compiler
import Hakyll.Web.Page
-import Hakyll.Web.Util.Url
+import Hakyll.Web.Urls
-- | Compiler form of 'relativizeUrls' which automatically picks the right root
-- path
@@ -45,18 +42,6 @@ relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize
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)
+relativizeUrls root = withUrls rel
where
- urls = S.fromList ["src", "href"]
+ rel x = if "/" `isPrefixOf` x then root ++ x else x
diff --git a/src/Hakyll/Web/Util/Url.hs b/src/Hakyll/Web/Util/Url.hs
deleted file mode 100644
index 7ab6717..0000000
--- a/src/Hakyll/Web/Util/Url.hs
+++ /dev/null
@@ -1,35 +0,0 @@
--- | Miscellaneous URL manipulation functions.
---
-module Hakyll.Web.Util.Url
- ( toUrl
- , toSiteRoot
- ) where
-
-import System.FilePath (splitPath, takeDirectory, joinPath)
-
--- | 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