75f157c · hakyll · git.iko.soy

git.iko.soy/hakyll

Add some URL utilities

commit75f157ca8c319d770f02c38d65226bb3de495a0e authorJasper Van der Jeugt <m@jaspervdj.be> dateTue 6 Sep 2011, 22:26 (15 years ago) parentbf4115e

12 files changed+115−96

compare with master

unifiedsplit

hakyll.cabal+2−2 src/Hakyll.hs+4−4 src/Hakyll/Web/Feed.hs+1−1 src/Hakyll/Web/Page.hs+1−1 src/Hakyll/Web/Tags.hs+1−1 src/Hakyll/Web/Urls.hs+56 src/Hakyll/Web/RelativizeUrls.hs → src/Hakyll/Web/Urls/Relativize.hs+4−19 src/Hakyll/Web/Util/Url.hs−35 tests/Hakyll/Web/RelativizeUrls/Tests.hs → tests/Hakyll/Web/Urls/Relativize/Tests.hs+2−2 tests/Hakyll/Web/Urls/Tests.hs+38 tests/Hakyll/Web/Util/Url/Tests.hs−25 tests/TestSuite.hs+6−6

hakyll.cabal+2−2

@@ -115,12 +115,12 @@ Library

115115 Hakyll.Web.Page.Read

116116 Hakyll.Web.Pandoc

117117 Hakyll.Web.Pandoc.FileType

118− Hakyll.Web.RelativizeUrls

119118 Hakyll.Web.Tags

120119 Hakyll.Web.Template

121120 Hakyll.Web.Template.Read

121+ Hakyll.Web.Urls

122+ Hakyll.Web.Urls.Relativize

122123 Hakyll.Web.Util.Html

123− Hakyll.Web.Util.Url

124124

125125 Other-Modules:

126126 Hakyll.Core.Compiler.Internal

src/Hakyll.hs+4−4

@@ -26,11 +26,11 @@ module Hakyll

2626 , module Hakyll.Web.Page.Read

2727 , module Hakyll.Web.Pandoc

2828 , module Hakyll.Web.Pandoc.FileType

29− , module Hakyll.Web.RelativizeUrls

29+ , module Hakyll.Web.Urls

30+ , module Hakyll.Web.Urls.Relativize

3031 , module Hakyll.Web.Tags

3132 , module Hakyll.Web.Template

3233 , module Hakyll.Web.Util.Html

33− , module Hakyll.Web.Util.Url

3434 ) where

3535

3636import Hakyll.Core.Compiler

@@ -58,8 +58,8 @@ import Hakyll.Web.Page.Metadata

5858import Hakyll.Web.Page.Read

5959import Hakyll.Web.Pandoc

6060import Hakyll.Web.Pandoc.FileType

61−import Hakyll.Web.RelativizeUrls

61+import Hakyll.Web.Urls

62+import Hakyll.Web.Urls.Relativize

6263import Hakyll.Web.Tags

6364import Hakyll.Web.Template

6465import Hakyll.Web.Util.Html

65−import Hakyll.Web.Util.Url

src/Hakyll/Web/Feed.hs+1−1

@@ -33,7 +33,7 @@ import Hakyll.Web.Page

3333import Hakyll.Web.Page.Metadata

3434import Hakyll.Web.Template

3535import Hakyll.Web.Template.Read.Hakyll (readTemplate)

36−import Hakyll.Web.Util.Url

36+import Hakyll.Web.Urls

3737

3838import Paths_hakyll

3939

src/Hakyll/Web/Page.hs+1−1

@@ -78,7 +78,7 @@ import Hakyll.Web.Page.Read

7878import Hakyll.Web.Page.Metadata

7979import Hakyll.Web.Pandoc

8080import Hakyll.Web.Template

81−import Hakyll.Web.Util.Url

81+import Hakyll.Web.Urls

8282

8383-- | Create a page from a body, without metadata

8484--

src/Hakyll/Web/Tags.hs+1−1

@@ -55,7 +55,7 @@ import qualified Text.Blaze.Html5.Attributes as A

5555

5656import Hakyll.Web.Page

5757import Hakyll.Web.Page.Metadata

58−import Hakyll.Web.Util.Url

58+import Hakyll.Web.Urls

5959import Hakyll.Core.Writable

6060import Hakyll.Core.Identifier

6161import Hakyll.Core.Compiler

src/Hakyll/Web/Urls.hsnew file+56

@@ -0,0 +1,56 @@

1+-- | Provides utilities to manipulate URL's

2+--

3+module Hakyll.Web.Urls

4+ ( withUrls

5+ , toUrl

6+ , toSiteRoot

7+ , isExternal

8+ ) where

10+import Data.List (isPrefixOf)

11+import System.FilePath (splitPath, takeDirectory, joinPath)

12+import qualified Data.Set as S

13+

14+import Text.HTML.TagSoup (Tag (..), renderTags, parseTags)

