summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--hakyll.cabal4
-rw-r--r--src/Hakyll.hs8
-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
-rw-r--r--tests/Hakyll/Web/Urls/Relativize/Tests.hs (renamed from tests/Hakyll/Web/RelativizeUrls/Tests.hs)4
-rw-r--r--tests/Hakyll/Web/Urls/Tests.hs38
-rw-r--r--tests/Hakyll/Web/Util/Url/Tests.hs25
-rw-r--r--tests/TestSuite.hs12
12 files changed, 115 insertions, 96 deletions
diff --git a/hakyll.cabal b/hakyll.cabal
index 52ef48f..96b656e 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -115,12 +115,12 @@ Library
Hakyll.Web.Page.Read
Hakyll.Web.Pandoc
Hakyll.Web.Pandoc.FileType
- Hakyll.Web.RelativizeUrls
Hakyll.Web.Tags
Hakyll.Web.Template
Hakyll.Web.Template.Read
+ Hakyll.Web.Urls
+ Hakyll.Web.Urls.Relativize
Hakyll.Web.Util.Html
- Hakyll.Web.Util.Url
Other-Modules:
Hakyll.Core.Compiler.Internal
diff --git a/src/Hakyll.hs b/src/Hakyll.hs
index 268c9ae..a0e48f5 100644
--- a/src/Hakyll.hs
+++ b/src/Hakyll.hs
@@ -26,11 +26,11 @@ module Hakyll
, module Hakyll.Web.Page.Read
, module Hakyll.Web.Pandoc
, module Hakyll.Web.Pandoc.FileType
- , module Hakyll.Web.RelativizeUrls
+ , module Hakyll.Web.Urls
+ , module Hakyll.Web.Urls.Relativize
, module Hakyll.Web.Tags
, module Hakyll.Web.Template
, module Hakyll.Web.Util.Html
- , module Hakyll.Web.Util.Url
) where
import Hakyll.Core.Compiler
@@ -58,8 +58,8 @@ import Hakyll.Web.Page.Metadata
import Hakyll.Web.Page.Read
import Hakyll.Web.Pandoc
import Hakyll.Web.Pandoc.FileType
-import Hakyll.Web.RelativizeUrls
+import Hakyll.Web.Urls
+import Hakyll.Web.Urls.Relativize
import Hakyll.Web.Tags
import Hakyll.Web.Template
import Hakyll.Web.Util.Html
-import Hakyll.Web.Util.Url
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
diff --git a/tests/Hakyll/Web/RelativizeUrls/Tests.hs b/tests/Hakyll/Web/Urls/Relativize/Tests.hs
index 05971ad..00f5a0f 100644
--- a/tests/Hakyll/Web/RelativizeUrls/Tests.hs
+++ b/tests/Hakyll/Web/Urls/Relativize/Tests.hs
@@ -1,12 +1,12 @@
{-# LANGUAGE OverloadedStrings #-}
-module Hakyll.Web.RelativizeUrls.Tests
+module Hakyll.Web.Urls.Relativize.Tests
( tests
) where
import Test.Framework
import Test.HUnit hiding (Test)
-import Hakyll.Web.RelativizeUrls
+import Hakyll.Web.Urls.Relativize
import TestSuite.Util
tests :: [Test]
diff --git a/tests/Hakyll/Web/Urls/Tests.hs b/tests/Hakyll/Web/Urls/Tests.hs
new file mode 100644
index 0000000..db7a10b
--- /dev/null
+++ b/tests/Hakyll/Web/Urls/Tests.hs
@@ -0,0 +1,38 @@
+module Hakyll.Web.Urls.Tests
+ ( tests
+ ) where
+
+import Data.Char (toUpper)
+
+import Test.Framework
+import Test.HUnit hiding (Test)
+
+import Hakyll.Web.Urls
+import TestSuite.Util
+
+tests :: [Test]
+tests = concat
+ [ fromAssertions "withUrls"
+ [ "<a href=\"FOO\">bar</a>" @=?
+ withUrls (map toUpper) "<a href=\"foo\">bar</a>"
+ , "<img src=\"OH BAR\">" @=?
+ withUrls (map toUpper) "<img src=\"oh bar\">"
+ ]
+ , fromAssertions "toUrl"
+ [ "/foo/bar.html" @=? toUrl "foo/bar.html"
+ , "/" @=? toUrl "/"
+ , "/funny-pics.html" @=? toUrl "/funny-pics.html"
+ ]
+ , fromAssertions "toSiteRoot"
+ [ ".." @=? toSiteRoot "/foo/bar.html"
+ , "." @=? toSiteRoot "index.html"
+ , "." @=? toSiteRoot "/index.html"
+ , "../.." @=? toSiteRoot "foo/bar/qux"
+ ]
+ , fromAssertions "isExternal"
+ [ assert (isExternal "http://reddit.com")
+ , assert (isExternal "https://mail.google.com")
+ , assert (not (isExternal "../header.png"))
+ , assert (not (isExternal "/foo/index.html"))
+ ]
+ ]
diff --git a/tests/Hakyll/Web/Util/Url/Tests.hs b/tests/Hakyll/Web/Util/Url/Tests.hs
deleted file mode 100644
index aab4172..0000000
--- a/tests/Hakyll/Web/Util/Url/Tests.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-module Hakyll.Web.Util.Url.Tests
- ( tests
- ) where
-
-import Test.Framework
-import Test.HUnit hiding (Test)
-
-import Hakyll.Web.Util.Url
-import TestSuite.Util
-
-tests :: [Test]
-tests = concat
- [ fromAssertions "toUrl"
- [ "/foo/bar.html" @=? toUrl "foo/bar.html"
- , "/" @=? toUrl "/"
- , "/funny-pics.html" @=? toUrl "/funny-pics.html"
- ]
-
- , fromAssertions "toSiteRoot"
- [ ".." @=? toSiteRoot "/foo/bar.html"
- , "." @=? toSiteRoot "index.html"
- , "." @=? toSiteRoot "/index.html"
- , "../.." @=? toSiteRoot "foo/bar/qux"
- ]
- ]
diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs
index 0f13106..fdd5e56 100644
--- a/tests/TestSuite.hs
+++ b/tests/TestSuite.hs
@@ -10,10 +10,10 @@ import qualified Hakyll.Core.Store.Tests
import qualified Hakyll.Core.UnixFilter.Tests
import qualified Hakyll.Web.Page.Tests
import qualified Hakyll.Web.Page.Metadata.Tests
-import qualified Hakyll.Web.RelativizeUrls.Tests
import qualified Hakyll.Web.Template.Tests
+import qualified Hakyll.Web.Urls.Tests
+import qualified Hakyll.Web.Urls.Relativize.Tests
import qualified Hakyll.Web.Util.Html.Tests
-import qualified Hakyll.Web.Util.Url.Tests
main :: IO ()
main = defaultMain
@@ -33,12 +33,12 @@ main = defaultMain
Hakyll.Web.Page.Tests.tests
, testGroup "Hakyll.Web.Page.Metadata.Tests"
Hakyll.Web.Page.Metadata.Tests.tests
- , testGroup "Hakyll.Web.RelativizeUrls.Tests"
- Hakyll.Web.RelativizeUrls.Tests.tests
, testGroup "Hakyll.Web.Template.Tests"
Hakyll.Web.Template.Tests.tests
+ , testGroup "Hakyll.Web.Urls.Tests"
+ Hakyll.Web.Urls.Tests.tests
+ , testGroup "Hakyll.Web.Urls.Relativize.Tests"
+ Hakyll.Web.Urls.Relativize.Tests.tests
, testGroup "Hakyll.Web.Util.Html.Tests"
Hakyll.Web.Util.Html.Tests.tests
- , testGroup "Hakyll.Web.Util.Url.Tests"
- Hakyll.Web.Util.Url.Tests.tests
]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 07:09:23 +0000