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') 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