From 42b279e81ac0fbdc13f42d4ac1c6c371aad68062 Mon Sep 17 00:00:00 2001
From: Eugen Wissner
Date: Thu, 20 Aug 2026 14:08:43 +0200
Subject: Remove HTML breaks from plain teasers
---
src/Main.hs | 37 ++++++++++++++++++++++++++++++-------
1 file changed, 30 insertions(+), 7 deletions(-)
(limited to 'src/Main.hs')
diff --git a/src/Main.hs b/src/Main.hs
index c5c9f09..675ce91 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -12,7 +12,7 @@ import Hakyll.Core.Compiler
, loadAllSnapshots
, makeItem
, noResult
- , saveSnapshot
+ , saveSnapshot, loadSnapshotBody
)
import Hakyll.Core.Configuration (Configuration(..))
import Hakyll.Core.File (copyFileCompiler)
@@ -183,7 +183,11 @@ teaserDescriptionField = field "teaser" withItem
in getMetadataField itemIdentifier' "teaser"
>>= withMetadataField itemIdentifier'
paragraphMap "" = "
"
- paragraphMap paragraph = paragraph
+ paragraphMap paragraph
+ | " //" `isSuffixOf` paragraph
+ = take (length paragraph - length (" //" :: String)) paragraph
+ <> "
"
+ | otherwise = paragraph
withMetadataField _ (Just teaser) = pure $ "
"
<> unlines (paragraphMap <$> lines teaser)
<> "
"
@@ -194,21 +198,40 @@ teaserDescriptionField = field "teaser" withItem
teaserMetaField :: Context String
teaserMetaField = field "teaser" withItem
where
- withItem item =
+ withItem item = do
let itemIdentifier' = itemIdentifier item
- in getMetadataField itemIdentifier' "teaser"
- >>= withMetadataField itemIdentifier'
+
+ body <- loadSnapshotBody itemIdentifier' "content"
+ metadata <- getMetadataField itemIdentifier' "teaser"
+
+ withMetadataField body metadata
+ -- Keep only the first paragraph, replace newlines with whitespaces.
paragraphFolder ("", True) paragraph = (paragraph, True)
paragraphFolder (accumulator, True) "" = (accumulator, False)
paragraphFolder (accumulator, True) paragraph =
(accumulator <> " " <> paragraph, True)
paragraphFolder (accumulator, False) _ = (accumulator, False)
+ -- Remove HTML tags, keep only the first paragraph, replace explicit
+ -- with //.
+ htmlFolder (accumulator, currentTag, False) _ = (accumulator, currentTag, False)
+ htmlFolder (accumulator, Nothing, True) '<' = (accumulator, Just "<", True)
+ htmlFolder (accumulator, Just currentTag, True) '>'
+ | "
" //", Nothing, True)
+ | currentTag == "" = (accumulator <> " ", Nothing, False)
+ | otherwise = (accumulator, Nothing, True)
+ htmlFolder (accumulator, Just currentTag, True) character =
+ (accumulator, Just (currentTag <> [character]), True)
+ htmlFolder (accumulator, currentTag, True) '\n' = (accumulator <> " ", currentTag, True)
+ htmlFolder (accumulator, Nothing, True) character =
+ (accumulator <> [character], Nothing, True)
+ withMetadataField :: String -> Maybe String -> Compiler String
withMetadataField _ (Just teaser) = pure
$ fst
$ foldl' paragraphFolder ("", True)
$ lines teaser
- withMetadataField itemIdentifier' Nothing = fail
- $ "No teaser defined for " <> show itemIdentifier'
+ withMetadataField itemBody' Nothing =
+ let (result, _, _) = foldl' htmlFolder ("", Nothing, True) itemBody'
+ in pure result
publishedOnField :: forall a. Context a
publishedOnField =
--
cgit v1.2.3