parent
8d2c3c229c
commit
b4bbc0f1b3
19
Types.hs
19
Types.hs
|
@ -21,7 +21,8 @@
|
||||||
module Types where
|
module Types where
|
||||||
|
|
||||||
import Control.Monad.Trans.State.Lazy
|
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.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Data.Yaml as Y
|
import qualified Data.Yaml as Y
|
||||||
|
@ -73,6 +74,7 @@ data SiteState =
|
||||||
, _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages
|
, _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages
|
||||||
, _tagTemplate :: FilePath -- ^ Name of the template for category pages
|
, _tagTemplate :: FilePath -- ^ Name of the template for category pages
|
||||||
, _listTemplate :: FilePath -- ^ Name of the template for listing 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.
|
, _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.
|
, _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links.
|
||||||
, _appendUrlIndex :: Bool -- ^ Append full @index.html@ to all page URLs
|
, _appendUrlIndex :: Bool -- ^ Append full @index.html@ to all page URLs
|
||||||
|
@ -146,6 +148,21 @@ siteOptions' = do
|
||||||
long "timestamp-prefix" <>
|
long "timestamp-prefix" <>
|
||||||
help "Timestamp file suffix for markdowns" <>
|
help "Timestamp file suffix for markdowns" <>
|
||||||
value ".timestamp" <> showDefault
|
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 <-
|
_urlBase <-
|
||||||
strOption $
|
strOption $
|
||||||
long "url-base" <>
|
long "url-base" <>
|
||||||
|
|
|
@ -32,6 +32,7 @@ executable reploy
|
||||||
, SHA
|
, SHA
|
||||||
, text
|
, text
|
||||||
, transformers
|
, transformers
|
||||||
|
, utf8-string
|
||||||
, yaml
|
, yaml
|
||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wunused-imports
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wunused-imports
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -202,8 +202,9 @@ addGlobalMeta :: Y.Value -> Site MT.Value
|
||||||
addGlobalMeta (Y.Object m) = do
|
addGlobalMeta (Y.Object m) = do
|
||||||
r <- use urlBase
|
r <- use urlBase
|
||||||
i <- use appendUrlIndex
|
i <- use appendUrlIndex
|
||||||
|
em <- use extraMeta
|
||||||
let l = map (\(k, v) -> (K.toText k, Mu.toMustache v)) $ KM.toList m
|
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)
|
[ ("root", Mu.toMustache $ T.pack r)
|
||||||
, ("rawRootUrl", Mu.overText $ T.pack . rootUrl' r . T.unpack)
|
, ("rawRootUrl", Mu.overText $ T.pack . rootUrl' r . T.unpack)
|
||||||
, ("pageLink", Mu.overText $ T.pack . rootPageUrl' r i . T.unpack)
|
, ("pageLink", Mu.overText $ T.pack . rootPageUrl' r i . T.unpack)
|
||||||
|
|
Loading…
Reference in a new issue