support custom metadata per build

Closes #13
This commit is contained in:
Mirek Kratochvil 2023-08-03 14:12:18 +02:00
parent 8d2c3c229c
commit b4bbc0f1b3
3 changed files with 21 additions and 2 deletions

View file

@ -21,7 +21,8 @@
module Types where
import Control.Monad.Trans.State.Lazy
import Data.List.NonEmpty
import qualified Data.ByteString.UTF8
import Data.List.NonEmpty (nonEmpty, toList)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Yaml as Y
@ -73,6 +74,7 @@ data SiteState =
, _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages
, _tagTemplate :: FilePath -- ^ Name of the template for category pages
, _listTemplate :: FilePath -- ^ Name of the template for listing pages
, _extraMeta :: [(String, Y.Value)] -- ^ Extra metadata added to rendering of all templates
, _timestampSuffix :: FilePath -- ^ File to search for a timestamp (e.g., if the prefix is ".ts", a timestamp for file "page.md" will be looked for in "page.md.ts"). These are best autogenerated with a script that sources the data from git or so.
, _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links.
, _appendUrlIndex :: Bool -- ^ Append full @index.html@ to all page URLs
@ -146,6 +148,21 @@ siteOptions' = do
long "timestamp-prefix" <>
help "Timestamp file suffix for markdowns" <>
value ".timestamp" <> showDefault
_extraMeta <-
let processKeyVal :: String -> (String, Y.Value)
processKeyVal opt =
case break (== ':') opt of
(k, ':':v) ->
case Y.decodeEither' $ Data.ByteString.UTF8.fromString v of
Right v -> (k, v :: Y.Value)
Left err ->
error $
"cannot parse key:val in --extra-metadata: " ++ show err
_ -> error "cannot process key:val in --extra-metadata"
in fmap (map processKeyVal) . many . strOption $
long "extra-metadata" <>
help
"Extra metadata to add to pages rendering in format `key:<yaml>'. May be specified multiple times."
_urlBase <-
strOption $
long "url-base" <>

View file

@ -32,6 +32,7 @@ executable reploy
, SHA
, text
, transformers
, utf8-string
, yaml
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wunused-imports
default-language: Haskell2010

View file

@ -202,8 +202,9 @@ addGlobalMeta :: Y.Value -> Site MT.Value
addGlobalMeta (Y.Object m) = do
r <- use urlBase
i <- use appendUrlIndex
em <- use extraMeta
let l = map (\(k, v) -> (K.toText k, Mu.toMustache v)) $ KM.toList m
pure . Mu.object $ l ++
pure . Mu.object $ l ++ map (\(k, v) -> (T.pack k, Mu.toMustache v)) em ++
[ ("root", Mu.toMustache $ T.pack r)
, ("rawRootUrl", Mu.overText $ T.pack . rootUrl' r . T.unpack)
, ("pageLink", Mu.overText $ T.pack . rootPageUrl' r i . T.unpack)