exa/reploy
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

reformat using new hindent (cuteness +63)

Browse source
This commit is contained in:
Mirek Kratochvil 2023-10-16 19:08:27 +02:00
parent 56dcda5619
commit e2cec0c7a7
5 changed files with 235 additions and 194 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
FormatOpts.hs
View file

@ -23,10 +23,10 @@ import Text.Pandoc.Options
markdownReadOpts = markdownReadOpts =
def def
{ readerExtensions = { readerExtensions =
Text.Pandoc.Extensions.extensionsFromList $ Text.Pandoc.Extensions.extensionsFromList
Text.Pandoc.Extensions.extensionsToList $ Text.Pandoc.Extensions.extensionsToList
Text.Pandoc.Extensions.pandocExtensions ++ Text.Pandoc.Extensions.pandocExtensions
[ Text.Pandoc.Extensions.Ext_smart ++ [ Text.Pandoc.Extensions.Ext_smart
, Ext_lists_without_preceding_blankline , Ext_lists_without_preceding_blankline
] ]
} }

37
Tags.hs
View file

@ -44,8 +44,10 @@ sourceTagMetaFile fp = do
case yml' of case yml' of
Left err -> Left err ->
error error
("Failed to load tag metadata from " ++ fp ++ ": " ++ ("Failed to load tag metadata from "
Y.prettyPrintParseException err) ++ fp
++ ": "
++ Y.prettyPrintParseException err)
Right yml -> traverse_ go (KM.toList yml) Right yml -> traverse_ go (KM.toList yml)
where go :: (KM.Key, Y.Value) -> Site () where go :: (KM.Key, Y.Value) -> Site ()
go (k, v') = go (k, v') =
@ -61,8 +63,10 @@ sourceTagMetaFile fp = do
| v == ov = Just ov | v == ov = Just ov
| otherwise = | otherwise =
error error
("conflicting tag metadata for tag " ++ ks ++ " in " ++ ("conflicting tag metadata for tag "
fp) ++ ks
++ " in "
++ fp)
ins Nothing = Just v ins Nothing = Just v
in tagMeta %= M.alter ins kx in tagMeta %= M.alter ins kx
@ -87,10 +91,11 @@ sourceTags :: Site ()
sourceTags = do sourceTags = do
sgat <- sgat <-
map map
(second $ map splitTag . (second
(^.. pageMeta . key "tags" . values . _String . to T.unpack)) . $ map splitTag
M.assocs <$> . (^.. pageMeta . key "tags" . values . _String . to T.unpack))
use pages . M.assocs
<$> use pages
ehtags .= M.fromList (invExpandTags sgat) ehtags .= M.fromList (invExpandTags sgat)
htags .= M.fromList (invTags sgat) htags .= M.fromList (invTags sgat)
@ -115,14 +120,14 @@ htagRenderMeta makeLink htag = do
links <- map fromString <$> traverse makeLink htags links <- map fromString <$> traverse makeLink htags
names <- map fromString <$> traverse getTagGroupName htags names <- map fromString <$> traverse getTagGroupName htags
metas <- traverse htagMeta htags metas <- traverse htagMeta htags
pure $ pure
Y.object $ Y.object
[ ("href", last links) [ ("href", last links)
, ("name", last names) , ("name", last names)
, ("meta", last metas) , ("meta", last metas)
, ( "htag" , ( "htag"
, Y.array $ , Y.array
zipWith3 $ zipWith3
(\l n m -> Y.object [("href", l), ("name", n), ("meta", m)]) (\l n m -> Y.object [("href", l), ("name", n), ("meta", m)])
links links
names names
@ -151,8 +156,8 @@ genericTaggedPagesRenderMeta ::
-> M.Map [String] [FilePath] -> M.Map [String] [FilePath]
-> Site Y.Value -> Site Y.Value
genericTaggedPagesRenderMeta makePageMeta htag tagmap = genericTaggedPagesRenderMeta makePageMeta htag tagmap =
Y.array . map snd . sortOn (uncurry toSortKey) <$> Y.array . map snd . sortOn (uncurry toSortKey)
traverse metaPair (maybe [] id $ tagmap M.!? htag) <$> traverse metaPair (maybe [] id $ tagmap M.!? htag)
where where
metaPair x = do metaPair x = do
m <- makePageMeta x m <- makePageMeta x
@ -190,6 +195,6 @@ htagRenderMetaWithSubtags makeLink extraMeta subtagMeta htag = do
m <- subtagMeta x m <- subtagMeta x
pure (joinPath x, m) pure (joinPath x, m)
subtagMetas <- subtagMetas <-
Y.array . filter (/= Y.Null) . map snd . sortOn (uncurry toSortKey) <$> Y.array . filter (/= Y.Null) . map snd . sortOn (uncurry toSortKey)
traverse metaPair subtags <$> traverse metaPair subtags
pure $ meta `objMerge` Y.object [("subtags", subtagMetas)] `objMerge` em pure $ meta `objMerge` Y.object [("subtags", subtagMetas)] `objMerge` em

172
Types.hs
View file

@ -32,19 +32,16 @@ import qualified Text.Mustache as Mu
import qualified Text.Pandoc.Definition import qualified Text.Pandoc.Definition
-- | Information about a single deployed page (with metadata etc). -- | Information about a single deployed page (with metadata etc).
data PageInfo = data PageInfo = PageInfo
PageInfo
{ _pagePath :: FilePath -- ^ original path to the markdown file { _pagePath :: FilePath -- ^ original path to the markdown file
, _pageMeta :: Y.Value -- ^ YAML metadata extracted from the file , _pageMeta :: Y.Value -- ^ YAML metadata extracted from the file
, _pageDoc :: Text.Pandoc.Definition.Pandoc -- ^ Page data , _pageDoc :: Text.Pandoc.Definition.Pandoc -- ^ Page data
} } deriving (Show)
deriving (Show)
makeLenses ''PageInfo makeLenses ''PageInfo
-- | Complete internal state of the deployment process that holds all data -- | Complete internal state of the deployment process that holds all data
data SiteState = data SiteState = SiteState
SiteState
{ _pages :: M.Map FilePath PageInfo -- ^ Map of page mounts to `PageInfo` { _pages :: M.Map FilePath PageInfo -- ^ Map of page mounts to `PageInfo`
, _redirects :: M.Map FilePath FilePath -- ^ Map of redirects (from -> to) , _redirects :: M.Map FilePath FilePath -- ^ Map of redirects (from -> to)
, _htags :: M.Map [String] [FilePath] -- ^ Map of tags, assigning to each tag sequence a list of tagged page mounts , _htags :: M.Map [String] [FilePath] -- ^ Map of tags, assigning to each tag sequence a list of tagged page mounts
@ -70,8 +67,7 @@ data SiteState =
, _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 filenames to all page URLs , _appendUrlIndex :: Bool -- ^ Append full index filenames to all page URLs
, _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes. , _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes.
} } deriving (Show)
deriving (Show)
makeLenses ''SiteState makeLenses ''SiteState
@ -82,98 +78,116 @@ type Site a = StateT SiteState IO a
siteOptions' :: Parser SiteState siteOptions' :: Parser SiteState
siteOptions' = do siteOptions' = do
_outputDir <- _outputDir <-
strOption $ strOption
long "output" <> $ long "output"
short 'd' <> <> short 'd'
help "Directory to render the site to" <> value "_site" <> showDefault <> help "Directory to render the site to"
<> value "_site"
<> showDefault
_searchDataOut <- _searchDataOut <-
Just <$> Just
(strOption $ <$> (strOption
long "search-data-output" <> $ long "search-data-output"
help "Output JSON with searchable page data to this file") <|> <> help "Output JSON with searchable page data to this file")
pure Nothing <|> pure Nothing
_assetDirs <- _assetDirs <-
many . strOption $ many . strOption
long "assets" <> $ long "assets"
short 'a' <> <> short 'a'
help "Assets directory to be copied verbatim (possibly multiple paths)" <> help
"Assets directory to be copied verbatim (possibly multiple paths)"
_sourceDirs <- _sourceDirs <-
many . strOption $ many . strOption
long "source-directory" <> $ long "source-directory"
short 's' <> <> short 's'
help "Path to the directory with source data (possibly multiple paths)" <> help
"Path to the directory with source data (possibly multiple paths)"
_notSourceDirs <- _notSourceDirs <-
many . strOption $ many . strOption
long "exclude-source-directory" <> $ long "exclude-source-directory"
help <> help
"Names of subdirectories of the sources that should never be used for sourcing pages (possibly multiple directory names)" "Names of subdirectories of the sources that should never be used for sourcing pages (possibly multiple directory names)"
_tagMetaFile <- _tagMetaFile <-
strOption $ strOption
long "tag-metadata-file" <> $ long "tag-metadata-file"
help "Name of files with tag metadata" <> <> help "Name of files with tag metadata"
value "tag-metadata.yml" <> showDefault <> value "tag-metadata.yml"
<> showDefault
_templateDir <- _templateDir <-
strOption $ strOption
long "template-directory" <> $ long "template-directory"
help "Path to the directory with templates" <> <> help "Path to the directory with templates"
value "templates" <> showDefault <> value "templates"
<> showDefault
_defaultTemplate <- _defaultTemplate <-
strOption $ strOption
long "default-template" <> $ long "default-template"
help "Default template to use for stuff (as found in templates directory)" <> <> help
value "default.html" <> showDefault "Default template to use for stuff (as found in templates directory)"
<> value "default.html"
<> showDefault
_redirectTemplate <- _redirectTemplate <-
strOption $ strOption
long "redirect-template" <> $ long "redirect-template"
help "Template for making redirect pages" <> <> help "Template for making redirect pages"
value "redirect.html" <> showDefault <> value "redirect.html"
<> showDefault
_tagTemplate <- _tagTemplate <-
strOption $ strOption
long "tag-template" <> $ long "tag-template"
help "Template for making category view pages" <> <> help "Template for making category view pages"
value "tag.html" <> showDefault <> value "tag.html"
<> showDefault
_listTemplate <- _listTemplate <-
strOption $ strOption
long "list-template" <> $ long "list-template"
help "Template for making tag-listing pages" <> <> help "Template for making tag-listing pages"
value "list.html" <> showDefault <> value "list.html"
<> showDefault
_metadataSuffix <- _metadataSuffix <-
strOption $ strOption
long "metadata-suffix" <> $ long "metadata-suffix"
help <> help
"Suffix for YAML files with base metadata for each markdown page. Metadata from files override the extra metadata specified on commandline, but are overridden by metadata specified directly in the markdown header of the pages." <> "Suffix for YAML files with base metadata for each markdown page. Metadata from files override the extra metadata specified on commandline, but are overridden by metadata specified directly in the markdown header of the pages."
value ".metadata.yml" <> showDefault <> value ".metadata.yml"
<> showDefault
_extraMeta <- _extraMeta <-
let processKeyVal :: String -> Y.Value let processKeyVal :: String -> Y.Value
processKeyVal opt = processKeyVal opt =
case Y.decodeEither' $ Data.ByteString.UTF8.fromString opt of case Y.decodeEither' $ Data.ByteString.UTF8.fromString opt of
Right v -> v Right v -> v
Left err -> Left err ->
error $ error
"cannot parse YAML in --extra-metadata: " ++ $ "cannot parse YAML in --extra-metadata: "
Y.prettyPrintParseException err ++ Y.prettyPrintParseException err
in fmap (foldl objMerge Y.Null . map processKeyVal) . many . strOption $ in fmap (foldl objMerge Y.Null . map processKeyVal) . many . strOption
long "extra-metadata" <> $ long "extra-metadata"
help <> help
"Extra metadata to add to pages rendering in YAML format. May be specified multiple times." "Extra metadata to add to pages rendering in YAML format. May be specified multiple times."
_urlBase <- _urlBase <-
strOption $ strOption
long "url-base" <> $ long "url-base"
short 'u' <> help "Base absolute URL" <> value "/" <> showDefault <> short 'u'
<> help "Base absolute URL"
<> value "/"
<> showDefault
_indexFile <- _indexFile <-
strOption $ strOption
long "index-filename" <> $ long "index-filename"
help "Base absolute URL" <> value "index.html" <> showDefault <> help "Base absolute URL"
<> value "index.html"
<> showDefault
_appendUrlIndex <- _appendUrlIndex <-
switch $ switch
long "append-url-index" <> $ long "append-url-index"
help <> help
"Append 'index.html' to all urls, negating server problems with directory index settings." "Append 'index.html' to all urls, negating server problems with directory index settings."
_dumpFinalState <- _dumpFinalState <-
switch $ switch
long "dump-state" <> $ long "dump-state"
short 'D' <> <> short 'D'
help "Print out the complete internal state after the site is built" <> help
"Print out the complete internal state after the site is built"
pure pure
SiteState SiteState
{ _pages = M.empty { _pages = M.empty
@ -191,6 +205,6 @@ siteOptions' = do
siteOptions = siteOptions =
info info
(siteOptions' <**> helper) (siteOptions' <**> helper)
(fullDesc <> (fullDesc
progDesc "Build a R3 static site" <> <> progDesc "Build a R3 static site"
header "reploy - the R3 static site builder") <> header "reploy - the R3 static site builder")

12
Utils.hs
View file

@ -75,8 +75,12 @@ addHeadingLinks cls = Text.Pandoc.Walk.walk go
Header Header
lvl lvl
attr attr
(inlines ++ (inlines
[Link ("", [cls], []) [Str "#"] ("#" <> id, "Link to this section")]) ++ [ Link
("", [cls], [])
[Str "#"]
("#" <> id, "Link to this section")
])
go x = x go x = x
-- | @"https://example.com" `hasUriScheme` "https"@ -- | @"https://example.com" `hasUriScheme` "https"@
@ -132,8 +136,8 @@ sourcePaths fp process = do
| null ds = False | null ds = False
| last ds `elem` notSource = True | last ds `elem` notSource = True
| otherwise = False | otherwise = False
io (getRecursiveContents (pure . ignoreDir . splitDirectories) fp) >>= io (getRecursiveContents (pure . ignoreDir . splitDirectories) fp)
foldMapM process >>= foldMapM process
-- | Given a path to a file, try to make the path writable by making all -- | Given a path to a file, try to make the path writable by making all
-- directories on the path. (Interned from Hakyll.) -- directories on the path. (Interned from Hakyll.)

98
reploy.hs
View file

@ -81,8 +81,8 @@ loadPage fp = do
io $ putStrLn $ "P <- " ++ fp io $ putStrLn $ "P <- " ++ fp
txt <- io $ TIO.readFile fp txt <- io $ TIO.readFile fp
{- tear out the metadata manually -} {- tear out the metadata manually -}
(T.take 4 txt == "---\n") `unless` (T.take 4 txt == "---\n")
error ("metadata block start missing in " ++ fp) `unless` error ("metadata block start missing in " ++ fp)
let (meta, markdown) = T.breakOn "\n---\n" (T.drop 4 txt) let (meta, markdown) = T.breakOn "\n---\n" (T.drop 4 txt)
T.null meta `when` error ("metadata block bad in " ++ fp) T.null meta `when` error ("metadata block bad in " ++ fp)
{- parse everything -} {- parse everything -}
@ -90,17 +90,16 @@ loadPage fp = do
md <- io $ runIOorExplode $ readMarkdown markdownReadOpts (T.drop 5 markdown) md <- io $ runIOorExplode $ readMarkdown markdownReadOpts (T.drop 5 markdown)
{- find the main mount point for the page -} {- find the main mount point for the page -}
let mount = let mount =
unAbsolute . T.unpack . just ("mount point of " ++ fp) $ yml ^? unAbsolute . T.unpack . just ("mount point of " ++ fp)
key "mount" . $ yml ^? key "mount" . _String
_String
existing <- use $ pages . to (M.!? mount) existing <- use $ pages . to (M.!? mount)
case existing of case existing of
Just pi -> Just pi ->
error $ "mount for " ++ fp ++ " already exists from " ++ _pagePath pi error $ "mount for " ++ fp ++ " already exists from " ++ _pagePath pi
_ -> pure () _ -> pure ()
{- save to the state -} {- save to the state -}
pages %= pages
M.insert mount PageInfo {_pagePath = fp, _pageMeta = yml, _pageDoc = md} %= M.insert mount PageInfo {_pagePath = fp, _pageMeta = yml, _pageDoc = md}
-- | Find which template to use for rendering a page. -- | Find which template to use for rendering a page.
pageTemplate :: PageInfo -> Site FilePath pageTemplate :: PageInfo -> Site FilePath
@ -114,8 +113,8 @@ pageTemplates = do
rt <- use redirectTemplate rt <- use redirectTemplate
tt <- use tagTemplate tt <- use tagTemplate
lt <- use listTemplate lt <- use listTemplate
nub . ([rt, tt, lt] ++) <$> nub . ([rt, tt, lt] ++)
(gets (^.. pages . traverse) >>= traverse pageTemplate) <$> (gets (^.. pages . traverse) >>= traverse pageTemplate)
-- | Compile a single template in a directory -- | Compile a single template in a directory
compileTemplate :: compileTemplate ::
@ -180,8 +179,8 @@ rootedLink = (<*>) rootedLink' . pure
-- | Process a single link pointing out from a page. -- | Process a single link pointing out from a page.
processLink :: FilePath -> FilePath -> Site String processLink :: FilePath -> FilePath -> Site String
processLink base l = processLink base l =
if any (l `hasUriScheme`) ["http", "https", "ftp", "mailto"] || take 1 l == if any (l `hasUriScheme`) ["http", "https", "ftp", "mailto"]
"#" || take 1 l == "#"
then pure l then pure l
else if isAbsolute l else if isAbsolute l
then rootedPageLink l then rootedPageLink l
@ -203,8 +202,9 @@ addGlobalMeta meta = do
rtp <- rootedPageLink' rtp <- rootedPageLink'
Y.Object m <- (`objMerge` meta) <$> use extraMeta Y.Object m <- (`objMerge` meta) <$> 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
[ ("root", Mu.toMustache $ T.pack r) $ l
++ [ ("root", Mu.toMustache $ T.pack r)
, ("rawRootUrl", Mu.overText $ T.pack . rt . T.unpack) , ("rawRootUrl", Mu.overText $ T.pack . rt . T.unpack)
, ("pageLink", Mu.overText $ T.pack . rtp . T.unpack) , ("pageLink", Mu.overText $ T.pack . rtp . T.unpack)
] ]
@ -226,8 +226,11 @@ addExtraMeta pi m = do
em' <- io $ Y.decodeFileEither metaPath em' <- io $ Y.decodeFileEither metaPath
case em' of case em' of
Left pe -> Left pe ->
error $ "decoding " ++ metaPath ++ " failed: " ++ error
Y.prettyPrintParseException pe $ "decoding "
++ metaPath
++ " failed: "
++ Y.prettyPrintParseException pe
Right em -> pure $ objMerge em m Right em -> pure $ objMerge em m
else pure m else pure m
@ -237,11 +240,13 @@ addExtraMeta pi m = do
addPageMeta :: PageInfo -> Y.Value -> Site Y.Value addPageMeta :: PageInfo -> Y.Value -> Site Y.Value
addPageMeta pi (Y.Object m) = do addPageMeta pi (Y.Object m) = do
htagMeta <- htagMeta <-
traverse (htagRenderMeta tagLink) . sort $ pi ^.. pageMeta . key "tags" . traverse (htagRenderMeta tagLink) . sort
values . $ pi ^.. pageMeta
_String . . key "tags"
to T.unpack . . values
to splitTag . _String
. to T.unpack
. to splitTag
addExtraMeta pi . Y.Object $ KM.insert "htags" (Y.array htagMeta) m addExtraMeta pi . Y.Object $ KM.insert "htags" (Y.array htagMeta) m
-- | If viable for a page (by config), add the TOC field -- | If viable for a page (by config), add the TOC field
@ -249,12 +254,16 @@ addTOC :: PageInfo -> Text.Pandoc.Definition.Pandoc -> Y.Value -> Site Y.Value
addTOC pi doc meta@(Y.Object meta') = addTOC pi doc meta@(Y.Object meta') =
let go n = do let go n = do
toc <- toc <-
io . runIOorExplode $ writeHtml5String htmlWriteOpts $ io . runIOorExplode
withPandocBlocks (pure . toTableOfContents (tocWriteOpts n)) doc $ writeHtml5String htmlWriteOpts
$ withPandocBlocks (pure . toTableOfContents (tocWriteOpts n)) doc
pure . Y.Object $ KM.insert "toc" (Y.String toc) meta' pure . Y.Object $ KM.insert "toc" (Y.String toc) meta'
in case ( pi ^? pageMeta . key "toc" . _Bool in case ( pi ^? pageMeta . key "toc" . _Bool
, join $ pi ^? pageMeta . key "toc" . _Number . , join
to Data.Scientific.toBoundedInteger) of $ pi ^? pageMeta
. key "toc"
. _Number
. to Data.Scientific.toBoundedInteger) of
(Just False, _) -> pure meta (Just False, _) -> pure meta
(_, Nothing) -> go (3 :: Int) (_, Nothing) -> go (3 :: Int)
(_, Just n) -> go n (_, Just n) -> go n
@ -269,8 +278,9 @@ installPage mount pi = do
walkURLs (processLink $ pi ^. pagePath . to takeDirectory) $ pi ^. pageDoc walkURLs (processLink $ pi ^. pagePath . to takeDirectory) $ pi ^. pageDoc
checkTarget file checkTarget file
body <- body <-
io . runIOorExplode $ writeHtml5String htmlWriteOpts $ io . runIOorExplode
addHeadingLinks "header-local-anchor" fixedUrlDoc $ writeHtml5String htmlWriteOpts
$ addHeadingLinks "header-local-anchor" fixedUrlDoc
let Y.Object meta' = pi ^. pageMeta let Y.Object meta' = pi ^. pageMeta
meta = Y.Object $ KM.insert "body" (Y.String body) meta' meta = Y.Object $ KM.insert "body" (Y.String body) meta'
meta <- addTOC pi fixedUrlDoc meta >>= addPageMeta pi >>= addGlobalMeta meta <- addTOC pi fixedUrlDoc meta >>= addPageMeta pi >>= addGlobalMeta
@ -292,8 +302,8 @@ installRedirect target' from = do
putStrLn $ "@ -> " ++ file ++ " -> " ++ target putStrLn $ "@ -> " ++ file ++ " -> " ++ target
makeDirectories file makeDirectories file
txt <- txt <-
checkedSubstitute templ $ checkedSubstitute templ
Mu.object [("target", Mu.toMustache $ T.pack target)] $ Mu.object [("target", Mu.toMustache $ T.pack target)]
TIO.writeFile file txt TIO.writeFile file txt
-- | Install all redirects required by one page. -- | Install all redirects required by one page.
@ -347,8 +357,8 @@ installAsset ad fp = do
-- | Copy all files from a given asset directory. -- | Copy all files from a given asset directory.
installAssetDir :: FilePath -> Site () installAssetDir :: FilePath -> Site ()
installAssetDir ad = installAssetDir ad =
io (getRecursiveContents (pure . const False) ad) >>= io (getRecursiveContents (pure . const False) ad)
traverse_ (installAsset ad) >>= traverse_ (installAsset ad)
-- | Copy all files from the asset directories. -- | Copy all files from the asset directories.
installAssets :: Site () installAssets :: Site ()
@ -375,8 +385,8 @@ makePageLinkRenderMeta :: FilePath -> Site Y.Value
makePageLinkRenderMeta mount = do makePageLinkRenderMeta mount = do
link <- rootedPageLink mount link <- rootedPageLink mount
meta <- use $ pages . to (M.! mount) . pageMeta meta <- use $ pages . to (M.! mount) . pageMeta
pure $ pure
Y.object $ Y.object
[("mount", fromString mount), ("href", fromString link), ("meta", meta)] [("mount", fromString mount), ("href", fromString link), ("meta", meta)]
wrapPagesMeta :: Y.Value -> String -> FilePath -> Y.Value wrapPagesMeta :: Y.Value -> String -> FilePath -> Y.Value
@ -424,15 +434,23 @@ renderListing templName fileName makeMeta mark htag = do
renderTags = do renderTags = do
lt <- use tagTemplate lt <- use tagTemplate
M.keys <$> use ehtags >>= M.keys <$> use ehtags
traverse_ >>= traverse_
(renderListing lt tagFilename (makeTagRenderMeta >=> addGlobalMeta) "#") (renderListing
lt
tagFilename
(makeTagRenderMeta >=> addGlobalMeta)
"#")
renderLists = do renderLists = do
lt <- use listTemplate lt <- use listTemplate
M.keys <$> use ehtags >>= M.keys <$> use ehtags
traverse_ >>= traverse_
(renderListing lt listFilename (makeListRenderMeta >=> addGlobalMeta) "*") (renderListing
lt
listFilename
(makeListRenderMeta >=> addGlobalMeta)
"*")
-- | Transform one mounted PageInfo to the base search data -- | Transform one mounted PageInfo to the base search data
makeSearchData :: FilePath -> PageInfo -> Site [Y.Value] makeSearchData :: FilePath -> PageInfo -> Site [Y.Value]
@ -447,8 +465,8 @@ makeSearchData mount pi = do
let tagarray = Y.array . map (Y.array . map fromString) $ tagnames let tagarray = Y.array . map (Y.array . map fromString) $ tagnames
if pi ^? pageMeta . key "search" . _Bool == Just False -- `off` gets parsed as bool if pi ^? pageMeta . key "search" . _Bool == Just False -- `off` gets parsed as bool
then pure [] then pure []
else pure $ else pure
[ Y.object $ [ Y.object
[ ("link", fromString link) [ ("link", fromString link)
, ("name", maybe (fromString mount) Y.String name) , ("name", maybe (fromString mount) Y.String name)
, ("tags", tagarray) , ("tags", tagarray)