lots of progress but still has compiler errors

This commit is contained in:
Pagwin 2024-07-20 17:36:55 -04:00
parent d364237e05
commit 9c1dad567b
No known key found for this signature in database
GPG key ID: 81137023740CA260
7 changed files with 145 additions and 30 deletions

BIN
.shake/.shake.database Normal file

Binary file not shown.

0
.shake/.shake.lock Normal file
View file

13
app/Config.hs Normal file
View file

@ -0,0 +1,13 @@
module Config where
outputDir :: String
outputDir = "publish"
assetGlobs :: [String]
assetGlobs = ["static/*"]
pagePaths :: [String]
pagePaths = ["about.md", "contact.md"]
postGlobs :: [String]
postGlobs = ["posts/*.typ"]

View file

@ -4,7 +4,7 @@
-- https://hackage.haskell.org/package/mustache-2.4.2/docs/doc-index.html
--
{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-}
{-# LANGUAGE DerivingVia, LambdaCase, TypeApplications #-}
{-# LANGUAGE DerivingVia, TypeApplications #-}
module Main where
@ -27,7 +27,9 @@ import qualified Development.Shake.FilePath as Shake
import qualified Text.Mustache as Mus
import qualified Text.Mustache.Compile as Mus
import qualified Text.Pandoc as Pandoc
import Config
import Utilities
import Templates
-- target = thing we want
-- Rule = pattern of thing being made + actions to produce the thing
-- Action = actions to produce a thing
@ -39,8 +41,6 @@ main = Shake.shakeArgs Shake.shakeOptions $ do
Shake.withTargetDocs "Clean the built site" $
"clean" ~> Shake.removeFilesAfter outputDir ["//*"]
outputDir :: String
outputDir = "publish"
buildSite :: Action ()
buildSite = do
@ -59,6 +59,12 @@ buildSite = do
-- remaining pages, index.xml = rss feed
Shake.need $ map (outputDir </>) ["index.html", "index.xml"]
buildRules :: Rules ()
buildRules = do
assets
pages
posts
-- make a rule of the pattern outputDir/asset_name which copes from outputDir/../pages
assets :: Rules ()
assets = map (outputDir </>) assetGlobs |%> \target -> do
@ -66,36 +72,53 @@ assets = map (outputDir </>) assetGlobs |%> \target -> do
Shake.copyFileChanged src target
Shake.putInfo $ "Copied " <> target <> " from " <> src
typstToHtml :: FilePath -> Action Text
typstToHtml filePath = do
content <- Shake.readFile' filePath
Shake.quietly . Shake.traced "Typst to HTML" $ do
doc <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content
runPandoc . Pandoc.writeHtml5String writerOptions $ doc
where
readerOptions =
Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions}
writerOptions =
Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions}
data Page = Page {pageTitle :: Text, pageContent :: Text}
deriving (Show, Generic)
deriving (ToJSON) via PrefixedSnake "page" Page
assetGlobs :: [String]
assetGlobs = ["static/*"]
pages :: Rules ()
pages = map indexHtmlOutputPath pagePaths |%> \target -> do
let src = indexHtmlSourcePath target
(meta, html) <- typstToHtml src
pagePaths :: [String]
pagePaths = ["about.md", "contact.md"]
let page = Page (meta HM.! "title") html
applyTemplateAndWrite "default.html" page target
Shake.putInfo $ "Built " <> target <> " from " <> src
postGlobs :: [String]
postGlobs = ["posts/*.typ"]
data Post = Post
{ postTitle :: Text,
postAuthor :: Maybe Text,
postTags :: [Text],
postDate :: Maybe Text,
postContent :: Maybe Text,
postLink :: Maybe Text
} deriving (Show, Generic)
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post
runPandoc action =
Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
>>= either (fail . show) return
posts :: Rules ()
posts = map indexHtmlOutputPath postGlobs |%> \target -> do
let src = indexHtmlSourcePath target
post <- readPost src
postHtml <- applyTemplate "post.html" post
let page = Page (postTitle post) postHtml
applyTemplateAndWrite "default.html" page target
Shake.putInfo $ "Built " <> target <> " from " <> src
readPost :: FilePath -> Action Post
readPost postPath = do
date <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d"
. take 10
. Shake.takeBaseName
$ postPath
let formattedDate =
T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date
(post, html) <- typstToHtml postPath
Shake.putInfo $ "Read " <> postPath
return $ post
{ postDate = Just formattedDate,
postContent = Just html,
postLink = Just . T.pack $ "/" <> Shake.dropExtension postPath <> "/"
}
indexHtmlOutputPath :: FilePath -> FilePath
indexHtmlOutputPath srcPath =
outputDir </> Shake.dropExtension srcPath </> "index.html"

40
app/Templates.hs Normal file
View file

@ -0,0 +1,40 @@
{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-}
{-# LANGUAGE DerivingVia, LambdaCase, TypeApplications #-}
module Templates where
import Development.Shake
import Data.Aeson (ToJSON)
import Data.Text (Text)
import qualified Text.Mustache as Mus
import qualified Text.Mustache.Compile as Mus
import qualified Development.Shake as Shake
import qualified Data.Aeson as A
import qualified Data.Text as T
import Development.Shake.FilePath ((</>))
applyTemplate :: ToJSON a => String -> a -> Text
applyTemplate templateName context = do
tmpl <- readTemplate $ "templates" </> templateName
case Mus.checkedSubstitute tmpl (A.toJSON context) of
([], text) -> return text
(errs, _) -> fail $
"Error while substituting template " <> templateName
<> ": " <> unlines (map show errs)
applyTemplateAndWrite :: ToJSON a => String -> a -> FilePath -> Action ()
applyTemplateAndWrite templateName context outputPath =
applyTemplate templateName context
>>= Shake.writeFile' outputPath . T.unpack
readTemplate :: FilePath -> Action Mus.Template
readTemplate templatePath = do
Shake.need [templatePath]
eTemplate <- Shake.quietly
. Shake.traced "Compile template"
$ Mus.localAutomaticCompile templatePath
case eTemplate of
Right template -> do
Shake.need . Mus.getPartials . Mus.ast $ template
Shake.putInfo $ "Read " <> templatePath
return template
Left err -> fail $ show err

39
app/Utilities.hs Normal file
View file

@ -0,0 +1,39 @@
{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-}
{-# LANGUAGE DerivingVia, LambdaCase, TypeApplications #-}
module Utilities where
import Data.Text (Text)
import Development.Shake.FilePath ((<.>), (</>))
import qualified Data.Text as T
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)
indexHtmlOutputPath :: FilePath -> FilePath
indexHtmlOutputPath srcPath =
outputDir </> Shake.dropExtension srcPath </> "index.html"
indexHtmlSourcePath :: FilePath -> FilePath
indexHtmlSourcePath =
Shake.dropDirectory1
. (<.> "md")
. Shake.dropTrailingPathSeparator
. Shake.dropFileName
typstToHtml :: FilePath -> Action Text
typstToHtml filePath = do
content <- Shake.readFile' filePath
Shake.quietly . Shake.traced "Typst to HTML" $ do
doc <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content
runPandoc . Pandoc.writeHtml5String writerOptions $ doc
where
readerOptions =
Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions}
writerOptions =
Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions}
runPandoc action =
Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
>>= either (fail . show) return

View file

@ -62,7 +62,7 @@ executable psb
main-is: Main.hs
-- Modules included in this executable, other than Main.
-- other-modules:
other-modules: Config Utilities Templates
-- LANGUAGE extensions used by modules in this package.
-- other-extensions: