diff --git a/app/Config.hs b/app/Config.hs index 0519f7c..80c3ff9 100644 --- a/app/Config.hs +++ b/app/Config.hs @@ -4,7 +4,7 @@ outputDir :: String outputDir = "publish" assetGlobs :: [String] -assetGlobs = ["static//*"] +assetGlobs = ["static//*", "robots.txt"] -- CAN ONLY BE TYPST DOCS UNLESS YOU CHANGE THINGS AT THE `pages` RULE in `Main.hs pagePaths :: [String] diff --git a/app/Main.hs b/app/Main.hs index 4f79e79..462f9ca 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,12 +11,16 @@ import Config import Control.Monad (forM, when) import qualified Data.HashMap.Strict as HM import Data.List (sortOn) +import Data.Maybe (fromJust) import qualified Data.Ord as Ord import qualified Data.Text as T +import Deriving.Aeson +import Deriving.Aeson.Stock (Vanilla) import Development.Shake (Action, Rules, (%>), (|%>), (~>)) import qualified Development.Shake as Shake import Development.Shake.FilePath (()) import qualified Development.Shake.FilePath as FP +import qualified Development.Shake.FilePath as Shake import Templates import Types import Utilities @@ -79,7 +83,14 @@ pages = let metaSrc = indexHtmlTypstMetaPath target html <- typstToHtml src meta <- yamlToPost metaSrc - let page = Page (postTitle meta) html + time <- Utilities.now + let page = + Page + { pageTitle = postTitle meta, + pageContent = html, + pageNow = time, + pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target + } applyTemplateAndWrite "default.html" page target Shake.putInfo $ "Built " <> target <> " from " <> src @@ -111,8 +122,14 @@ typstPost src = do post <- readTypstPost src let rPost = fromPost post postHtml <- applyTemplate "post.html" rPost - - let page = Page (postTitle post) postHtml + time <- Utilities.now + let page = + Page + { pageTitle = rPostTitle rPost, + pageContent = postHtml, + pageNow = time, + pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target + } applyTemplateAndWrite "default.html" page target Shake.putInfo $ "Built " <> target <> " from " <> src @@ -126,7 +143,14 @@ markdownPost src = do -- Shake.putInfo $ show . toJSON $ rPost postHtml <- applyTemplate "post.html" rPost - let page = Page (postTitle post) postHtml + time <- Utilities.now + let page = + Page + { pageTitle = rPostTitle rPost, + pageContent = postHtml, + pageNow = time, + pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target + } applyTemplateAndWrite "default.html" page target Shake.putInfo $ "Built " <> target <> " from " <> src @@ -140,7 +164,14 @@ home = <$> forM postPaths readPost let posts' = map fromPost posts html <- applyTemplate "home.html" $ HM.singleton "posts" posts' - let page = Page (T.pack "Home") html + time <- Utilities.now + let page = + Page + { pageTitle = T.pack "Home", + pageContent = html, + pageNow = time, + pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target + } applyTemplateAndWrite "default.html" page target Shake.putInfo $ "Built " <> target @@ -151,17 +182,31 @@ postList = posts <- sortOn (Ord.Down . postDate) <$> forM postPaths readPost let posts' = map fromPost posts html <- applyTemplate "posts.html" $ HM.singleton "posts" posts' - let page = Page (T.pack "Blog Posts") html + time <- Utilities.now + let page = + Page + { pageTitle = T.pack "Blog Posts", + pageContent = html, + pageNow = time, + pageSection = T.pack $ fromJust $ Shake.stripExtension "html" target + } applyTemplateAndWrite "default.html" page target Shake.putInfo $ "Built " <> target +data Rss = Rss + { now :: T.Text, + posts :: [RenderedPost] + } + deriving (Show, Generic) + deriving (ToJSON) via Vanilla Rss + rss :: Rules () rss = outputDir "index.xml" %> \target -> do postPaths <- getPublishedPosts - posts <- sortOn (Ord.Down . postDate) <$> forM postPaths readPost - -- TODO: change this to actually have it's own type for things like updated - applyTemplateAndWrite "feed.xml" (HM.singleton "posts" posts) target + posts <- map fromPost . sortOn (Ord.Down . postDate) <$> forM postPaths readPost + time <- Utilities.now + applyTemplateAndWrite "feed.xml" (Rss time posts) target Shake.putInfo $ "Built " <> target diff --git a/app/Templates.hs b/app/Templates.hs index 7daa290..ffe26d9 100644 --- a/app/Templates.hs +++ b/app/Templates.hs @@ -10,7 +10,7 @@ import Development.Shake.FilePath (()) import GHC.Stack (HasCallStack) import qualified Text.Mustache as Mus import qualified Text.Mustache.Compile as Mus -import Types (Post (postAuthor, postContent, postDate, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostIsoDate, rPostLink, 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 applyTemplate :: (HasCallStack, (ToJSON a)) => String -> a -> Action Text @@ -55,5 +55,8 @@ fromPost post = rPostDate = postDate post, rPostIsoDate = postDate post >>= parseDate, rPostContent = postContent post, - rPostLink = postLink post + rPostLink = postLink post, + -- maybe can replace non-acceptable chars with - but unclear is exactly one - is allowed or now https://www.iana.org/assignments/urn-informal/urn-1 + rPostId = T.pack . ("urn:urn-1:" ++) . filter (\c -> elem c "abcdefghijklmnopqrstuvwxyz0123456789") . T.unpack . T.toLower . postTitle $ post, + rPostSummary = postDescription post } diff --git a/app/Types.hs b/app/Types.hs index 038efa6..3a5b2a3 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -5,7 +5,14 @@ import Deriving.Aeson import Deriving.Aeson.Stock (PrefixedSnake) -- 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 {pageTitle :: Text, pageContent :: Text, pageNow :: Text, pageSection :: Text} +data Page = Page + { pageTitle :: Text, + pageContent :: Text, + -- build time + pageNow :: Text, + -- css class for page section + pageSection :: Text + } deriving (Show, Generic) deriving (ToJSON) via PrefixedSnake "page" Page @@ -31,7 +38,7 @@ data Post = Post postDate :: Maybe Text, postContent :: Maybe Text, postLink :: Maybe Text, - postSummary :: Maybe Text, + postDescription :: Maybe Text, postDraft :: Maybe Bool } deriving (Show, Generic) diff --git a/app/Utilities.hs b/app/Utilities.hs index 1e2b74a..2186cbe 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -8,6 +8,7 @@ import Data.List (find) import Data.Text (Text) import qualified Data.Text as T import Data.Time +import Data.Time.Format.ISO8601 (iso8601Show) import Data.Yaml.Aeson import Development.Shake (Action) import qualified Development.Shake as Shake @@ -99,6 +100,9 @@ runPandoc action = Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action) >>= either (fail . show) return +now :: Action T.Text +now = Shake.liftIO $ fmap (T.pack . iso8601Show) getCurrentTime + markdownToPost :: FilePath -> Action Post markdownToPost path = do content <- Shake.readFile' path