refactored to use ToMustache instead of ToJSON

This commit is contained in:
Pagwin 2025-12-29 19:28:55 -05:00
parent d8d126a4c5
commit 27e08cbc7a
No known key found for this signature in database
GPG key ID: 81137023740CA260
3 changed files with 21 additions and 4 deletions

View file

@ -9,6 +9,7 @@ module Psb.Main where
import Config import Config
import Control.Monad (when) import Control.Monad (when)
import Data.Aeson (ToJSON (toJSON))
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.List (sortOn) import Data.List (sortOn)
import qualified Data.Ord as Ord import qualified Data.Ord as Ord
@ -22,6 +23,7 @@ import Development.Shake.FilePath ((</>))
import qualified Development.Shake.FilePath as FP import qualified Development.Shake.FilePath as FP
import Templates import Templates
import Text.Megaparsec (errorBundlePretty) import Text.Megaparsec (errorBundlePretty)
import Text.Mustache (ToMustache (toMustache))
import Types import Types
import Utilities.Action (getPublishedPosts, isDraft', markdownToHtml, markdownToPost, now, psbProgress) import Utilities.Action (getPublishedPosts, isDraft', markdownToHtml, markdownToPost, now, psbProgress)
import qualified Utilities.CSS as CSS import qualified Utilities.CSS as CSS
@ -173,6 +175,9 @@ data Rss = Rss
deriving (Show, Generic) deriving (Show, Generic)
deriving (ToJSON) via Vanilla Rss deriving (ToJSON) via Vanilla Rss
instance ToMustache Rss where
toMustache = toMustache . toJSON
rss :: Rules () rss :: Rules ()
rss = rss =
outputDir </> "index.xml" %> \target -> do outputDir </> "index.xml" %> \target -> do

View file

@ -8,16 +8,17 @@ import Development.Shake
import qualified Development.Shake as Shake import qualified Development.Shake as Shake
import Development.Shake.FilePath ((</>)) import Development.Shake.FilePath ((</>))
import GHC.Stack (HasCallStack) import GHC.Stack (HasCallStack)
import Text.Mustache (ToMustache)
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 Types (Post (postAuthor, postContent, postDate, postDescription, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostId, rPostIsoDate, rPostLink, rPostSummary, rPostTags, rPostTitle)) import Types (Post (postAuthor, postContent, postDate, postDescription, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostId, rPostIsoDate, rPostLink, rPostSummary, rPostTags, rPostTitle))
import Utilities import Utilities
applyTemplate :: (HasCallStack, (ToJSON a)) => String -> a -> Action Text applyTemplate :: (HasCallStack, (ToMustache a)) => String -> a -> Action Text
applyTemplate templateName context = do applyTemplate templateName context = do
tmpl <- readTemplate $ "templates" </> templateName tmpl <- readTemplate $ "templates" </> templateName
-- liftIO $ print $ A.toJSON context -- liftIO $ print $ A.toJSON context
case Mus.checkedSubstitute tmpl (A.toJSON context) of case Mus.checkedSubstitute tmpl context of
([], text) -> return text ([], text) -> return text
(errs, _) -> (errs, _) ->
error $ error $
@ -26,7 +27,7 @@ applyTemplate templateName context = do
<> ": " <> ": "
<> unlines (map show errs) <> unlines (map show errs)
applyTemplateAndWrite :: (ToJSON a) => String -> a -> FilePath -> Action () applyTemplateAndWrite :: (ToMustache 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

View file

@ -1,8 +1,10 @@
module Types where module Types where
import Data.Aeson (ToJSON (toJSON))
import Data.Text (Text) import Data.Text (Text)
import Deriving.Aeson import Deriving.Aeson
import Deriving.Aeson.Stock (PrefixedSnake) import Deriving.Aeson.Stock (PrefixedSnake)
import Text.Mustache (ToMustache (toMustache))
-- pageSection is what css class should be specified in a style html element, I would do an enum but I foresee that being a mistake -- pageSection is what css class should be specified in a style html element, I would do an enum but I foresee that being a mistake
data Page = Page data Page = Page
@ -16,6 +18,9 @@ data Page = Page
deriving (Show, Generic) deriving (Show, Generic)
deriving (ToJSON) via PrefixedSnake "page" Page deriving (ToJSON) via PrefixedSnake "page" Page
instance ToMustache Page where
toMustache = toMustache . toJSON
data RenderedPost = RenderedPost data RenderedPost = RenderedPost
{ rPostTitle :: Text, { rPostTitle :: Text,
rPostAuthor :: Maybe Text, rPostAuthor :: Maybe Text,
@ -31,6 +36,9 @@ data RenderedPost = RenderedPost
deriving (Show, Generic) deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "rPost" RenderedPost deriving (FromJSON, ToJSON) via PrefixedSnake "rPost" RenderedPost
instance ToMustache RenderedPost where
toMustache = toMustache . toJSON
data Post = Post data Post = Post
{ postTitle :: Text, { postTitle :: Text,
postAuthor :: Maybe Text, postAuthor :: Maybe Text,
@ -43,3 +51,6 @@ data Post = Post
} }
deriving (Show, Generic) deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post
instance ToMustache Post where
toMustache = toMustache . toJSON