added info on if the tags is empty
This commit is contained in:
parent
c87a6cae09
commit
af6c529f35
4 changed files with 57 additions and 20 deletions
6
TODO
6
TODO
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
19
app/Types.hs
19
app/Types.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue