basic stuff is done

This commit is contained in:
Pagwin 2024-10-02 18:18:10 -04:00
parent db24be34dd
commit 93bfd31abf
No known key found for this signature in database
GPG key ID: 81137023740CA260
2 changed files with 123 additions and 108 deletions

View file

@ -7,49 +7,50 @@
module Main where
import Config
import Control.Monad (forM, when)
import Data.List (sortOn)
import Development.Shake (Action, Rules, (|%>), (~>), (%>))
import Development.Shake.FilePath ((</>))
import qualified Data.HashMap.Strict as HM
import Data.List (sortOn)
import qualified Data.Ord as Ord
import qualified Data.Text as T
import Data.Time
import Development.Shake (Action, Rules, (%>), (|%>), (~>))
import qualified Development.Shake as Shake
import Development.Shake.FilePath ((</>))
import qualified Development.Shake.FilePath as FP
import Config
import Templates
import Types
import Utilities
import Templates
import Data.Time
-- target = thing we want
-- Rule = pattern of thing being made + actions to produce the thing
-- Action = actions to produce a thing
main :: IO ()
main = do
Shake.shakeArgs Shake.shakeOptions $ do
Shake.withTargetDocs "Build the site" $
"build" ~> buildSite
Shake.withTargetDocs "Clean the built site" $
"clean" ~> Shake.removeFilesAfter outputDir ["//*"]
Shake.withoutTargets buildRules
Shake.shakeArgs Shake.shakeOptions $ do
Shake.withTargetDocs "Build the site" $
"build" ~> buildSite
Shake.withTargetDocs "Clean the built site" $
"clean" ~> Shake.removeFilesAfter outputDir ["//*"]
Shake.withoutTargets buildRules
buildSite :: Action ()
buildSite = do
-- static files
assetPaths <- Shake.getDirectoryFiles "" assetGlobs
-- path concat each asset path so it's output into the outputDir
Shake.need $ map (outputDir </>) assetPaths
-- take the misc pages which aren't blog posts and make their html files
Shake.need $ map indexHtmlOutputPath pagePaths
-- static files
assetPaths <- Shake.getDirectoryFiles "" assetGlobs
-- path concat each asset path so it's output into the outputDir
Shake.need $ map (outputDir </>) assetPaths
-- handle posts
postPaths <- Shake.getDirectoryFiles "" postGlobs
Shake.need $ map indexHtmlOutputPath postPaths
-- take the misc pages which aren't blog posts and make their html files
Shake.need $ map indexHtmlOutputPath pagePaths
-- remaining pages, index.xml = rss feed
Shake.need $ map (outputDir </>) ["index.html", "index.xml"]
-- handle posts
postPaths <- Shake.getDirectoryFiles "" postGlobs
Shake.need $ map indexHtmlOutputPath postPaths
-- remaining pages, index.xml = rss feed
Shake.need $ map (outputDir </>) ["index.html", "index.xml"]
buildRules :: Rules ()
buildRules = do
@ -61,36 +62,43 @@ buildRules = do
-- make a rule of the pattern outputDir/asset_name which copes from outputDir/../pages
assets :: Rules ()
assets = map (outputDir </>) assetGlobs |%> \target -> do
let src = FP.dropDirectory1 target
Shake.copyFileChanged src target
Shake.putInfo $ "Copied " <> target <> " from " <> src
assets =
map (outputDir </>) assetGlobs |%> \target -> do
let src = FP.dropDirectory1 target
Shake.copyFileChanged src target
Shake.putInfo $ "Copied " <> target <> " from " <> src
-- handling typst only because pages should only be typst no reason for backwards compat on that
pages :: Rules ()
pages = map indexHtmlOutputPath pagePaths |%> \target -> do
let src = indexHtmlTypstSourcePath target
let metaSrc = indexHtmlTypstMetaPath target
html <- typstToHtml src
meta <- yamlToPost metaSrc
let page = Page (postTitle meta) html
applyTemplateAndWrite "default.html" page target
Shake.putInfo $ "Built " <> target <> " from " <> src
pages =
map indexHtmlOutputPath pagePaths |%> \target -> do
let src = indexHtmlTypstSourcePath target
let metaSrc = indexHtmlTypstMetaPath target
html <- typstToHtml src
meta <- yamlToPost metaSrc
let page = Page (postTitle meta) html
applyTemplateAndWrite "default.html" page target
Shake.putInfo $ "Built " <> target <> " from " <> src
-- there's probably a better way of doing this that allows for the target's origin file extension to get passed in but for now we're doing brute force
postsRule :: Rules ()
postsRule = map indexHtmlOutputPath postGlobs |%> \target -> do
postsRule =
map indexHtmlOutputPath postGlobs |%> \target -> do
let potentials = indexHtmlSourcePaths target
Shake.forP potentials (\path->do
exists <- Shake.doesFileExist path
when exists
(case FP.takeExtension path of
Shake.forP
potentials
( \path -> do
exists <- Shake.doesFileExist path
when
exists
( case FP.takeExtension path of
".typ" -> typstPost path
".md" -> markdownPost path
_ -> error $ "invalid file extension for post " <> target)
)
_ -> error $ "invalid file extension for post " <> target
)
)
return ()
typstPost :: FP.FilePath -> Action ()
typstPost src = do
Shake.need [src]
@ -103,7 +111,6 @@ typstPost src = do
applyTemplateAndWrite "default.html" page target
Shake.putInfo $ "Built " <> target <> " from " <> src
markdownPost :: FP.FilePath -> Action ()
markdownPost src = do
Shake.need [src]
@ -117,49 +124,52 @@ markdownPost src = do
Shake.putInfo $ "Built " <> target <> " from " <> src
home :: Rules ()
home = outputDir </> "index.html" %> \target -> do
postPaths <- Shake.getDirectoryFiles "" postGlobs
posts <- take 3
. sortOn (Ord.Down . postDate)
<$> forM postPaths readPost
html <- applyTemplate "home.html" $ HM.singleton "posts" posts
home =
outputDir </> "index.html" %> \target -> do
postPaths <- Shake.getDirectoryFiles "" postGlobs
posts <-
take 3
. sortOn (Ord.Down . postDate)
<$> forM postPaths readPost
html <- applyTemplate "home.html" $ HM.singleton "posts" posts
let page = Page (T.pack "Home") html
applyTemplateAndWrite "default.html" page target
Shake.putInfo $ "Built " <> target
let page = Page (T.pack "Home") html
applyTemplateAndWrite "default.html" page target
Shake.putInfo $ "Built " <> target
rss :: Rules ()
rss = outputDir </> "index.xml" %> \target -> do
rss =
outputDir </> "index.xml" %> \target -> do
postPaths <- Shake.getDirectoryFiles "" postGlobs
posts <- sortOn (Ord.Down . postDate) <$> forM postPaths readPost
applyTemplateAndWrite "feed.xml" (HM.singleton "posts" posts) target
Shake.putInfo $ "Built " <> target
readPost :: FilePath -> Action Post
readPost postPath = do
case FP.takeExtension postPath of
".typ" -> readTypstPost postPath
".md" -> readMarkdownPost postPath
_ -> error $ "unknown file extension for file" <> postPath
case FP.takeExtension postPath of
".typ" -> readTypstPost postPath
".md" -> readMarkdownPost postPath
_ -> error $ "unknown file extension for file" <> postPath
readTypstPost :: FilePath -> Action Post
readTypstPost postPath = do
html <- typstToHtml postPath
post <- yamlToPost $ typstMetaPath postPath
Shake.putInfo $ "Read " <> postPath
return $ post
{
postContent = Just html,
postLink = Just . T.pack $ "/" <> FP.dropExtension postPath <> "/"
}
return $
post
{ postContent = Just html,
postLink = Just . T.pack $ "/" <> FP.dropExtension postPath <> "/"
}
readMarkdownPost :: FilePath -> Action Post
readMarkdownPost postPath = do
(post, html) <- markdownToHtml postPath
Shake.putInfo $ "Read " <> postPath
return $ post
{
postContent = Just html,
postLink = Just . T.pack $ "/" <> FP.dropExtension postPath <> "/"
}
(post, html) <- markdownToHtml postPath
Shake.putInfo $ "Read " <> postPath
return $
post
{ postContent = Just html,
postLink = Just . T.pack $ "/" <> FP.dropExtension postPath <> "/"
}

