From d61fd86b76d206670c34086fadaad8c1bc8a749c Mon Sep 17 00:00:00 2001 From: Pagwin Date: Sat, 1 Nov 2025 17:01:59 -0400 Subject: [PATCH] hooked everything up to make use of new markdown parsing, just need to write the code to generate HTML --- app/Utilities.hs | 10 ++++++++++ psb.cabal | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/app/Utilities.hs b/app/Utilities.hs index e4f0270..40785c0 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -7,6 +7,7 @@ import qualified Data.Aeson as A import Data.List (find) import Data.Text (Text) import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) import Data.Time import Data.Time.Format.ISO8601 (iso8601Show) import Data.Yaml.Aeson @@ -14,8 +15,11 @@ import Development.Shake (Action) import qualified Development.Shake as Shake import Development.Shake.FilePath ((<.>), ()) import qualified Development.Shake.FilePath as FP +import HTML +import Markdown import Text.Pandoc (Block (Plain), Meta (..), MetaValue (..), Pandoc (..)) import qualified Text.Pandoc as Pandoc +import Text.Parsec hiding (Error) import Types indexHtmlOutputPath :: FilePath -> FilePath @@ -36,6 +40,12 @@ indexHtmlMarkdownSourcePath = markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text) markdownToHtml filePath = do + content <- Shake.readFile' filePath + let Right (metadataText, document) = parse (liftA2 (,) Markdown.metadata Markdown.document) filePath content + let Right metadata = decodeEither' $ encodeUtf8 metadataText + pure (metadata, compileToHTML document) + +markdownToHtml_ filePath = do content <- Shake.readFile' filePath Shake.quietly . Shake.traced "Markdown to HTML" $ do pandoc@(Pandoc meta _) <- diff --git a/psb.cabal b/psb.cabal index 0f9ef17..ea74a56 100644 --- a/psb.cabal +++ b/psb.cabal @@ -29,7 +29,7 @@ executable psb -- .hs or .lhs file containing the Main module. main-is: Main.hs - other-modules: Config Utilities Templates Types IR Markdown Restruct + other-modules: Config Utilities Templates Types IR Markdown Restruct HTML default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric