diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 37 |
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 = |