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 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
}
|
||||||
|
|
17
app/Types.hs
17
app/Types.hs
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue