diff --git a/app/Main.hs b/app/Main.hs index 3edaec9..8dff799 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,174 +1,6 @@ --- 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 Main where -import Config -import Control.Monad (forM, when) -import qualified Data.HashMap.Strict as HM -import Data.List (sortOn) -import qualified Data.Ord as Ord -import qualified Data.Text as T -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 Types -import Utilities.Action (getPublishedPosts, isDraft', markdownToHtml, markdownToPost, now) -import Utilities.FilePath (indexHtmlOutputPath, indexHtmlSourcePaths, isMarkdownPost, urlConvert) +import qualified Psb.Main as Psb --- 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} $ 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 - - -- 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 - postsRule - rss - --- 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 - --- 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) - <$> forM postPaths readPost - 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 - -rss :: Rules () -rss = - outputDir "index.xml" %> \target -> do - postPaths <- getPublishedPosts isDraft - posts <- map fromPost . sortOn (Ord.Down . postDate) <$> forM postPaths readPost - 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 - -psbProgress :: IO Shake.Progress -> IO () -psbProgress = Shake.progressDisplay 0.01 putStrLn +main = Psb.main diff --git a/psb.cabal b/psb.cabal index 5b6d974..5291381 100644 --- a/psb.cabal +++ b/psb.cabal @@ -27,43 +27,30 @@ common warnings library hs-source-dirs: src - exposed-modules: Markdown HTML Logger IR Logger.Shake - build-depends: base >=4.20 && < 4.21, text >= 2.1.2 , megaparsec >= 9.7.0 , transformers >= 0.6.2, shake >= 0.19.8, + exposed-modules: Markdown HTML Logger IR Logger.Shake Psb.Main Utilities Utilities.FilePath Utilities.Action Templates Types Config + build-depends: base >=4.20 && < 4.21, mustache >=2.4.2, shake >= 0.19.8, deriving-aeson >= 0.2.9, aeson, text >= 2.1.2, time, unordered-containers, yaml, megaparsec >= 9.7.0, transformers >= 0.6.2 default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances test-suite test-markdown-parse - hs-source-dirs: app + hs-source-dirs: tests type: exitcode-stdio-1.0 - main-is: Tests/Markdown/Parse.hs + main-is: Markdown/Parse.hs build-depends: base >=4.20 && < 4.21, text >= 2.1.2 , megaparsec >= 9.7.0 , transformers >= 0.6.2 , hedgehog >= 1.7 , time, psb default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances - other-modules: Utilities default-language: Haskell2010 + executable psb - -- Import common warning flags. - import: warnings - + import: warnings + hs-source-dirs: app -- .hs or .lhs file containing the Main module. main-is: Main.hs - - other-modules: Config Utilities Utilities.FilePath Utilities.Action Templates Types - - default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances - - -- Other library packages from which modules are imported. - -- https://hackage.haskell.org/package/texmath - build-depends: base >=4.20 && < 4.21, mustache >=2.4.2, shake >= 0.19.8, deriving-aeson >= 0.2.9, aeson, text >= 2.1.2, time, unordered-containers, yaml, megaparsec >= 9.7.0, transformers >= 0.6.2, psb - --parsec >= 3.1.18.0 - - -- Directories containing source files. - hs-source-dirs: app - - -- Base language which the package is written in. - default-language: Haskell2010 - ghc-options: -threaded + build-depends: psb, base + + +-- default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances source-repository head type: git diff --git a/app/Config.hs b/src/Config.hs similarity index 100% rename from app/Config.hs rename to src/Config.hs diff --git a/src/Psb/Main.hs b/src/Psb/Main.hs new file mode 100644 index 0000000..f13baa6 --- /dev/null +++ b/src/Psb/Main.hs @@ -0,0 +1,174 @@ +-- 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 (forM, when) +import qualified Data.HashMap.Strict as HM +import Data.List (sortOn) +import qualified Data.Ord as Ord +import qualified Data.Text as T +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 Types +import Utilities.Action (getPublishedPosts, isDraft', markdownToHtml, markdownToPost, now) +import Utilities.FilePath (indexHtmlOutputPath, indexHtmlSourcePaths, isMarkdownPost, urlConvert) + +-- 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} $ 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 + + -- 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 + postsRule + rss + +-- 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 + +-- 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) + <$> forM postPaths readPost + 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 + +rss :: Rules () +rss = + outputDir "index.xml" %> \target -> do + postPaths <- getPublishedPosts isDraft + posts <- map fromPost . sortOn (Ord.Down . postDate) <$> forM postPaths readPost + 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 + +psbProgress :: IO Shake.Progress -> IO () +psbProgress = Shake.progressDisplay 0.01 putStrLn diff --git a/app/Restruct.hs b/src/Restruct.hs similarity index 100% rename from app/Restruct.hs rename to src/Restruct.hs diff --git a/app/Templates.hs b/src/Templates.hs similarity index 100% rename from app/Templates.hs rename to src/Templates.hs diff --git a/app/Types.hs b/src/Types.hs similarity index 100% rename from app/Types.hs rename to src/Types.hs diff --git a/app/Utilities.hs b/src/Utilities.hs similarity index 100% rename from app/Utilities.hs rename to src/Utilities.hs diff --git a/app/Utilities/Action.hs b/src/Utilities/Action.hs similarity index 100% rename from app/Utilities/Action.hs rename to src/Utilities/Action.hs diff --git a/app/Utilities/FilePath.hs b/src/Utilities/FilePath.hs similarity index 100% rename from app/Utilities/FilePath.hs rename to src/Utilities/FilePath.hs diff --git a/app/Tests/Markdown/Parse.hs b/tests/Markdown/Parse.hs similarity index 100% rename from app/Tests/Markdown/Parse.hs rename to tests/Markdown/Parse.hs