From 93bfd31abf21a06ef7d5e10394e3e6f3a16341b1 Mon Sep 17 00:00:00 2001 From: Pagwin Date: Wed, 2 Oct 2024 18:18:10 -0400 Subject: [PATCH] basic stuff is done --- app/Main.hs | 156 +++++++++++++++++++++++++---------------------- app/Utilities.hs | 75 ++++++++++++----------- 2 files changed, 123 insertions(+), 108 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index dd579c6..01fd947 100755 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 <> "/" + } diff --git a/app/Utilities.hs b/app/Utilities.hs index 53eb9ea..f3cb6a1 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -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"