From 93b3894d5160809deba500252a4797018314f0df Mon Sep 17 00:00:00 2001
From: Paweł Dybiec <pawel@dybiec.info>
Date: Tue, 21 Nov 2023 00:35:37 +0000
Subject: Hide non-published posts from the list

---
 site.hs | 103 ++++++++++++++++++++++++++++++++++------------------------------
 1 file changed, 55 insertions(+), 48 deletions(-)

(limited to 'site.hs')

diff --git a/site.hs b/site.hs
index d32fd49..47230de 100644
--- a/site.hs
+++ b/site.hs
@@ -1,67 +1,74 @@
 --------------------------------------------------------------------------------
 {-# LANGUAGE OverloadedStrings #-}
-import           Data.Monoid (mappend)
-import           Hakyll
 
+import Control.Monad (filterM)
+import Data.Maybe (isJust)
+import Data.Monoid (mappend)
+import Hakyll
 
 --------------------------------------------------------------------------------
 main :: IO ()
 main = hakyll $ do
+  match "images/*" $ do
+    route idRoute
+    compile copyFileCompiler
 
-    match "images/*" $ do
-        route   idRoute
-        compile copyFileCompiler
+  match "static/*" $ do
+    route idRoute
+    compile copyFileCompiler
 
-    match "static/*" $ do
-        route   idRoute
-        compile copyFileCompiler
+  match (fromList ["robots.txt"]) $ do
+    route idRoute
+    compile copyFileCompiler
 
-    match (fromList ["robots.txt"]) $ do
-        route   idRoute
-        compile copyFileCompiler
+  match "css/*" $ compile compressCssCompiler
+  create ["style.css"] $ do
+    route idRoute
+    compile $ do
+      csses <- loadAll "css/*.css"
+      makeItem $ unlines $ map itemBody csses
 
-    match "css/*" $ compile compressCssCompiler
-    create ["style.css"] $ do
-        route idRoute
-        compile $ do
-            csses <- loadAll "css/*.css"
-            makeItem $ unlines $ map itemBody csses
-    
-    match (fromList ["index.md"]) $ do
-        route   $ setExtension "html"
-        compile $ pandocCompiler
-            >>= loadAndApplyTemplate "templates/default.html" defaultContext
-            >>= relativizeUrls
-    
+  match (fromList ["index.md"]) $ do
+    route $ setExtension "html"
+    compile $
+      pandocCompiler
+        >>= loadAndApplyTemplate "templates/default.html" defaultContext
+        >>= relativizeUrls
 
-    match "posts/*" $ do
-        route $ setExtension "html"
-        compile $ pandocCompiler
-            >>= loadAndApplyTemplate "templates/post.html"    postCtx
-            >>= loadAndApplyTemplate "templates/default.html" postCtx
-            >>= relativizeUrls
+  match "posts/*" $ do
+    route $ setExtension "html"
+    compile $
+      pandocCompiler
+        >>= loadAndApplyTemplate "templates/post.html" postCtx
+        >>= loadAndApplyTemplate "templates/default.html" postCtx
+        >>= relativizeUrls
 
-    create ["posts.html"] $ do
-        route idRoute
-        compile $ do
-            posts <- recentFirst =<< loadAll "posts/*"
-            let archiveCtx =
-                    listField "posts" postCtx (return posts) `mappend`
-                    constField "title" "Archives"            `mappend`
-                    defaultContext
+  create ["posts.html"] $ do
+    route idRoute
+    compile $ do
+      posts <- recentFirst =<< filterPublished =<< loadAll "posts/*"
+      let archiveCtx =
+            listField "posts" postCtx (return posts)
+              `mappend` constField "title" "Archives"
+              `mappend` defaultContext
 
-            makeItem ""
-                >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
-                >>= loadAndApplyTemplate "templates/default.html" archiveCtx
-                >>= relativizeUrls
-
-
-
-    match "templates/*" $ compile templateBodyCompiler
+      makeItem ""
+        >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
+        >>= loadAndApplyTemplate "templates/default.html" archiveCtx
+        >>= relativizeUrls
 
+  match "templates/*" $ compile templateBodyCompiler
 
 --------------------------------------------------------------------------------
 postCtx :: Context String
 postCtx =
-    dateField "date" "%B %e, %Y" `mappend`
-    defaultContext
+  dateField "date" "%B %e, %Y"
+    `mappend` defaultContext
+
+filterPublished :: (MonadMetadata m, MonadFail m) => [Item a] -> m [Item a]
+filterPublished = filterM $ isPublished . itemIdentifier
+  where
+    isPublished :: (MonadMetadata m, MonadFail m) => Identifier -> m Bool
+    isPublished id' = do
+      metadata <- getMetadata id'
+      pure $ isJust $ lookupString "date" metadata
-- 
cgit 1.4.1