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 description attr
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)
minify js and css when copying over instead of just copying

View file

@ -105,7 +105,8 @@ typstPost src = do
let target = indexHtmlOutputPath src
post <- readTypstPost src
postHtml <- applyTemplate "post.html" post
let rPost = fromPost post
postHtml <- applyTemplate "post.html" rPost
let page = Page (postTitle post) postHtml
applyTemplateAndWrite "default.html" page target
@ -117,7 +118,9 @@ markdownPost src = do
let target = indexHtmlOutputPath 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
applyTemplateAndWrite "default.html" page target

View file

@ -1,24 +1,30 @@
module Templates where
import Development.Shake
import Data.Aeson (ToJSON)
import qualified Data.Aeson as A
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.Compile as Mus
import qualified Development.Shake as Shake
import qualified Data.Aeson as A
import qualified Data.Text as T
import Development.Shake.FilePath ((</>))
import Types (Post (postAuthor, postContent, postDate, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostLink, rPostTags, rPostTitle))
applyTemplate :: ToJSON a => String -> a -> Action Text
applyTemplate :: (HasCallStack, (ToJSON a)) => String -> a -> Action Text
applyTemplate templateName context = do
tmpl <- readTemplate $ "templates" </> templateName
case Mus.checkedSubstitute tmpl (A.toJSON context) of
([], text) -> return text
(errs, _) -> fail $
"Error while substituting template " <> templateName
<> ": " <> unlines (map show errs)
(errs, _) ->
error $
"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 =
applyTemplate templateName context
>>= Shake.writeFile' outputPath . T.unpack
@ -26,12 +32,25 @@ applyTemplateAndWrite templateName context outputPath =
readTemplate :: FilePath -> Action Mus.Template
readTemplate templatePath = do
Shake.need [templatePath]
eTemplate <- Shake.quietly
. Shake.traced "Compile template"
$ Mus.localAutomaticCompile templatePath
eTemplate <-
Shake.quietly
. Shake.traced "Compile template"
$ Mus.localAutomaticCompile templatePath
case eTemplate of
Right template -> do
Shake.need . Mus.getPartials . Mus.ast $ template
Shake.putInfo $ "Read " <> templatePath
return template
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
import Data.Text (Text)
import Deriving.Aeson
import Deriving.Aeson.Stock (PrefixedSnake)
import Data.Text (Text)
data Page = Page {pageTitle :: Text, pageContent :: Text}
deriving (Show, Generic)
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
{ postTitle :: Text,
postAuthor :: Maybe Text,
@ -15,5 +27,6 @@ data Post = Post
postDate :: Maybe Text,
postContent :: Maybe Text,
postLink :: Maybe Text
} deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post
}
deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post