draft attr done

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
 

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

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