summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll.hs62
-rw-r--r--src/Hakyll/Web/Html.hs147
-rw-r--r--src/Hakyll/Web/Html/RelativizeUrls.hs (renamed from src/Hakyll/Web/Urls/Relativize.hs)4
-rw-r--r--src/Hakyll/Web/Tags.hs2
-rw-r--r--src/Hakyll/Web/Template/Context.hs2
-rw-r--r--src/Hakyll/Web/Urls.hs66
-rw-r--r--src/Hakyll/Web/Util/Html.hs47
7 files changed, 182 insertions, 148 deletions
diff --git a/src/Hakyll.hs b/src/Hakyll.hs
index 12f14bb..1131772 100644
--- a/src/Hakyll.hs
+++ b/src/Hakyll.hs
@@ -1,5 +1,5 @@
+--------------------------------------------------------------------------------
-- | Top-level module exporting all modules that are interesting for the user
---
{-# LANGUAGE CPP #-}
module Hakyll
( module Hakyll.Core.Compiler
@@ -20,45 +20,45 @@ module Hakyll
, module Hakyll.Main
, module Hakyll.Web.CompressCss
, module Hakyll.Web.Feed
+ , module Hakyll.Web.Html
+ , module Hakyll.Web.Html.RelativizeUrls
, module Hakyll.Web.Pandoc
, module Hakyll.Web.Pandoc.Biblio
, module Hakyll.Web.Pandoc.FileType
- , module Hakyll.Web.Urls
- , module Hakyll.Web.Urls.Relativize
, module Hakyll.Web.Tags
, module Hakyll.Web.Template
, module Hakyll.Web.Template.Context
, module Hakyll.Web.Template.List
, module Hakyll.Web.Template.Read
- , module Hakyll.Web.Util.Html
) where
-import Hakyll.Core.Compiler
-import Hakyll.Core.Configuration
-import Hakyll.Core.Identifier
-import Hakyll.Core.Identifier.Pattern
-import Hakyll.Core.Item
-import Hakyll.Core.Metadata
-import Hakyll.Core.Routes
-import Hakyll.Core.Rules
+
+--------------------------------------------------------------------------------
+import Hakyll.Core.Compiler
+import Hakyll.Core.Configuration
+import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
+import Hakyll.Core.Item
+import Hakyll.Core.Metadata
+import Hakyll.Core.Routes
+import Hakyll.Core.Rules
#ifdef UNIX_FILTER
-import Hakyll.Core.UnixFilter
+import Hakyll.Core.UnixFilter
#endif
-import Hakyll.Core.Util.File
-import Hakyll.Core.Util.String
-import Hakyll.Core.Writable
-import Hakyll.Core.Writable.CopyFile
-import Hakyll.Main
-import Hakyll.Web.CompressCss
-import Hakyll.Web.Feed
-import Hakyll.Web.Pandoc
-import Hakyll.Web.Pandoc.Biblio
-import Hakyll.Web.Pandoc.FileType
-import Hakyll.Web.Urls
-import Hakyll.Web.Urls.Relativize
-import Hakyll.Web.Tags
-import Hakyll.Web.Template
-import Hakyll.Web.Template.Context
-import Hakyll.Web.Template.List
-import Hakyll.Web.Template.Read
-import Hakyll.Web.Util.Html
+import Hakyll.Core.Util.File
+import Hakyll.Core.Util.String
+import Hakyll.Core.Writable
+import Hakyll.Core.Writable.CopyFile
+import Hakyll.Main
+import Hakyll.Web.CompressCss
+import Hakyll.Web.Feed
+import Hakyll.Web.Html
+import Hakyll.Web.Html.RelativizeUrls
+import Hakyll.Web.Pandoc
+import Hakyll.Web.Pandoc.Biblio
+import Hakyll.Web.Pandoc.FileType
+import Hakyll.Web.Tags
+import Hakyll.Web.Template
+import Hakyll.Web.Template.Context
+import Hakyll.Web.Template.List
+import Hakyll.Web.Template.Read
diff --git a/src/Hakyll/Web/Html.hs b/src/Hakyll/Web/Html.hs
new file mode 100644
index 0000000..3c94b2f
--- /dev/null
+++ b/src/Hakyll/Web/Html.hs
@@ -0,0 +1,147 @@
+--------------------------------------------------------------------------------
+-- | Provides utilities to manipulate HTML pages
+module Hakyll.Web.Html
+ ( -- * Generic
+ withTags
+
+ -- * Headers
+ , demoteHeaders
+
+ -- * Url manipulation
+ , withUrls
+ , toUrl
+ , toSiteRoot
+ , isExternal
+
+ -- * Stripping/escaping
+ , stripTags
+ , escapeHtml
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.Char (digitToInt, intToDigit, isDigit, toLower)
+import Data.List (isPrefixOf)
+import qualified Data.Set as S
+import System.FilePath (joinPath, splitPath, takeDirectory)
+import Text.Blaze.Html (toHtml)
+import Text.Blaze.Html.Renderer.String (renderHtml)
+
+
+--------------------------------------------------------------------------------
+import qualified Text.HTML.TagSoup as TS
+
+
+--------------------------------------------------------------------------------
+-- | Map over all tags in the document
+withTags :: (TS.Tag String -> TS.Tag String) -> String -> String
+withTags f = renderTags' . map f . TS.parseTags
+
+
+--------------------------------------------------------------------------------
+-- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc.
+demoteHeaders :: String -> String
+demoteHeaders = withTags $ \tag -> case tag of
+ TS.TagOpen t a -> TS.TagOpen (demote t) a
+ TS.TagClose t -> TS.TagClose (demote t)
+ t -> t
+ where
+ demote t@['h', n]
+ | isDigit n = ['h', intToDigit (min 6 $ digitToInt n + 1)]
+ | otherwise = t
+ demote t = t
+
+
+--------------------------------------------------------------------------------
+-- | Apply a function to each URL on a webpage
+withUrls :: (String -> String) -> String -> String
+withUrls f = withTags tag
+ where
+ tag (TS.TagOpen s a) = TS.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"]
+
+
+-- | Customized TagSoup renderer. (The default TagSoup renderer escape CSS
+-- within style tags.)
+renderTags' :: [TS.Tag String] -> String
+renderTags' = TS.renderTagsOptions TS.renderOptions
+ { TS.optRawTag = (`elem` ["script", "style"]) . map toLower
+ , TS.optMinimize = (`elem` ["br", "img"])
+ }
+
+
+--------------------------------------------------------------------------------
+-- | 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://"]
+
+
+--------------------------------------------------------------------------------
+-- | Strip all HTML tags from a string
+--
+-- Example:
+--
+-- > stripTags "<p>foo</p>"
+--
+-- Result:
+--
+-- > "foo"
+--
+-- This also works for incomplete tags
+--
+-- Example:
+--
+-- > stripTags "<p>foo</p"
+--
+-- Result:
+--
+-- > "foo"
+stripTags :: String -> String
+stripTags [] = []
+stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs
+stripTags (x : xs) = x : stripTags xs
+
+
+--------------------------------------------------------------------------------
+-- | HTML-escape a string
+--
+-- Example:
+--
+-- > escapeHtml "Me & Dean"
+--
+-- Result:
+--
+-- > "Me &amp; Dean"
+escapeHtml :: String -> String
+escapeHtml = renderHtml . toHtml
diff --git a/src/Hakyll/Web/Urls/Relativize.hs b/src/Hakyll/Web/Html/RelativizeUrls.hs
index 321bbe3..33b0c2c 100644
--- a/src/Hakyll/Web/Urls/Relativize.hs
+++ b/src/Hakyll/Web/Html/RelativizeUrls.hs
@@ -14,7 +14,7 @@
-- will result in (suppose your blogpost is located at @\/posts\/foo.html@:
--
-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />
-module Hakyll.Web.Urls.Relativize
+module Hakyll.Web.Html.RelativizeUrls
( relativizeUrls
, relativizeUrlsWith
) where
@@ -27,7 +27,7 @@ import Data.List (isPrefixOf)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
import Hakyll.Core.Item
-import Hakyll.Web.Urls
+import Hakyll.Web.Html
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index a2e4544..bf2b9d7 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/src/Hakyll/Web/Tags.hs
@@ -83,7 +83,7 @@ import Hakyll.Core.Metadata
import Hakyll.Core.Rules
import Hakyll.Core.Util.String
import Hakyll.Web.Template.Context
-import Hakyll.Web.Urls
+import Hakyll.Web.Html
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index c2ec6bc..7d359b4 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -40,7 +40,7 @@ import Hakyll.Core.Item
import Hakyll.Core.Metadata
import Hakyll.Core.Provider
import Hakyll.Core.Util.String (splitAll)
-import Hakyll.Web.Urls
+import Hakyll.Web.Html
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Urls.hs b/src/Hakyll/Web/Urls.hs
deleted file mode 100644
index 1cd0816..0000000
--- a/src/Hakyll/Web/Urls.hs
+++ /dev/null
@@ -1,66 +0,0 @@
--- | Provides utilities to manipulate URL's
---
-module Hakyll.Web.Urls
- ( withUrls
- , toUrl
- , toSiteRoot
- , isExternal
- ) where
-
-import Data.List (isPrefixOf)
-import Data.Char (toLower)
-import System.FilePath (splitPath, takeDirectory, joinPath)
-import qualified Data.Set as S
-
-import qualified Text.HTML.TagSoup as TS
-
--- | Apply a function to each URL on a webpage
---
-withUrls :: (String -> String) -> String -> String
-withUrls f = renderTags' . map tag . TS.parseTags
- where
- tag (TS.TagOpen s a) = TS.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"]
-
--- | Customized TagSoup renderer. (The default TagSoup renderer escape CSS
--- within style tags.)
---
-renderTags' :: [TS.Tag String] -> String
-renderTags' = TS.renderTagsOptions TS.renderOptions
- { TS.optRawTag = (`elem` ["script", "style"]) . map toLower
- , TS.optMinimize = (`elem` ["br", "img"])
- }
-
--- | 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/Util/Html.hs b/src/Hakyll/Web/Util/Html.hs
deleted file mode 100644
index a413f84..0000000
--- a/src/Hakyll/Web/Util/Html.hs
+++ /dev/null
@@ -1,47 +0,0 @@
--- | Miscellaneous HTML manipulation functions
---
-module Hakyll.Web.Util.Html
- ( stripTags
- , escapeHtml
- ) where
-
-import Text.Blaze.Html (toHtml)
-import Text.Blaze.Html.Renderer.String (renderHtml)
-
--- | Strip all HTML tags from a string
---
--- Example:
---
--- > stripTags "<p>foo</p>"
---
--- Result:
---
--- > "foo"
---
--- This also works for incomplete tags
---
--- Example:
---
--- > stripTags "<p>foo</p"
---
--- Result:
---
--- > "foo"
---
-stripTags :: String -> String
-stripTags [] = []
-stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs
-stripTags (x : xs) = x : stripTags xs
-
--- | HTML-escape a string
---
--- Example:
---
--- > escapeHtml "Me & Dean"
---
--- Result:
---
--- > "Me &amp; Dean"
---
-escapeHtml :: String -> String
-escapeHtml = renderHtml . toHtml
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 16:16:00 +0000