lots of progress but still has compiler errors
This commit is contained in:
parent
d364237e05
commit
9c1dad567b
7 changed files with 145 additions and 30 deletions
BIN
.shake/.shake.database
Normal file
BIN
.shake/.shake.database
Normal file
Binary file not shown.
0
.shake/.shake.lock
Normal file
0
.shake/.shake.lock
Normal file
13
app/Config.hs
Normal file
13
app/Config.hs
Normal 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"]
|
81
app/Main.hs
81
app/Main.hs
|
@ -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
40
app/Templates.hs
Normal 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
39
app/Utilities.hs
Normal 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
|
|
@ -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:
|
||||
|
|
Loading…
Reference in a new issue