made it so date is in the metadata instead of the filename
This commit is contained in:
parent
a15d27a324
commit
daeaf9b9ec
4 changed files with 46 additions and 33 deletions
36
app/Main.hs
36
app/Main.hs
|
@ -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
22
app/Types.hs
Normal 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
|
|
@ -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'
|
||||
|
|
|
@ -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:
|
||||
|
|
Loading…
Reference in a new issue