15+

16+-- | Apply a function to each URL on a webpage

17+--

18+withUrls :: (String -> String) -> String -> String

19+withUrls f = renderTags . map tag . parseTags

20+ where

21+ tag (TagOpen s a) = TagOpen s $ map attr a

22+ tag x = x

23+ attr (k, v) = (k, if k `S.member` refs then f v else v)

24+ refs = S.fromList ["src", "href"]

25+

26+-- | Convert a filepath to an URL starting from the site root

27+--

28+-- Example:

29+--

30+-- > toUrl "foo/bar.html"

31+--

32+-- Result:

33+--

34+-- > "/foo/bar.html"

35+--

36+toUrl :: FilePath -> String

37+toUrl ('/' : xs) = '/' : xs

38+toUrl url = '/' : url

39+

40+-- | Get the relative url to the site root, for a given (absolute) url

41+--

42+toSiteRoot :: String -> String

43+toSiteRoot = emptyException . joinPath . map parent

44+ . filter relevant . splitPath . takeDirectory

45+ where

46+ parent = const ".."

47+ emptyException [] = "."

48+ emptyException x = x

49+ relevant "." = False

50+ relevant "/" = False

51+ relevant _ = True

52+

53+-- | Check if an URL links to an external HTTP(S) source

54+--

55+isExternal :: String -> Bool

56+isExternal url = any (flip isPrefixOf url) ["http://", "https://"]

src/Hakyll/Web/RelativizeUrls.hs → src/Hakyll/Web/Urls/Relativize.hsrenamed+4−19

@@ -14,7 +14,7 @@

1414--

1515-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />

1616--

17−module Hakyll.Web.RelativizeUrls

17+module Hakyll.Web.Urls.Relativize

1818 ( relativizeUrlsCompiler

1919 , relativizeUrls

2020 ) where

@@ -23,13 +23,10 @@ import Prelude hiding (id)

2323import Control.Category (id)

2424import Control.Arrow ((&&&), (>>^))

2525import Data.List (isPrefixOf)

26−import qualified Data.Set as S

27−

28−import Text.HTML.TagSoup

2926

3027import Hakyll.Core.Compiler

3128import Hakyll.Web.Page

32−import Hakyll.Web.Util.Url

29+import Hakyll.Web.Urls

3330

3431-- | Compiler form of 'relativizeUrls' which automatically picks the right root

3532-- path

@@ -45,18 +42,6 @@ relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize

4542relativizeUrls :: String -- ^ Path to the site root

4643 -> String -- ^ HTML to relativize

4744 -> String -- ^ Resulting HTML

48−relativizeUrls root = renderTags . map relativizeUrls' . parseTags

49− where

50− relativizeUrls' (TagOpen s a) = TagOpen s $ map (relativizeUrlsAttrs root) a

51− relativizeUrls' x = x

52−

53−-- | Relativize URL's in attributes

54−--

55−relativizeUrlsAttrs :: String -- ^ Path to the site root

56− -> Attribute String -- ^ Attribute to relativize

57− -> Attribute String -- ^ Resulting attribute

58−relativizeUrlsAttrs root (key, value)

59− | key `S.member` urls && "/" `isPrefixOf` value = (key, root ++ value)

60− | otherwise = (key, value)

45+relativizeUrls root = withUrls rel

6146 where

62− urls = S.fromList ["src", "href"]

47+ rel x = if "/" `isPrefixOf` x then root ++ x else x

src/Hakyll/Web/Util/Url.hsdeleted−35

@@ -1,35 +0,0 @@

1−-- | Miscellaneous URL manipulation functions.

2−--

3−module Hakyll.Web.Util.Url

4− ( toUrl

5− , toSiteRoot

6− ) where

7−

8−import System.FilePath (splitPath, takeDirectory, joinPath)

9−

10−-- | Convert a filepath to an URL starting from the site root

11−--

12−-- Example:

13−--

14−-- > toUrl "foo/bar.html"

15−--

16−-- Result:

17−--

18−-- > "/foo/bar.html"

19−--

20−toUrl :: FilePath -> String

21−toUrl ('/' : xs) = '/' : xs

22−toUrl url = '/' : url

23−

24−-- | Get the relative url to the site root, for a given (absolute) url

25−--

26−toSiteRoot :: String -> String

27−toSiteRoot = emptyException . joinPath . map parent

28− . filter relevant . splitPath . takeDirectory

29− where

30− parent = const ".."

31− emptyException [] = "."

32− emptyException x = x

33− relevant "." = False

34− relevant "/" = False

35− relevant _ = True

tests/Hakyll/Web/RelativizeUrls/Tests.hs → tests/Hakyll/Web/Urls/Relativize/Tests.hsrenamed+2−2

@@ -1,12 +1,12 @@

