Remove HTML breaks from plain teasers

1 files changed, 30 insertions, 7 deletions

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 "" = "</p><p>"
-    paragraphMap paragraph = paragraph
+    paragraphMap paragraph
+        | " //" `isSuffixOf` paragraph
+            = take (length paragraph - length (" //" :: String)) paragraph
+            <> "<br>"
+        | otherwise = paragraph
     withMetadataField _ (Just teaser) = pure $ "<p>"
         <> unlines (paragraphMap <$> lines teaser)
         <> "</p>"
@@ -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 <br>
+    -- with //.
+    htmlFolder (accumulator, currentTag, False) _ = (accumulator, currentTag, False)
+    htmlFolder (accumulator, Nothing, True) '<' = (accumulator, Just "<", True)
+    htmlFolder (accumulator, Just currentTag, True) '>'
+        | "<br" `isPrefixOf` currentTag = (accumulator <> " //", Nothing, True)
+        | currentTag == "</p>" = (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 =