started integration of markdown into my setup but differences in preference between me and blog post author will make that annoying

TODO

@@ -0,0 +1,5 @@
+make this work with markdown to save on effort moving over the old posts
+
+make the date format ISO
+
+make separate blogs page target

app/Config.hs

@@ -10,4 +10,4 @@ pagePaths :: [String]
 pagePaths = ["links.typ"]
 
 postGlobs :: [String]
-postGlobs = ["posts/*.typ"]
+postGlobs = ["posts/*.typ", "posts/*.md"]

app/Main.hs

@@ -54,7 +54,8 @@ buildRules = do
   home
   assets
   pages
-  postsRule
+  typstPostsRule
+  markdownPostsRule
   rss
 
 -- make a rule of the pattern outputDir/asset_name which copes from outputDir/../pages
@@ -75,10 +76,20 @@ pages = map indexHtmlOutputPath pagePaths |%> \target -> do
   applyTemplateAndWrite "default.html" page target
   Shake.putInfo $ "Built " <> target <> " from " <> src
 
-postsRule :: Rules ()
+typstPostsRule :: Rules ()
-postsRule = map indexHtmlOutputPath postGlobs |%> \target -> do
+typstPostsRule = map indexHtmlOutputPath postGlobs |%> \target -> do
   let src = indexHtmlSourcePath target
-  post <- readPost src
+  post <- readTypstPost src
+  postHtml <- applyTemplate "post.html" post
+
+  let page = Page (postTitle post) postHtml
+  applyTemplateAndWrite "default.html" page target
+  Shake.putInfo $ "Built " <> target <> " from " <> src
+
+markdownPostsRule :: Rules ()
+markdownPostsRule = map indexHtmlOutputPath postGlobs |%> \target -> do
+  let src = indexHtmlSourcePath target
+  post <- readMarkdownPost src
   postHtml <- applyTemplate "post.html" post
 
   let page = Page (postTitle post) postHtml
@@ -105,8 +116,8 @@ rss = outputDir </> "index.xml" %> \target -> do
     
     Shake.putInfo $ "Built " <> target
 
-readPost :: FilePath -> Action Post
+readTypstPost :: FilePath -> Action Post
-readPost postPath = do
+readTypstPost postPath = do
   html <- typstToHtml postPath
   post <- yamlToPost $ typstMetaPath postPath
   Shake.putInfo $ "Read " <> postPath
@@ -116,3 +127,17 @@ readPost postPath = do
       postLink = Just . T.pack $ "/" <> Shake.dropExtension postPath <> "/"
     }
 
+readMarkdownPost :: FilePath -> Action Post
+readMarkdownPost postPath = do
+    date <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d"
+        . take 10
+        . Shake.takeBaseName
+        $ postPath
+    let formattedDate = T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date
+    (post, html) <- markdownToHtml postPath
+    Shake.putInfo $ "Read " <> postPath
+    return $ post
+        { postDate = Just formattedDate,
+        postContent = Just html,
+        postLink = Just . T.pack $ "/" <> Shake.dropExtension postPath <> "/"
+        }

app/Utilities.hs

@@ -12,6 +12,9 @@ import Development.Shake (Action)
 import Types
 import Data.Maybe (fromMaybe)
 import Data.Time
+import Text.Pandoc (Block (Plain), Meta (..), MetaValue (..), Pandoc (..))
+import Data.Aeson (Result(Success, Error))
+import qualified Data.Aeson as A
 
 indexHtmlOutputPath :: FilePath -> FilePath
 indexHtmlOutputPath srcPath =
@@ -43,9 +46,40 @@ typstToHtml filePath = do
       Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions}
     writerOptions =
       Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions}
-    runPandoc action =
+markdownToHtml :: FromJSON a => FilePath -> Action (a, Text)
-          Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
+markdownToHtml filePath = do
-            >>= either (fail . show) return
+  content <- Shake.readFile' filePath
+  Shake.quietly . Shake.traced "Markdown to HTML" $ do
+    pandoc@(Pandoc meta _) <-
+      runPandoc . Pandoc.readMarkdown readerOptions . T.pack $ content
+    meta' <- fromMeta meta
+    html <- runPandoc . Pandoc.writeHtml5String writerOptions $ pandoc
+    return (meta', html)
+  where
+    readerOptions =
+      Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions}
+    writerOptions =
+      Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions}
+    fromMeta (Meta meta) =
+      A.fromJSON . A.toJSON <$> traverse metaValueToJSON meta >>= \case
+        Success res -> pure res
+        Error err -> fail $ "json conversion error:" <> err
+    metaValueToJSON = \case
+      MetaMap m -> A.toJSON <$> traverse metaValueToJSON m
+      MetaList m -> A.toJSONList <$> traverse metaValueToJSON m
+      MetaBool m -> pure $ A.toJSON m
+      MetaString m -> pure $ A.toJSON $ T.strip m
+      MetaInlines m -> metaValueToJSON $ MetaBlocks [Plain m]
+      MetaBlocks m ->
+        fmap (A.toJSON . T.strip)
+          . runPandoc
+          . Pandoc.writePlain Pandoc.def
+          $ Pandoc mempty m
+
+runPandoc :: Pandoc.PandocIO b -> IO b
+runPandoc action =
+      Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
+        >>= either (fail . show) return
 
 yamlToPost :: FilePath -> Action Post
 yamlToPost path = do