diff options
Diffstat (limited to 'src/Hakyll/Web')
| -rw-r--r-- | src/Hakyll/Web/Html.hs | 147 | ||||
| -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.hs | 2 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Context.hs | 2 | ||||
| -rw-r--r-- | src/Hakyll/Web/Urls.hs | 66 | ||||
| -rw-r--r-- | src/Hakyll/Web/Util/Html.hs | 47 |
6 files changed, 151 insertions, 117 deletions
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 & 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 & Dean" --- -escapeHtml :: String -> String -escapeHtml = renderHtml . toHtml |