diff --git a/TODO b/TODO new file mode 100644 index 0000000..89ad027 --- /dev/null +++ b/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 diff --git a/app/Config.hs b/app/Config.hs index 767635a..9e76f87 100644 --- a/app/Config.hs +++ b/app/Config.hs @@ -10,4 +10,4 @@ pagePaths :: [String] pagePaths = ["links.typ"] postGlobs :: [String] -postGlobs = ["posts/*.typ"] +postGlobs = ["posts/*.typ", "posts/*.md"] diff --git a/app/Main.hs b/app/Main.hs index cb4aca5..35673e0 100755 --- a/app/Main.hs +++ b/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 () -postsRule = map indexHtmlOutputPath postGlobs |%> \target -> do +typstPostsRule :: Rules () +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 -readPost postPath = do +readTypstPost :: FilePath -> Action Post +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 <> "/" + } diff --git a/app/Utilities.hs b/app/Utilities.hs index 6a0dc2e..8d7e930 100644 --- a/app/Utilities.hs +++ b/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 = - Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action) - >>= either (fail . show) return +markdownToHtml :: FromJSON a => FilePath -> Action (a, Text) +markdownToHtml filePath = do + 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