View file

@ -1,41 +1,40 @@
module Utilities where
import Data.Text (Text)
import Development.Shake.FilePath ((<.>), (</>))
import qualified Data.Text as T
import Data.Yaml.Aeson
import qualified Development.Shake as Shake
import qualified Development.Shake.FilePath as Shake
import qualified Text.Pandoc as Pandoc
import Config
import Development.Shake (Action)
import Types
import Data.Maybe (fromMaybe)
import Data.Time
import Text.Pandoc (Block (Plain), Meta (..), MetaValue (..), Pandoc (..))
import Data.Aeson (Result(Success, Error))
import Data.Aeson (Result (Error, Success))
import qualified Data.Aeson as A
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
import Data.Yaml.Aeson
import Development.Shake (Action)
import qualified Development.Shake as Shake
import Development.Shake.FilePath ((<.>), (</>))
import qualified Development.Shake.FilePath as Shake
import Text.Pandoc (Block (Plain), Meta (..), MetaValue (..), Pandoc (..))
import qualified Text.Pandoc as Pandoc
import Types
indexHtmlOutputPath :: FilePath -> FilePath
indexHtmlOutputPath srcPath =
outputDir </> Shake.dropExtension srcPath </> "index.html"
-- were applicative shenanigans necessary? no
-- but using them felt cool
indexHtmlSourcePaths :: FilePath -> [FilePath]
indexHtmlSourcePaths path = [indexHtmlTypstSourcePath, indexHtmlMarkdownSourcePath] <*> [path]
indexHtmlTypstSourcePath :: FilePath -> FilePath
indexHtmlTypstSourcePath =
Shake.dropDirectory1
indexHtmlTypstSourcePath =
Shake.dropDirectory1
. (<.> "typ")
. Shake.dropTrailingPathSeparator
. Shake.dropFileName
indexHtmlMarkdownSourcePath :: FilePath -> FilePath
indexHtmlMarkdownSourcePath =
Shake.dropDirectory1
Shake.dropDirectory1
. (<.> "md")
. Shake.dropTrailingPathSeparator
. Shake.dropFileName
@ -46,7 +45,6 @@ indexHtmlTypstMetaPath = typstMetaPath . indexHtmlTypstSourcePath
typstMetaPath :: FilePath -> FilePath
typstMetaPath typstPath = Shake.dropExtension typstPath <.> "yaml"
typstToHtml :: FilePath -> Action Text
typstToHtml filePath = do
content <- Shake.readFile' filePath
@ -59,18 +57,24 @@ typstToHtml filePath = do
Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions}
writerOptions =
Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions}
markdownToHtml :: FromJSON a => FilePath -> Action (a, Text)
markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text)
markdownToHtml filePath = do
content <- Shake.readFile' filePath
Shake.quietly . Shake.traced "Markdown to HTML" $ do
pandoc@(Pandoc meta _) <-
runPandoc . Pandoc.readMarkdown readerOptions . T.pack $ content
-- WARNING markdown needs to have no whitespace before/after dashes
-- print meta
meta' <- fromMeta meta
html <- runPandoc . Pandoc.writeHtml5String writerOptions $ pandoc
return (meta', html)
where
readerOptions =
Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions}
Pandoc.def
{ Pandoc.readerStandalone = True,
Pandoc.readerExtensions = Pandoc.enableExtension Pandoc.Ext_yaml_metadata_block Pandoc.pandocExtensions
}
writerOptions =
Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions}
fromMeta (Meta meta) =
@ -91,24 +95,25 @@ markdownToHtml filePath = do
runPandoc :: Pandoc.PandocIO b -> IO b
runPandoc action =
Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
>>= either (fail . show) return
Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
>>= either (fail . show) return
yamlToPost :: FilePath -> Action Post
yamlToPost path = do
post <- decodeFileThrow path
let post' = dateTransform post
return $ fromMaybe post post'
where
dateTransform post@(Post{postDate}) = do
postDate' <- postDate
let postDate'' = dateStrTransform $ T.unpack postDate'
Just post {
postDate = postDate''
}
dateStrTransform date = do
date' <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d" date
Just $ T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date'
post <- decodeFileThrow path
let post' = dateTransform post
return $ fromMaybe post post'
where
dateTransform post@(Post {postDate}) = do
postDate' <- postDate
let postDate'' = dateStrTransform $ T.unpack postDate'
Just
post
{ postDate = postDate''
}
dateStrTransform date = do
date' <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d" date
Just $ T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date'
isTypstPost :: FilePath -> Bool
isTypstPost path = Shake.takeExtension path == ".typ"