summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--hakyll.cabal8
-rw-r--r--src/Hakyll/Core/Util/String.hs43
-rw-r--r--src/Hakyll/Web/Html.hs14
-rw-r--r--src/Hakyll/Web/Template/Context.hs10
-rw-r--r--tests/Hakyll/Core/Util/String/Tests.hs14
-rw-r--r--tests/Hakyll/Web/Html/Tests.hs12
-rw-r--r--web/examples.markdown2
-rw-r--r--web/releases.markdown6
-rw-r--r--web/tutorials/using-teasers-in-hakyll.markdown13
9 files changed, 87 insertions, 35 deletions
diff --git a/hakyll.cabal b/hakyll.cabal
index 633a414..ced01c6 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -1,5 +1,5 @@
Name: hakyll
-Version: 4.3.0.0
+Version: 4.3.1.0
Synopsis: A static website compiler library
Description:
@@ -143,6 +143,7 @@ Library
blaze-markup >= 0.5.1 && < 0.6,
bytestring >= 0.9 && < 0.11,
citeproc-hs >= 0.3.2 && < 0.4,
+ cmdargs >= 0.10 && < 0.11,
containers >= 0.3 && < 0.6,
cryptohash >= 0.7 && < 0.10,
data-default >= 0.4 && < 0.6,
@@ -151,9 +152,9 @@ Library
filepath >= 1.0 && < 1.4,
lrucache >= 1.1.1 && < 1.2,
mtl >= 1 && < 2.2,
+ network >= 2.4 && < 2.5,
old-locale >= 1.0 && < 1.1,
old-time >= 1.0 && < 1.2,
- cmdargs >= 0.10 && < 0.11,
pandoc >= 1.10 && < 1.12,
parsec >= 3.0 && < 3.2,
process >= 1.0 && < 1.2,
@@ -219,6 +220,7 @@ Test-suite hakyll-tests
blaze-markup >= 0.5.1 && < 0.6,
bytestring >= 0.9 && < 0.11,
citeproc-hs >= 0.3.2 && < 0.4,
+ cmdargs >= 0.10 && < 0.11,
containers >= 0.3 && < 0.6,
cryptohash >= 0.7 && < 0.10,
data-default >= 0.4 && < 0.6,
@@ -227,9 +229,9 @@ Test-suite hakyll-tests
filepath >= 1.0 && < 1.4,
lrucache >= 1.1.1 && < 1.2,
mtl >= 1 && < 2.2,
+ network >= 2.4 && < 2.5,
old-locale >= 1.0 && < 1.1,
old-time >= 1.0 && < 1.2,
- cmdargs >= 0.10 && < 0.11,
pandoc >= 1.10 && < 1.12,
parsec >= 3.0 && < 3.2,
process >= 1.0 && < 1.2,
diff --git a/src/Hakyll/Core/Util/String.hs b/src/Hakyll/Core/Util/String.hs
index d9ec91c..b46f7b8 100644
--- a/src/Hakyll/Core/Util/String.hs
+++ b/src/Hakyll/Core/Util/String.hs
@@ -1,5 +1,5 @@
+--------------------------------------------------------------------------------
-- | Miscellaneous string manipulation functions.
---
module Hakyll.Core.Util.String
( trim
, replaceAll
@@ -7,21 +7,24 @@ module Hakyll.Core.Util.String
, needlePrefix
) where
+
+--------------------------------------------------------------------------------
import Data.Char (isSpace)
import Data.List (isPrefixOf)
import Data.Maybe (listToMaybe)
-
import Text.Regex.TDFA ((=~~))
+
+--------------------------------------------------------------------------------
-- | Trim a string (drop spaces, tabs and newlines at both sides).
---
trim :: String -> String
trim = reverse . trim' . reverse . trim'
where
trim' = dropWhile isSpace
+
+--------------------------------------------------------------------------------
-- | A simple (but inefficient) regex replace funcion
---
replaceAll :: String -- ^ Pattern
-> (String -> String) -- ^ Replacement (called on capture)
-> String -- ^ Source string
@@ -35,9 +38,10 @@ replaceAll pattern f source = replaceAll' source
(capture, after) = splitAt l tmp
in before ++ f capture ++ replaceAll' after
+
+--------------------------------------------------------------------------------
-- | A simple regex split function. The resulting list will contain no empty
-- strings.
---
splitAll :: String -- ^ Pattern
-> String -- ^ String to split
-> [String] -- ^ Result
@@ -50,19 +54,24 @@ splitAll pattern = filter (not . null) . splitAll'
in before : splitAll' (drop l tmp)
--- | Find the first instance of needle (must be non-empty) in
--- haystack. We return the prefix of haystack before needle is
--- matched.
+
+--------------------------------------------------------------------------------
+-- | Find the first instance of needle (must be non-empty) in haystack. We
+-- return the prefix of haystack before needle is matched.
--
-- Examples:
--- needlePrefix "cd" "abcde" = "ab"
--- needlePrefix "ab" "abc" = ""
--- needlePrefix "ab" "xxab" = "xx"
--- needlePrefix "a" "xx" = "xx"
--
-needlePrefix :: String -> String -> String
-needlePrefix needle haystack = go haystack
+-- > needlePrefix "cd" "abcde" = "ab"
+--
+-- > needlePrefix "ab" "abc" = ""
+--
+-- > needlePrefix "ab" "xxab" = "xx"
+--
+-- > needlePrefix "a" "xx" = "xx"
+needlePrefix :: String -> String -> Maybe String
+needlePrefix needle haystack = go [] haystack
where
- go [] = []
- go xss@(x:xs) | needle `isPrefixOf` xss = []
- | otherwise = x : go xs
+ go _ [] = Nothing
+ go acc xss@(x:xs)
+ | needle `isPrefixOf` xss = Just $ reverse acc
+ | otherwise = go (x : acc) xs
diff --git a/src/Hakyll/Web/Html.hs b/src/Hakyll/Web/Html.hs
index 58b5c43..3a0aa3b 100644
--- a/src/Hakyll/Web/Html.hs
+++ b/src/Hakyll/Web/Html.hs
@@ -30,6 +30,7 @@ import System.FilePath (joinPath, splitPath,
import Text.Blaze.Html (toHtml)
import Text.Blaze.Html.Renderer.String (renderHtml)
import qualified Text.HTML.TagSoup as TS
+import Network.URI (isUnreserved, escapeURIString)
--------------------------------------------------------------------------------
@@ -98,9 +99,18 @@ renderTags' = TS.renderTagsOptions TS.renderOptions
-- Result:
--
-- > "/foo/bar.html"
+--
+-- This also sanitizes the URL, e.g. converting spaces into '%20'
toUrl :: FilePath -> String
-toUrl ('/' : xs) = '/' : xs
-toUrl url = '/' : url
+toUrl url = case url of
+ ('/' : xs) -> '/' : sanitize xs
+ xs -> '/' : sanitize xs
+ where
+ -- Everything but unreserved characters should be escaped as we are
+ -- sanitising the path therefore reserved characters which have a
+ -- meaning in URI does not appear. Special casing for `/`, because it has
+ -- a special meaning in FilePath as well as in URI.
+ sanitize = escapeURIString (\c -> c == '/' || isUnreserved c)
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 3fde93b..ecf769d 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -242,9 +242,13 @@ modificationTimeFieldWith locale key fmt = field key $ \i -> do
teaserField :: String -- ^ Key to use
-> Snapshot -- ^ Snapshot to load
-> Context String -- ^ Resulting context
-teaserField key snapshot = field key $ \item ->
- (needlePrefix teaserSeparator . itemBody) <$>
- loadSnapshot (itemIdentifier item) snapshot
+teaserField key snapshot = field key $ \item -> do
+ body <- itemBody <$> loadSnapshot (itemIdentifier item) snapshot
+ case needlePrefix teaserSeparator body of
+ Nothing -> fail $
+ "Hakyll.Web.Template.Context: no teaser defined for " ++
+ show (itemIdentifier item)
+ Just t -> return t
--------------------------------------------------------------------------------
diff --git a/tests/Hakyll/Core/Util/String/Tests.hs b/tests/Hakyll/Core/Util/String/Tests.hs
index 973f6ff..56bdd1a 100644
--- a/tests/Hakyll/Core/Util/String/Tests.hs
+++ b/tests/Hakyll/Core/Util/String/Tests.hs
@@ -30,13 +30,13 @@ tests = testGroup "Hakyll.Core.Util.String.Tests" $ concat
]
, fromAssertions "needlePrefix"
- [ "ab" @=? needlePrefix "cd" "abcde"
- , "xx" @=? needlePrefix "ab" "xxab"
- , "xx" @=? needlePrefix "a" "xx"
- , "x" @=? needlePrefix "ab" "xabxab"
- , "" @=? needlePrefix "ab" "abc"
- , "" @=? needlePrefix "ab" "abab"
- , "" @=? needlePrefix "" ""
+ [ Just "ab" @=? needlePrefix "cd" "abcde"
+ , Just "xx" @=? needlePrefix "ab" "xxab"
+ , Nothing @=? needlePrefix "a" "xx"
+ , Just "x" @=? needlePrefix "ab" "xabxab"
+ , Just "" @=? needlePrefix "ab" "abc"
+ , Just "" @=? needlePrefix "ab" "abab"
+ , Nothing @=? needlePrefix "" ""
]
]
diff --git a/tests/Hakyll/Web/Html/Tests.hs b/tests/Hakyll/Web/Html/Tests.hs
index bfb6b7c..e150ea2 100644
--- a/tests/Hakyll/Web/Html/Tests.hs
+++ b/tests/Hakyll/Web/Html/Tests.hs
@@ -43,9 +43,15 @@ tests = testGroup "Hakyll.Web.Html.Tests" $ concat
]
, fromAssertions "toUrl"
- [ "/foo/bar.html" @=? toUrl "foo/bar.html"
- , "/" @=? toUrl "/"
- , "/funny-pics.html" @=? toUrl "/funny-pics.html"
+ [ "/foo/bar.html" @=? toUrl "foo/bar.html"
+ , "/" @=? toUrl "/"
+ , "/funny-pics.html" @=? toUrl "/funny-pics.html"
+ , "/funny%20pics.html" @=? toUrl "funny pics.html"
+ -- Test various reserved characters (RFC 3986, section 2.2)
+ , "/%21%2A%27%28%29%3B%3A%40%26.html" @=? toUrl "/!*'();:@&.html"
+ , "/%3D%2B%24%2C/%3F%23%5B%5D.html" @=? toUrl "=+$,/?#[].html"
+ -- Test various characters that are nor reserved, nor unreserved.
+ , "/%E3%81%82%F0%9D%90%87%E2%88%80" @=? toUrl "\12354\119815\8704"
]
, fromAssertions "toSiteRoot"
diff --git a/web/examples.markdown b/web/examples.markdown
index ab49e2f..2ddc2ed 100644
--- a/web/examples.markdown
+++ b/web/examples.markdown
@@ -51,6 +51,8 @@ this list. This list has no particular ordering.
[source](https://github.com/CleverCloud/clever-cloud.com)
- <http://blaenkdenum.com/>,
[source](https://github.com/blaenk/blaenk.github.io)
+- <https://xinitrc.de/>,
+ [source](https://github.com/xinitrc/xinitrc.de)
## Hakyll 3.X
diff --git a/web/releases.markdown b/web/releases.markdown
index 7ee5aa2..47014a1 100644
--- a/web/releases.markdown
+++ b/web/releases.markdown
@@ -4,6 +4,12 @@ title: Releases
# Releases
+## Hakyll 4.3.1.0
+
+- Make teasers undefined if no `<!--more-->` comment is found
+
+- Sanitize tag URLs (contribution by Simonas Kazlauskas)
+
## Hakyll 4.3.0.0
- Add conditionals, partials and for loops to the template system (includes a
diff --git a/web/tutorials/using-teasers-in-hakyll.markdown b/web/tutorials/using-teasers-in-hakyll.markdown
index ebff3e7..978d37b 100644
--- a/web/tutorials/using-teasers-in-hakyll.markdown
+++ b/web/tutorials/using-teasers-in-hakyll.markdown
@@ -83,6 +83,19 @@ Here, we've just added a new context which knows how to handle
`$teaser$` key to the default context (note that we passed the same
snapshot name `"content"` which we used while saving).
+## Optional teasers
+
+In case you don't add a `<!--more-->` comment, `$teaser$` will not be defined.
+This means you can use something like:
+
+```html
+$if(teaser)$
+ $teaser$
+$else$
+ $body$
+$endif$
+```
+
## Known issues
Since we use an HTML comment `<!--more-->` to separate the teaser,
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-13 23:50:59 +0000