made it so date is in the metadata instead of the filename

This commit is contained in:
Pagwin 2024-07-30 01:49:28 -04:00
parent a15d27a324
commit daeaf9b9ec
No known key found for this signature in database
GPG key ID: 81137023740CA260
4 changed files with 46 additions and 33 deletions

View file

@ -11,10 +11,6 @@ module Main where
import Control.Monad (forM)
import Data.List (sortOn)
import Data.Text (Text)
import Data.Time (UTCTime, defaultTimeLocale, formatTime, parseTimeM)
import Deriving.Aeson
import Deriving.Aeson.Stock (PrefixedSnake)
import Development.Shake (Action, Rules, (|%>), (~>), (%>))
import Development.Shake.FilePath ((</>))
import qualified Data.HashMap.Strict as HM
@ -23,6 +19,7 @@ import qualified Data.Text as T
import qualified Development.Shake as Shake
import qualified Development.Shake.FilePath as Shake
import Config
import Types
import Utilities
import Templates
-- target = thing we want
@ -59,7 +56,7 @@ buildRules = do
home
assets
pages
posts
postsRule
rss
-- make a rule of the pattern outputDir/asset_name which copes from outputDir/../pages
@ -69,31 +66,18 @@ assets = map (outputDir </>) assetGlobs |%> \target -> do
Shake.copyFileChanged src target
Shake.putInfo $ "Copied " <> target <> " from " <> src
data Page = Page {pageTitle :: Text, pageContent :: Text}
deriving (Show, Generic)
deriving (ToJSON) via PrefixedSnake "page" Page
pages :: Rules ()
pages = map indexHtmlOutputPath pagePaths |%> \target -> do
let src = indexHtmlSourcePath target
(meta, html) <- typstToHtml src
let page = Page (meta HM.! "title") html
let page = Page (postTitle meta) html
applyTemplateAndWrite "default.html" page target
Shake.putInfo $ "Built " <> target <> " from " <> src
data Post = Post
{ postTitle :: Text,
postAuthor :: Maybe Text,
postTags :: [Text],
postDate :: Maybe Text,
postContent :: Maybe Text,
postLink :: Maybe Text
} deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post
posts :: Rules ()
posts = map indexHtmlOutputPath postGlobs |%> \target -> do
postsRule :: Rules ()
postsRule = map indexHtmlOutputPath postGlobs |%> \target -> do
let src = indexHtmlSourcePath target
post <- readPost src
postHtml <- applyTemplate "post.html" post
@ -125,17 +109,11 @@ rss = outputDir </> "index.xml" %> \target -> do
readPost :: FilePath -> Action Post
readPost postPath = do
date <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d"
. take 10
. Shake.takeBaseName
$ postPath
let formattedDate =
T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date
(post, html) <- typstToHtml postPath
Shake.putInfo $ show post
Shake.putInfo $ "Read " <> postPath
return $ post
{ postDate = Just formattedDate,
{
postContent = Just html,
postLink = Just . T.pack $ "/" <> Shake.dropExtension postPath <> "/"
}

22
app/Types.hs Normal file
View file

@ -0,0 +1,22 @@
{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-}
{-# LANGUAGE DerivingVia, TypeApplications #-}
module Types where
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 Post = Post
{ postTitle :: Text,
postAuthor :: Maybe Text,
postTags :: [Text],
postDate :: Maybe Text,
postContent :: Maybe Text,
postLink :: Maybe Text
} deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post

View file

@ -1,6 +1,7 @@
{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-}
{-# LANGUAGE ApplicativeDo, DataKinds, NamedFieldPuns #-}
{-# LANGUAGE DerivingVia, LambdaCase, TypeApplications #-}
module Utilities where
import Data.Text (Text)
import Development.Shake.FilePath ((<.>), (</>))
import qualified Data.Text as T
@ -11,6 +12,9 @@ import Config
import Development.Shake (Action)
import Text.Pandoc
import Data.Aeson as A
import Data.Time (UTCTime(UTCTime), formatTime, defaultTimeLocale, parseTimeM)
import Types
import Data.Maybe (fromJust)
indexHtmlOutputPath :: FilePath -> FilePath
indexHtmlOutputPath srcPath =
@ -23,14 +27,15 @@ indexHtmlSourcePath =
. Shake.dropTrailingPathSeparator
. Shake.dropFileName
typstToHtml :: FromJSON a => FilePath -> Action (a, Text)
typstToHtml :: FilePath -> Action (Post, Text)
typstToHtml filePath = do
content <- Shake.readFile' filePath
Shake.quietly . Shake.traced "Typst to HTML" $ do
doc@(Pandoc meta _) <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content
meta' <- fromMeta meta
let dateTransformedMeta = dateTransform meta'
html <- runPandoc . Pandoc.writeHtml5String writerOptions $ doc
return (meta', html)
return (fromJust dateTransformedMeta, html)
where
readerOptions =
Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions}
@ -54,3 +59,11 @@ typstToHtml filePath = do
runPandoc action =
Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
>>= either (fail . show) return
dateTransform post@(Post{postDate}) = do
postDate' <- dateStrTransform $ T.unpack $ fromJust postDate
Just post {
postDate = Just postDate'
}
dateStrTransform date = do
date' <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d" date
Just $ T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date'

View file

@ -62,7 +62,7 @@ executable psb
main-is: Main.hs
-- Modules included in this executable, other than Main.
other-modules: Config Utilities Templates
other-modules: Config Utilities Templates Types
-- LANGUAGE extensions used by modules in this package.
-- other-extensions: