basic stuff is done
This commit is contained in:
parent
db24be34dd
commit
93bfd31abf
2 changed files with 123 additions and 108 deletions
156
app/Main.hs
156
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 <> "/"
|
||||
}
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Reference in a new issue