added info on if the tags is empty

This commit is contained in:
Pagwin 2024-10-24 16:56:06 -04:00
parent c87a6cae09
commit af6c529f35
No known key found for this signature in database
GPG key ID: 81137023740CA260
4 changed files with 57 additions and 20 deletions

6
TODO
View file

@ -4,8 +4,10 @@ make separate blog list page target
add draft attr add draft attr
add description attr
github action for docker image/deploy github action for docker image/deploy
make it so articles without tags don't mention them
see if performance can be improved (it isn't slow atm but it definitely feels like there's a bottleneck) see if performance can be improved (it isn't slow atm but it definitely feels like there's a bottleneck)
minify js and css when copying over instead of just copying

View file

@ -105,7 +105,8 @@ typstPost src = do
let target = indexHtmlOutputPath src let target = indexHtmlOutputPath src
post <- readTypstPost src post <- readTypstPost src
postHtml <- applyTemplate "post.html" post let rPost = fromPost post
postHtml <- applyTemplate "post.html" rPost
let page = Page (postTitle post) postHtml let page = Page (postTitle post) postHtml
applyTemplateAndWrite "default.html" page target applyTemplateAndWrite "default.html" page target
@ -117,7 +118,9 @@ markdownPost src = do
let target = indexHtmlOutputPath src let target = indexHtmlOutputPath src
post <- readMarkdownPost src post <- readMarkdownPost src
postHtml <- applyTemplate "post.html" post let rPost = fromPost post
-- Shake.putInfo $ show . toJSON $ rPost
postHtml <- applyTemplate "post.html" rPost
let page = Page (postTitle post) postHtml let page = Page (postTitle post) postHtml
applyTemplateAndWrite "default.html" page target applyTemplateAndWrite "default.html" page target

View file

@ -1,24 +1,30 @@
module Templates where module Templates where
import Development.Shake
import Data.Aeson (ToJSON) import Data.Aeson (ToJSON)
import qualified Data.Aeson as A
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import qualified Development.Shake as Shake
import Development.Shake.FilePath ((</>))
import GHC.Stack (HasCallStack)
import qualified Text.Mustache as Mus import qualified Text.Mustache as Mus
import qualified Text.Mustache.Compile as Mus import qualified Text.Mustache.Compile as Mus
import qualified Development.Shake as Shake import Types (Post (postAuthor, postContent, postDate, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostLink, rPostTags, rPostTitle))
import qualified Data.Aeson as A
import qualified Data.Text as T
import Development.Shake.FilePath ((</>))
applyTemplate :: ToJSON a => String -> a -> Action Text applyTemplate :: (HasCallStack, (ToJSON a)) => String -> a -> Action Text
applyTemplate templateName context = do applyTemplate templateName context = do
tmpl <- readTemplate $ "templates" </> templateName tmpl <- readTemplate $ "templates" </> templateName
case Mus.checkedSubstitute tmpl (A.toJSON context) of case Mus.checkedSubstitute tmpl (A.toJSON context) of
([], text) -> return text ([], text) -> return text
(errs, _) -> fail $ (errs, _) ->
"Error while substituting template " <> templateName error $
<> ": " <> unlines (map show errs) "Error while substituting template "
<> templateName
<> ": "
<> unlines (map show errs)
applyTemplateAndWrite :: ToJSON a => String -> a -> FilePath -> Action () applyTemplateAndWrite :: (ToJSON a) => String -> a -> FilePath -> Action ()
applyTemplateAndWrite templateName context outputPath = applyTemplateAndWrite templateName context outputPath =
applyTemplate templateName context applyTemplate templateName context
>>= Shake.writeFile' outputPath . T.unpack >>= Shake.writeFile' outputPath . T.unpack
@ -26,7 +32,8 @@ applyTemplateAndWrite templateName context outputPath =
readTemplate :: FilePath -> Action Mus.Template readTemplate :: FilePath -> Action Mus.Template
readTemplate templatePath = do readTemplate templatePath = do
Shake.need [templatePath] Shake.need [templatePath]
eTemplate <- Shake.quietly eTemplate <-
Shake.quietly
. Shake.traced "Compile template" . Shake.traced "Compile template"
$ Mus.localAutomaticCompile templatePath $ Mus.localAutomaticCompile templatePath
case eTemplate of case eTemplate of
@ -35,3 +42,15 @@ readTemplate templatePath = do
Shake.putInfo $ "Read " <> templatePath Shake.putInfo $ "Read " <> templatePath
return template return template
Left err -> fail $ show err Left err -> fail $ show err
fromPost :: Post -> RenderedPost
fromPost post =
RenderedPost
{ rPostTitle = postTitle post,
rPostAuthor = postAuthor post,
rPostTags = postTags post,
rPostHasTags = not . null . postTags $ post,
rPostDate = postDate post,
rPostContent = postContent post,
rPostLink = postLink post
}

View file

@ -1,13 +1,25 @@
module Types where module Types where
import Data.Text (Text)
import Deriving.Aeson import Deriving.Aeson
import Deriving.Aeson.Stock (PrefixedSnake) import Deriving.Aeson.Stock (PrefixedSnake)
import Data.Text (Text)
data Page = Page {pageTitle :: Text, pageContent :: Text} data Page = Page {pageTitle :: Text, pageContent :: Text}
deriving (Show, Generic) deriving (Show, Generic)
deriving (ToJSON) via PrefixedSnake "page" Page deriving (ToJSON) via PrefixedSnake "page" Page
data RenderedPost = RenderedPost
{ rPostTitle :: Text,
rPostAuthor :: Maybe Text,
rPostTags :: [Text],
rPostHasTags :: Bool,
rPostDate :: Maybe Text,
rPostContent :: Maybe Text,
rPostLink :: Maybe Text
}
deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "rPost" RenderedPost
data Post = Post data Post = Post
{ postTitle :: Text, { postTitle :: Text,
postAuthor :: Maybe Text, postAuthor :: Maybe Text,
@ -15,5 +27,6 @@ data Post = Post
postDate :: Maybe Text, postDate :: Maybe Text,
postContent :: Maybe Text, postContent :: Maybe Text,
postLink :: Maybe Text postLink :: Maybe Text
} deriving (Show, Generic) }
deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post