diff --git a/app/Main.hs b/app/Main.hs index cb9b75d..c6d403a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,7 +8,7 @@ module Main where import Config -import Control.Monad (filterM, forM, when) +import Control.Monad (forM, when) import qualified Data.HashMap.Strict as HM import Data.List (sortOn) import qualified Data.Ord as Ord @@ -45,9 +45,8 @@ buildSite = do Shake.need $ map indexHtmlOutputPath pagePaths -- handle posts - postPaths <- Shake.getDirectoryFiles "" postGlobs - postPaths' <- filterM isDraft postPaths - Shake.need $ map indexHtmlOutputPath postPaths' + postPaths <- getPublishedPosts + Shake.need $ map indexHtmlOutputPath postPaths -- posts list Shake.need [indexHtmlOutputPath "posts"] @@ -93,8 +92,9 @@ postsRule = potentials ( \path -> do exists <- Shake.doesFileExist path + should <- if exists then not <$> isDraft path else pure False when - exists + should ( case FP.takeExtension path of ".typ" -> typstPost path ".md" -> markdownPost path @@ -133,7 +133,7 @@ markdownPost src = do home :: Rules () home = outputDir "index.html" %> \target -> do - postPaths <- Shake.getDirectoryFiles "" postGlobs + postPaths <- getPublishedPosts posts <- take 3 . sortOn (Ord.Down . postDate) @@ -147,7 +147,7 @@ home = postList :: Rules () postList = outputDir "posts/index.html" %> \target -> do - postPaths <- Shake.getDirectoryFiles "" postGlobs + postPaths <- getPublishedPosts posts <- sortOn (Ord.Down . postDate) <$> forM postPaths readPost html <- applyTemplate "posts.html" $ HM.singleton "posts" posts let page = Page (T.pack "Blog Posts") html @@ -157,7 +157,7 @@ postList = rss :: Rules () rss = outputDir "index.xml" %> \target -> do - postPaths <- Shake.getDirectoryFiles "" postGlobs + postPaths <- getPublishedPosts posts <- sortOn (Ord.Down . postDate) <$> forM postPaths readPost applyTemplateAndWrite "feed.xml" (HM.singleton "posts" posts) target diff --git a/app/Types.hs b/app/Types.hs index cbcae67..c8f5fd7 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -27,7 +27,7 @@ data Post = Post postDate :: Maybe Text, postContent :: Maybe Text, postLink :: Maybe Text, - postDraft :: Bool + postDraft :: Maybe Bool } deriving (Show, Generic) deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post diff --git a/app/Utilities.hs b/app/Utilities.hs index eb8e85b..8a32d80 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -1,6 +1,7 @@ module Utilities where import Config +import Control.Monad (filterM) import Data.Aeson (Result (Error, Success)) import qualified Data.Aeson as A import Data.List (find) @@ -12,14 +13,14 @@ import Data.Yaml.Aeson import Development.Shake (Action) import qualified Development.Shake as Shake import Development.Shake.FilePath ((<.>), ()) -import qualified Development.Shake.FilePath as Shake +import qualified Development.Shake.FilePath as FP import Text.Pandoc (Block (Plain), Meta (..), MetaValue (..), Pandoc (..)) import qualified Text.Pandoc as Pandoc import Types indexHtmlOutputPath :: FilePath -> FilePath indexHtmlOutputPath srcPath = - outputDir Shake.dropExtension srcPath "index.html" + outputDir FP.dropExtension srcPath "index.html" -- were applicative shenanigans necessary? no -- but using them felt cool @@ -28,23 +29,23 @@ indexHtmlSourcePaths path = [indexHtmlTypstSourcePath, indexHtmlMarkdownSourcePa indexHtmlTypstSourcePath :: FilePath -> FilePath indexHtmlTypstSourcePath = - Shake.dropDirectory1 + FP.dropDirectory1 . (<.> "typ") - . Shake.dropTrailingPathSeparator - . Shake.dropFileName + . FP.dropTrailingPathSeparator + . FP.dropFileName indexHtmlMarkdownSourcePath :: FilePath -> FilePath indexHtmlMarkdownSourcePath = - Shake.dropDirectory1 + FP.dropDirectory1 . (<.> "md") - . Shake.dropTrailingPathSeparator - . Shake.dropFileName + . FP.dropTrailingPathSeparator + . FP.dropFileName indexHtmlTypstMetaPath :: FilePath -> FilePath indexHtmlTypstMetaPath = typstMetaPath . indexHtmlTypstSourcePath typstMetaPath :: FilePath -> FilePath -typstMetaPath typstPath = Shake.dropExtension typstPath <.> "yaml" +typstMetaPath typstPath = FP.dropExtension typstPath <.> "yaml" typstToHtml :: FilePath -> Action Text typstToHtml filePath = do @@ -145,10 +146,10 @@ yamlToPost path = do Just $ T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date' isTypstPost :: FilePath -> Bool -isTypstPost path = Shake.takeExtension path == ".typ" +isTypstPost path = FP.takeExtension path == ".typ" isMarkdownPost :: FilePath -> Bool -isMarkdownPost path = Shake.takeExtension path == ".md" +isMarkdownPost path = FP.takeExtension path == ".md" postHandles :: [(FilePath -> Bool, FilePath -> Action Post)] postHandles = [(isTypstPost, yamlToPost . typstMetaPath), (isMarkdownPost, markdownToPost)] @@ -160,4 +161,11 @@ isDraft path = do (Just (_, action')) -> action' Nothing -> error "no post handle for this file type" post <- action path - return $ postDraft post + return $ case postDraft post of + Just ret -> ret + Nothing -> (error $ "Missing draft attr: " ++ path) + +getPublishedPosts :: Action [FilePath] +getPublishedPosts = do + postPaths <- Shake.getDirectoryFiles "" postGlobs + filterM (fmap not . isDraft) postPaths