git.iko.soy/hakyll
on master help sign in
Add demoteHeaders, refactor a bit
commit69ffbe03563cdbc7be6b826e2def2fc797442792 authorJasper Van der Jeugt <m@jaspervdj.be> dateTue 25 Dec 2012, 22:49 (14 years ago) parent2ae11c9
12 files changed+216−199
compare with master
unifiedsplit
hakyll.cabal+4−6 src/Hakyll.hs+31−31 src/Hakyll/Web/Html.hs+147 src/Hakyll/Web/Urls/Relativize.hs → src/Hakyll/Web/Html/RelativizeUrls.hs+2−2 src/Hakyll/Web/Tags.hs+1−1 src/Hakyll/Web/Template/Context.hs+1−1 src/Hakyll/Web/Urls.hs−66 src/Hakyll/Web/Util/Html.hs−47 tests/Hakyll/Web/Urls/Relativize/Tests.hs → tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs+5−5 tests/Hakyll/Web/Urls/Tests.hs → tests/Hakyll/Web/Html/Tests.hs+20−4 tests/Hakyll/Web/Util/Html/Tests.hs−29 tests/TestSuite.hs+5−7
hakyll.cabal+4−6
@@ -126,6 +126,8 @@ Library
126126 Hakyll.Main
127127 Hakyll.Web.CompressCss
128128 Hakyll.Web.Feed
129+ Hakyll.Web.Html
130+ Hakyll.Web.Html.RelativizeUrls
129131 Hakyll.Web.Pandoc
130132 Hakyll.Web.Pandoc.Biblio
131133 Hakyll.Web.Pandoc.FileType
@@ -134,9 +136,6 @@ Library
134136 Hakyll.Web.Template.Context
135137 Hakyll.Web.Template.List
136138 Hakyll.Web.Template.Read
137− Hakyll.Web.Urls
138− Hakyll.Web.Urls.Relativize
139− Hakyll.Web.Util.Html
140139
141140 Other-Modules:
142141 Hakyll.Core.Compiler.Internal
@@ -223,9 +222,8 @@ Test-suite hakyll-tests
223222 Hakyll.Core.Util.String.Tests
224223 Hakyll.Web.Template.Context.Tests
225224 Hakyll.Web.Template.Tests
226− Hakyll.Web.Urls.Tests
227− Hakyll.Web.Urls.Relativize.Tests
228− Hakyll.Web.Util.Html.Tests
225+ Hakyll.Web.Html.Tests
226+ Hakyll.Web.Html.RelativizeUrls.Tests
229227 TestSuite.Util
230228
231229Executable hakyll-init
src/Hakyll.hs+31−31
@@ -1,5 +1,5 @@
1+--------------------------------------------------------------------------------
12-- | Top-level module exporting all modules that are interesting for the user
2−--
33{-# LANGUAGE CPP #-}
44module Hakyll
55 ( module Hakyll.Core.Compiler
@@ -20,45 +20,45 @@ module Hakyll
2020 , module Hakyll.Main
2121 , module Hakyll.Web.CompressCss
2222 , module Hakyll.Web.Feed
23+ , module Hakyll.Web.Html
24+ , module Hakyll.Web.Html.RelativizeUrls
2325 , module Hakyll.Web.Pandoc
2426 , module Hakyll.Web.Pandoc.Biblio
2527 , module Hakyll.Web.Pandoc.FileType
26− , module Hakyll.Web.Urls
27− , module Hakyll.Web.Urls.Relativize
2828 , module Hakyll.Web.Tags
2929 , module Hakyll.Web.Template
3030 , module Hakyll.Web.Template.Context
3131 , module Hakyll.Web.Template.List
3232 , module Hakyll.Web.Template.Read
33− , module Hakyll.Web.Util.Html
3433 ) where
3534
36−import Hakyll.Core.Compiler
37−import Hakyll.Core.Configuration
38−import Hakyll.Core.Identifier
39−import Hakyll.Core.Identifier.Pattern
40−import Hakyll.Core.Item
41−import Hakyll.Core.Metadata
42−import Hakyll.Core.Routes
43−import Hakyll.Core.Rules
35+
36+--------------------------------------------------------------------------------
37+import Hakyll.Core.Compiler
38+import Hakyll.Core.Configuration
39+import Hakyll.Core.Identifier
40+import Hakyll.Core.Identifier.Pattern
41+import Hakyll.Core.Item
42+import Hakyll.Core.Metadata
43+import Hakyll.Core.Routes
44+import Hakyll.Core.Rules
4445#ifdef UNIX_FILTER
45−import Hakyll.Core.UnixFilter
46+import Hakyll.Core.UnixFilter
4647#endif
47−import Hakyll.Core.Util.File
48−import Hakyll.Core.Util.String
49−import Hakyll.Core.Writable
50−import Hakyll.Core.Writable.CopyFile
51−import Hakyll.Main
52−import Hakyll.Web.CompressCss
53−import Hakyll.Web.Feed
54−import Hakyll.Web.Pandoc
55−import Hakyll.Web.Pandoc.Biblio
56−import Hakyll.Web.Pandoc.FileType
57−import Hakyll.Web.Urls
58−import Hakyll.Web.Urls.Relativize
59−import Hakyll.Web.Tags
60−import Hakyll.Web.Template
61−import Hakyll.Web.Template.Context
62−import Hakyll.Web.Template.List
63−import Hakyll.Web.Template.Read
64−import Hakyll.Web.Util.Html
48+import Hakyll.Core.Util.File
49+import Hakyll.Core.Util.String
50+import Hakyll.Core.Writable
51+import Hakyll.Core.Writable.CopyFile
52+import Hakyll.Main
53+import Hakyll.Web.CompressCss
54+import Hakyll.Web.Feed
55+import Hakyll.Web.Html
56+import Hakyll.Web.Html.RelativizeUrls
57+import Hakyll.Web.Pandoc
58+import Hakyll.Web.Pandoc.Biblio
59+import Hakyll.Web.Pandoc.FileType
60+import Hakyll.Web.Tags
61+import Hakyll.Web.Template
62+import Hakyll.Web.Template.Context
63+import Hakyll.Web.Template.List
64+import Hakyll.Web.Template.Read
src/Hakyll/Web/Html.hsnew file+147
@@ -0,0 +1,147 @@
1+--------------------------------------------------------------------------------
2+-- | Provides utilities to manipulate HTML pages
3+module Hakyll.Web.Html
4+ ( -- * Generic
5+ withTags
6+
7+ -- * Headers
8+ , demoteHeaders
9+
10+ -- * Url manipulation
11+ , withUrls
12+ , toUrl
13+ , toSiteRoot
14+ , isExternal
15+
16+ -- * Stripping/escaping
17+ , stripTags
18+ , escapeHtml
19+ ) where
20+
21+
22+--------------------------------------------------------------------------------
23+import Data.Char (digitToInt, intToDigit, isDigit, toLower)
24+import Data.List (isPrefixOf)
25+import qualified Data.Set as S
26+import System.FilePath (joinPath, splitPath, takeDirectory)
27+import Text.Blaze.Html (toHtml)
28+import Text.Blaze.Html.Renderer.String (renderHtml)
29+
30+
31+--------------------------------------------------------------------------------
32+import qualified Text.HTML.TagSoup as TS
33+
34+
35+--------------------------------------------------------------------------------
36+-- | Map over all tags in the document
37+withTags :: (TS.Tag String -> TS.Tag String) -> String -> String
38+withTags f = renderTags' . map f . TS.parseTags
39+
40+
41+--------------------------------------------------------------------------------
42+-- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc.
43+demoteHeaders :: String -> String
44+demoteHeaders = withTags $ \tag -> case tag of
45+ TS.TagOpen t a -> TS.TagOpen (demote t) a
46+ TS.TagClose t -> TS.TagClose (demote t)
47+ t -> t
48+ where
49+ demote t@['h', n]
50+ | isDigit n = ['h', intToDigit (min 6 $ digitToInt n + 1)]
51+ | otherwise = t
52+ demote t = t
53+
54+
55+--------------------------------------------------------------------------------
56+-- | Apply a function to each URL on a webpage
57+withUrls :: (String -> String) -> String -> String
58+withUrls f = withTags tag
59+ where
60+ tag (TS.TagOpen s a) = TS.TagOpen s $ map attr a
61+ tag x = x
62+ attr (k, v) = (k, if k `S.member` refs then f v else v)
63+ refs = S.fromList ["src", "href"]
64+
65+
66+-- | Customized TagSoup renderer. (The default TagSoup renderer escape CSS
67+-- within style tags.)
68+renderTags' :: [TS.Tag String] -> String
69+renderTags' = TS.renderTagsOptions TS.renderOptions
70+ { TS.optRawTag = (`elem` ["script", "style"]) . map toLower
71+ , TS.optMinimize = (`elem` ["br", "img"])
72+ }
73+
74+
75+--------------------------------------------------------------------------------
76+-- | Convert a filepath to an URL starting from the site root
77+--
78+-- Example:
79+--
80+-- > toUrl "foo/bar.html"
81+--
82+-- Result:
83+--
84+-- > "/foo/bar.html"
85+toUrl :: FilePath -> String
86+toUrl ('/' : xs) = '/' : xs
87+toUrl url = '/' : url
88+
89+
90+--------------------------------------------------------------------------------
91+-- | Get the relative url to the site root, for a given (absolute) url
92+toSiteRoot :: String -> String
93+toSiteRoot = emptyException . joinPath . map parent
94+ . filter relevant . splitPath . takeDirectory
95+ where
96+ parent = const ".."
97+ emptyException [] = "."
98+ emptyException x = x
99+ relevant "." = False
100+ relevant "/" = False
101+ relevant _ = True
102+
103+
104+--------------------------------------------------------------------------------
105+-- | Check if an URL links to an external HTTP(S) source
106+isExternal :: String -> Bool
107+isExternal url = any (flip isPrefixOf url) ["http://", "https://"]
108+
109+
110+--------------------------------------------------------------------------------
111+-- | Strip all HTML tags from a string
112+--
113+-- Example:
114+--
115+-- > stripTags "<p>foo</p>"
116+--
117+-- Result:
118+--
119+-- > "foo"
120+--
121+-- This also works for incomplete tags
122+--
123+-- Example:
124+--
125+-- > stripTags "<p>foo</p"
126+--
127+-- Result:
128+--
129+-- > "foo"
130+stripTags :: String -> String
131+stripTags [] = []
132+stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs
133+stripTags (x : xs) = x : stripTags xs
134+
135+
136+--------------------------------------------------------------------------------
137+-- | HTML-escape a string
138+--
139+-- Example:
140+--
141+-- > escapeHtml "Me & Dean"
142+--
143+-- Result:
144+--
145+-- > "Me &amp; Dean"
146+escapeHtml :: String -> String
147+escapeHtml = renderHtml . toHtml
src/Hakyll/Web/Urls/Relativize.hs → src/Hakyll/Web/Html/RelativizeUrls.hsrenamed+2−2
@@ -14,7 +14,7 @@
1414-- will result in (suppose your blogpost is located at @\/posts\/foo.html@:
1515--
1616-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />
17−module Hakyll.Web.Urls.Relativize
17+module Hakyll.Web.Html.RelativizeUrls
1818 ( relativizeUrls
1919 , relativizeUrlsWith
2020 ) where
@@ -27,7 +27,7 @@ import Data.List (isPrefixOf)
2727--------------------------------------------------------------------------------
2828import Hakyll.Core.Compiler
2929import Hakyll.Core.Item
30−import Hakyll.Web.Urls
30+import Hakyll.Web.Html
3131
3232
3333--------------------------------------------------------------------------------
src/Hakyll/Web/Tags.hs+1−1
@@ -83,7 +83,7 @@ import Hakyll.Core.Metadata
8383import Hakyll.Core.Rules
8484import Hakyll.Core.Util.String
8585import Hakyll.Web.Template.Context
86−import Hakyll.Web.Urls
86+import Hakyll.Web.Html
8787
8888
8989--------------------------------------------------------------------------------
src/Hakyll/Web/Template/Context.hs+1−1
@@ -40,7 +40,7 @@ import Hakyll.Core.Item
4040import Hakyll.Core.Metadata
4141import Hakyll.Core.Provider
4242import Hakyll.Core.Util.String (splitAll)
43−import Hakyll.Web.Urls
43+import Hakyll.Web.Html
4444
4545
4646--------------------------------------------------------------------------------
src/Hakyll/Web/Urls.hsdeleted−66
@@ -1,66 +0,0 @@
1−-- | Provides utilities to manipulate URL's
2−--
3−module Hakyll.Web.Urls
4− ( withUrls
5− , toUrl
6− , toSiteRoot
7− , isExternal
8− ) where
9−
10−import Data.List (isPrefixOf)
11−import Data.Char (toLower)
12−import System.FilePath (splitPath, takeDirectory, joinPath)
13−import qualified Data.Set as S
14−
15−import qualified Text.HTML.TagSoup as TS
16−
17−-- | Apply a function to each URL on a webpage
18−--
19−withUrls :: (String -> String) -> String -> String
20−withUrls f = renderTags' . map tag . TS.parseTags
21− where
22− tag (TS.TagOpen s a) = TS.TagOpen s $ map attr a
23− tag x = x
24− attr (k, v) = (k, if k `S.member` refs then f v else v)
25− refs = S.fromList ["src", "href"]
26−
27−-- | Customized TagSoup renderer. (The default TagSoup renderer escape CSS
28−-- within style tags.)
29−--
30−renderTags' :: [TS.Tag String] -> String
31−renderTags' = TS.renderTagsOptions TS.renderOptions
32− { TS.optRawTag = (`elem` ["script", "style"]) . map toLower
33− , TS.optMinimize = (`elem` ["br", "img"])
34− }
35−
36−-- | Convert a filepath to an URL starting from the site root
37−--
38−-- Example:
39−--
40−-- > toUrl "foo/bar.html"
41−--
42−-- Result:
43−--
44−-- > "/foo/bar.html"
45−--
46−toUrl :: FilePath -> String
47−toUrl ('/' : xs) = '/' : xs
48−toUrl url = '/' : url
49−
50−-- | Get the relative url to the site root, for a given (absolute) url
51−--
52−toSiteRoot :: String -> String
53−toSiteRoot = emptyException . joinPath . map parent
54− . filter relevant . splitPath . takeDirectory
55− where
56− parent = const ".."
57− emptyException [] = "."
58− emptyException x = x
59− relevant "." = False
60− relevant "/" = False
61− relevant _ = True
62−
63−-- | Check if an URL links to an external HTTP(S) source
64−--
65−isExternal :: String -> Bool
66−isExternal url = any (flip isPrefixOf url) ["http://", "https://"]
src/Hakyll/Web/Util/Html.hsdeleted−47
@@ -1,47 +0,0 @@
1−-- | Miscellaneous HTML manipulation functions
2−--
3−module Hakyll.Web.Util.Html
4− ( stripTags
5− , escapeHtml
6− ) where
7−
8−import Text.Blaze.Html (toHtml)
9−import Text.Blaze.Html.Renderer.String (renderHtml)
10−
11−-- | Strip all HTML tags from a string
12−--
13−-- Example:
14−--
15−-- > stripTags "<p>foo</p>"
16−--
17−-- Result:
18−--
19−-- > "foo"
20−--
21−-- This also works for incomplete tags
22−--
23−-- Example:
24−--
25−-- > stripTags "<p>foo</p"
26−--
27−-- Result:
28−--
29−-- > "foo"
30−--
31−stripTags :: String -> String
32−stripTags [] = []
33−stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs
34−stripTags (x : xs) = x : stripTags xs
35−
36−-- | HTML-escape a string
37−--
38−-- Example:
39−--
40−-- > escapeHtml "Me & Dean"
41−--
42−-- Result:
43−--
44−-- > "Me &amp; Dean"
45−--
46−escapeHtml :: String -> String
47−escapeHtml = renderHtml . toHtml
tests/Hakyll/Web/Urls/Relativize/Tests.hs → tests/Hakyll/Web/Html/RelativizeUrls/Tests.hsrenamed+5−5
@@ -1,22 +1,22 @@
11--------------------------------------------------------------------------------
22{-# LANGUAGE OverloadedStrings #-}
3−module Hakyll.Web.Urls.Relativize.Tests
3+module Hakyll.Web.Html.RelativizeUrls.Tests
44 ( tests
55 ) where
66
77
88--------------------------------------------------------------------------------
9−import Test.Framework (Test, testGroup)
10−import Test.HUnit ((@=?))
9+import Test.Framework (Test, testGroup)
10+import Test.HUnit ((@=?))
1111
1212--------------------------------------------------------------------------------
13−import Hakyll.Web.Urls.Relativize
13+import Hakyll.Web.Html.RelativizeUrls
1414import TestSuite.Util
1515
1616
1717--------------------------------------------------------------------------------
1818tests :: Test
19−tests = testGroup "Hakyll.Web.Urls.Relativize.Tests" $
19+tests = testGroup "Hakyll.Web.Html.RelativizeUrls.Tests" $
2020 fromAssertions "relativizeUrls"
2121 [ "<a href=\"../foo\">bar</a>" @=?
2222 relativizeUrlsWith ".." "<a href=\"/foo\">bar</a>"
tests/Hakyll/Web/Urls/Tests.hs → tests/Hakyll/Web/Html/Tests.hsrenamed+20−4
@@ -1,5 +1,5 @@
11--------------------------------------------------------------------------------
2−module Hakyll.Web.Urls.Tests
2+module Hakyll.Web.Html.Tests
33 ( tests
44 ) where
55
@@ -11,14 +11,19 @@ import Test.HUnit (assert, (@=?))
1111
1212
1313--------------------------------------------------------------------------------
14−import Hakyll.Web.Urls
14+import Hakyll.Web.Html
1515import TestSuite.Util
1616
1717
1818--------------------------------------------------------------------------------
1919tests :: Test
20−tests = testGroup "Hakyll.Web.Urls.Tests" $ concat
21− [ fromAssertions "withUrls"
20+tests = testGroup "Hakyll.Web.Html.Tests" $ concat
21+ [ fromAssertions "demoteHeaders"
22+ [ "<h2>A h1 title</h2>" @=?
23+ demoteHeaders "<h1>A h1 title</h1>"
24+ ]
25+
26+ , fromAssertions "withUrls"
2227 [ "<a href=\"FOO\">bar</a>" @=?
2328 withUrls (map toUpper) "<a href=\"foo\">bar</a>"
2429 , "<img src=\"OH BAR\" />" @=?
@@ -52,4 +57,15 @@ tests = testGroup "Hakyll.Web.Urls.Tests" $ concat
5257 , assert (not (isExternal "../header.png"))
5358 , assert (not (isExternal "/foo/index.html"))
5459 ]
60+
61+ , fromAssertions "stripTags"
62+ [ "foo" @=? stripTags "<p>foo</p>"
63+ , "foo bar" @=? stripTags "<p>foo</p> bar"
64+ , "foo" @=? stripTags "<p>foo</p"
65+ ]
66+
67+ , fromAssertions "escapeHtml"
68+ [ "Me &amp; Dean" @=? escapeHtml "Me & Dean"
69+ , "&lt;img&gt;" @=? escapeHtml "<img>"
70+ ]
5571 ]
tests/Hakyll/Web/Util/Html/Tests.hsdeleted−29
@@ -1,29 +0,0 @@
1−--------------------------------------------------------------------------------
2−module Hakyll.Web.Util.Html.Tests
3− ( tests
4− ) where
5−
6−
7−--------------------------------------------------------------------------------
8−import Test.Framework (Test, testGroup)
9−import Test.HUnit ((@=?))
10−
11−
12−--------------------------------------------------------------------------------
13−import Hakyll.Web.Util.Html
14−import TestSuite.Util
15−
16−
17−--------------------------------------------------------------------------------
18−tests :: Test
19−tests = testGroup "Hakyll.Web.Util.Html" $ concat
20− [ fromAssertions "stripTags"
21− [ "foo" @=? stripTags "<p>foo</p>"
22− , "foo bar" @=? stripTags "<p>foo</p> bar"
23− , "foo" @=? stripTags "<p>foo</p"
24− ]
25− , fromAssertions "escapeHtml"
26− [ "Me &amp; Dean" @=? escapeHtml "Me & Dean"
27− , "&lt;img&gt;" @=? escapeHtml "<img>"
28− ]
29− ]
tests/TestSuite.hs+5−7
@@ -5,7 +5,7 @@ module Main
55
66
77--------------------------------------------------------------------------------
8−import Test.Framework (defaultMain)
8+import Test.Framework (defaultMain)
99
1010
1111--------------------------------------------------------------------------------
@@ -18,11 +18,10 @@ import qualified Hakyll.Core.Runtime.Tests
1818import qualified Hakyll.Core.Store.Tests
1919import qualified Hakyll.Core.UnixFilter.Tests
2020import qualified Hakyll.Core.Util.String.Tests
21+import qualified Hakyll.Web.Html.RelativizeUrls.Tests
22+import qualified Hakyll.Web.Html.Tests
2123import qualified Hakyll.Web.Template.Context.Tests
2224import qualified Hakyll.Web.Template.Tests
23−import qualified Hakyll.Web.Urls.Relativize.Tests
24−import qualified Hakyll.Web.Urls.Tests
25−import qualified Hakyll.Web.Util.Html.Tests
2625
2726
2827--------------------------------------------------------------------------------
@@ -37,9 +36,8 @@ main = defaultMain
3736 , Hakyll.Core.Store.Tests.tests
3837 , Hakyll.Core.UnixFilter.Tests.tests
3938 , Hakyll.Core.Util.String.Tests.tests
39+ , Hakyll.Web.Html.RelativizeUrls.Tests.tests
40+ , Hakyll.Web.Html.Tests.tests
4041 , Hakyll.Web.Template.Context.Tests.tests
4142 , Hakyll.Web.Template.Tests.tests
42− , Hakyll.Web.Urls.Relativize.Tests.tests
43− , Hakyll.Web.Urls.Tests.tests
44− , Hakyll.Web.Util.Html.Tests.tests
4543 ]