moved everything into src for ease of testing

This commit is contained in:
Pagwin 2025-12-05 19:42:15 -05:00
parent 6c81f761d6
commit c4ff078785
No known key found for this signature in database
GPG key ID: 81137023740CA260
11 changed files with 187 additions and 194 deletions

View file

@ -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 module Main where
import Config import qualified Psb.Main as Psb
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 :: IO ()
main = do main = Psb.main
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

View file

@ -27,43 +27,30 @@ common warnings
library library
hs-source-dirs: src hs-source-dirs: src
exposed-modules: Markdown HTML Logger IR Logger.Shake 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, text >= 2.1.2 , megaparsec >= 9.7.0 , transformers >= 0.6.2, shake >= 0.19.8, 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 default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances
test-suite test-markdown-parse test-suite test-markdown-parse
hs-source-dirs: app hs-source-dirs: tests
type: exitcode-stdio-1.0 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 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 default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances
other-modules: Utilities
default-language: Haskell2010 default-language: Haskell2010
executable psb executable psb
-- Import common warning flags. import: warnings
import: warnings hs-source-dirs: app
-- .hs or .lhs file containing the Main module. -- .hs or .lhs file containing the Main module.
main-is: Main.hs 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 ghc-options: -threaded
build-depends: psb, base
-- default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances
source-repository head source-repository head
type: git type: git

174
src/Psb/Main.hs Normal file
View file

@ -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