diff --git a/app/Main.hs b/app/Main.hs index 40567ab..cb9b75d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,12 +8,11 @@ module Main where import Config -import Control.Monad (forM, when) +import Control.Monad (filterM, forM, when) import qualified Data.HashMap.Strict as HM import Data.List (sortOn) import qualified Data.Ord as Ord import qualified Data.Text as T -import Data.Time import Development.Shake (Action, Rules, (%>), (|%>), (~>)) import qualified Development.Shake as Shake import Development.Shake.FilePath (()) @@ -47,7 +46,8 @@ buildSite = do -- handle posts postPaths <- Shake.getDirectoryFiles "" postGlobs - Shake.need $ map indexHtmlOutputPath postPaths + postPaths' <- filterM isDraft postPaths + Shake.need $ map indexHtmlOutputPath postPaths' -- posts list Shake.need [indexHtmlOutputPath "posts"] diff --git a/app/Types.hs b/app/Types.hs index 2f13a49..cbcae67 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -26,7 +26,8 @@ data Post = Post postTags :: [Text], postDate :: Maybe Text, postContent :: Maybe Text, - postLink :: Maybe Text + postLink :: Maybe Text, + postDraft :: Bool } deriving (Show, Generic) deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post diff --git a/app/Utilities.hs b/app/Utilities.hs index f3cb6a1..eb8e85b 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -3,6 +3,7 @@ module Utilities where import Config import Data.Aeson (Result (Error, Success)) import qualified Data.Aeson as A +import Data.List (find) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -98,6 +99,34 @@ runPandoc action = Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action) >>= either (fail . show) return +markdownToPost :: FilePath -> Action Post +markdownToPost path = do + content <- Shake.readFile' path + (Pandoc meta _) <- + Shake.liftIO . runPandoc . Pandoc.readMarkdown readerOptions . T.pack $ content + Shake.liftIO $ fromMeta meta + where + readerOptions = + Pandoc.def + { Pandoc.readerStandalone = True, + Pandoc.readerExtensions = Pandoc.enableExtension Pandoc.Ext_yaml_metadata_block 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 + yamlToPost :: FilePath -> Action Post yamlToPost path = do post <- decodeFileThrow path @@ -120,3 +149,15 @@ isTypstPost path = Shake.takeExtension path == ".typ" isMarkdownPost :: FilePath -> Bool isMarkdownPost path = Shake.takeExtension path == ".md" + +postHandles :: [(FilePath -> Bool, FilePath -> Action Post)] +postHandles = [(isTypstPost, yamlToPost . typstMetaPath), (isMarkdownPost, markdownToPost)] + +isDraft :: FilePath -> Action Bool +isDraft path = do + let action = + case find (\(test, _) -> test path) postHandles of + (Just (_, action')) -> action' + Nothing -> error "no post handle for this file type" + post <- action path + return $ postDraft post