-- pulling heavily from https://abhinavsarkar.net/posts/static-site-generator-using-shake/ -- docs: -- https://hackage.haskell.org/package/shake-0.19.8/docs/doc-index-All.html -- https://hackage.haskell.org/package/pandoc-3.2.1/docs/doc-index-All.html -- https://hackage.haskell.org/package/mustache-2.4.2/docs/doc-index.html -- module Psb.Main where import Config import Control.Monad (when) import Data.Aeson (ToJSON (toJSON)) 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.Traversable (traverse) 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 Templates import Text.Megaparsec (errorBundlePretty) import Text.Mustache (ToMustache (toMustache)) import Types import Utilities.Action (getPublishedPosts, isDraft', markdownToHtml, markdownToPost, now, psbProgress) import Utilities.Bundling (bundled) import qualified Utilities.CSS as CSS import Utilities.FilePath (indexHtmlOutputPath, indexHtmlSourcePaths, isMarkdownPost, urlConvert) import qualified Utilities.Javascript as JS -- target = thing we want -- Rule = pattern of thing being made + actions to produce the thing -- Action = actions to produce a thing -- note: live watch should be done outside of shake with the watcher then running shake which is rather annoying main :: IO () main = do Shake.shakeArgs Shake.shakeOptions { Shake.shakeProgress = psbProgress, Shake.shakeColor = True } $ 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 -- handle js, css and anything else we want to process before moving resourcePaths <- Shake.getDirectoryFiles "resources/" resourceGlobs Shake.need $ map resourceHashPath resourcePaths -- take the misc pages which aren't blog posts and make their html files Shake.need $ map indexHtmlOutputPath pagePaths -- handle posts postPaths <- getPublishedPosts isDraft Shake.need $ map indexHtmlOutputPath postPaths -- remaining pages, index.xml = rss feed Shake.need $ map (outputDir ) ["index.html", "index.xml"] buildRules :: Rules () buildRules = do home assets bundled postsRule rss -- css_resources -- js_resources -- 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 -- css_resources :: Rules () -- css_resources = -- map (outputDir ) cssGlobs |%> \target -> do -- src <- Shake.readFile' $ FP.dropDirectory1 target -- -- TODO: write to fingerprinted location as well -- Shake.writeFileChanged target $ CSS.minify src -- -- js_resources :: Rules () -- js_resources = -- map (outputDir ) jsGlobs |%> \target -> do -- let src_file = FP.dropDirectory1 target -- src <- Shake.readFile' $ src_file -- -- TODO: write to fingerprinted location as well -- Shake.writeFileChanged target $ JS.minify 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 let potentials = indexHtmlSourcePaths target Shake.forP potentials ( \path -> do exists <- Shake.doesFileExist path should <- if exists then not <$> isDraft path else pure False when should ( case FP.takeExtension path of ".md" -> markdownPost path _ -> error $ "invalid file extension for post " <> target ) ) return () markdownPost :: FP.FilePath -> Action () markdownPost src = do Shake.need [src] let target = indexHtmlOutputPath src post <- readMarkdownPost src let rPost = fromPost post postHtml <- applyTemplate "post.html" rPost time <- Utilities.Action.now -- Shake.putInfo $ T.unpack $ urlConvert target let page = Page { pageTitle = rPostTitle rPost, pageContent = postHtml, pageNow = time, pageUrl = urlConvert target } applyTemplateAndWrite "default.html" page target -- Shake.putInfo $ "Built " <> target <> " from " <> src home :: Rules () home = outputDir "index.html" %> \target -> do postPaths <- getPublishedPosts isDraft posts <- sortOn (Ord.Down . postDate) <$> traverse readPost postPaths let posts' = map fromPost posts html <- applyTemplate "home.html" $ HM.singleton "posts" posts' time <- Utilities.Action.now -- Shake.putInfo $ T.unpack $ urlConvert target let page = Page { pageTitle = T.pack "Home", pageContent = html, pageNow = time, pageUrl = urlConvert 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 instance ToMustache Rss where toMustache = toMustache . toJSON rss :: Rules () rss = outputDir "index.xml" %> \target -> do postPaths <- getPublishedPosts isDraft posts <- map fromPost . sortOn (Ord.Down . postDate) <$> traverse readPost postPaths time <- Utilities.Action.now applyTemplateAndWrite "feed.xml" (Rss time posts) target -- Shake.putInfo $ "Built " <> target readPost :: FilePath -> Action Post readPost postPath = case FP.takeExtension postPath of ".md" -> readMarkdownPost postPath _ -> error $ "unknown file extension for file" <> 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 <> "/" } postHandles :: [(FilePath -> Bool, FilePath -> Action Post)] postHandles = [(isMarkdownPost, markdownToPost)] isDraft :: FilePath -> Action Bool isDraft = isDraft' postHandles