moved everything into src for ease of testing
This commit is contained in:
Pagwin
parent
6c81f761d6
commit
c4ff078785
11 changed files with 187 additions and 194 deletions
172
app/Main.hs
172
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
|
||||
|
|
|
|||
33
psb.cabal
33
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
|
||||
|
||||
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
|
||||
|
|
|
|||
174
src/Psb/Main.hs
Normal file
174
src/Psb/Main.hs
Normal 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
|
||||
Loading…
Reference in a new issue