11{-# LANGUAGE OverloadedStrings #-}

2−module Hakyll.Web.RelativizeUrls.Tests

2+module Hakyll.Web.Urls.Relativize.Tests

33 ( tests

44 ) where

66import Test.Framework

77import Test.HUnit hiding (Test)

9−import Hakyll.Web.RelativizeUrls

9+import Hakyll.Web.Urls.Relativize

1010import TestSuite.Util

1111

1212tests :: [Test]

tests/Hakyll/Web/Urls/Tests.hsnew file+38

@@ -0,0 +1,38 @@

1+module Hakyll.Web.Urls.Tests

2+ ( tests

3+ ) where

5+import Data.Char (toUpper)

7+import Test.Framework

8+import Test.HUnit hiding (Test)

10+import Hakyll.Web.Urls

11+import TestSuite.Util

12+

13+tests :: [Test]

14+tests = concat

15+ [ fromAssertions "withUrls"

16+ [ "<a href=\"FOO\">bar</a>" @=?

17+ withUrls (map toUpper) "<a href=\"foo\">bar</a>"

18+ , "<img src=\"OH BAR\">" @=?

19+ withUrls (map toUpper) "<img src=\"oh bar\">"

20+ ]

21+ , fromAssertions "toUrl"

22+ [ "/foo/bar.html" @=? toUrl "foo/bar.html"

23+ , "/" @=? toUrl "/"

24+ , "/funny-pics.html" @=? toUrl "/funny-pics.html"

25+ ]

26+ , fromAssertions "toSiteRoot"

27+ [ ".." @=? toSiteRoot "/foo/bar.html"

28+ , "." @=? toSiteRoot "index.html"

29+ , "." @=? toSiteRoot "/index.html"

30+ , "../.." @=? toSiteRoot "foo/bar/qux"

31+ ]

32+ , fromAssertions "isExternal"

33+ [ assert (isExternal "http://reddit.com")

34+ , assert (isExternal "https://mail.google.com")

35+ , assert (not (isExternal "../header.png"))

36+ , assert (not (isExternal "/foo/index.html"))

37+ ]

38+ ]

tests/Hakyll/Web/Util/Url/Tests.hsdeleted−25

@@ -1,25 +0,0 @@

1−module Hakyll.Web.Util.Url.Tests

2− ( tests

3− ) where

4−

5−import Test.Framework

6−import Test.HUnit hiding (Test)

7−

8−import Hakyll.Web.Util.Url

9−import TestSuite.Util

10−

11−tests :: [Test]

12−tests = concat

13− [ fromAssertions "toUrl"

14− [ "/foo/bar.html" @=? toUrl "foo/bar.html"

15− , "/" @=? toUrl "/"

16− , "/funny-pics.html" @=? toUrl "/funny-pics.html"

17− ]

18−

19− , fromAssertions "toSiteRoot"

20− [ ".." @=? toSiteRoot "/foo/bar.html"

21− , "." @=? toSiteRoot "index.html"

22− , "." @=? toSiteRoot "/index.html"

23− , "../.." @=? toSiteRoot "foo/bar/qux"

24− ]

25− ]

tests/TestSuite.hs+6−6

@@ -10,10 +10,10 @@ import qualified Hakyll.Core.Store.Tests

1010import qualified Hakyll.Core.UnixFilter.Tests

1111import qualified Hakyll.Web.Page.Tests

1212import qualified Hakyll.Web.Page.Metadata.Tests

13−import qualified Hakyll.Web.RelativizeUrls.Tests

1413import qualified Hakyll.Web.Template.Tests

14+import qualified Hakyll.Web.Urls.Tests

15+import qualified Hakyll.Web.Urls.Relativize.Tests

1516import qualified Hakyll.Web.Util.Html.Tests

16−import qualified Hakyll.Web.Util.Url.Tests

1717

1818main :: IO ()

1919main = defaultMain

@@ -33,12 +33,12 @@ main = defaultMain

3333 Hakyll.Web.Page.Tests.tests

3434 , testGroup "Hakyll.Web.Page.Metadata.Tests"

3535 Hakyll.Web.Page.Metadata.Tests.tests

36− , testGroup "Hakyll.Web.RelativizeUrls.Tests"

37− Hakyll.Web.RelativizeUrls.Tests.tests

3836 , testGroup "Hakyll.Web.Template.Tests"

3937 Hakyll.Web.Template.Tests.tests

38+ , testGroup "Hakyll.Web.Urls.Tests"

39+ Hakyll.Web.Urls.Tests.tests

40+ , testGroup "Hakyll.Web.Urls.Relativize.Tests"

41+ Hakyll.Web.Urls.Relativize.Tests.tests

4042 , testGroup "Hakyll.Web.Util.Html.Tests"

4143 Hakyll.Web.Util.Html.Tests.tests

42− , testGroup "Hakyll.Web.Util.Url.Tests"

43− Hakyll.Web.Util.Url.Tests.tests

4444 ]