reformat using new hindent (cuteness +63)
This commit is contained in:
parent
56dcda5619
commit
e2cec0c7a7
|
@ -23,12 +23,12 @@ import Text.Pandoc.Options
|
|||
markdownReadOpts =
|
||||
def
|
||||
{ readerExtensions =
|
||||
Text.Pandoc.Extensions.extensionsFromList $
|
||||
Text.Pandoc.Extensions.extensionsToList
|
||||
Text.Pandoc.Extensions.pandocExtensions ++
|
||||
[ Text.Pandoc.Extensions.Ext_smart
|
||||
, Ext_lists_without_preceding_blankline
|
||||
]
|
||||
Text.Pandoc.Extensions.extensionsFromList
|
||||
$ Text.Pandoc.Extensions.extensionsToList
|
||||
Text.Pandoc.Extensions.pandocExtensions
|
||||
++ [ Text.Pandoc.Extensions.Ext_smart
|
||||
, Ext_lists_without_preceding_blankline
|
||||
]
|
||||
}
|
||||
|
||||
-- | Default HTML writing options for Pandoc.
|
||||
|
|
55
Tags.hs
55
Tags.hs
|
@ -44,8 +44,10 @@ sourceTagMetaFile fp = do
|
|||
case yml' of
|
||||
Left err ->
|
||||
error
|
||||
("Failed to load tag metadata from " ++ fp ++ ": " ++
|
||||
Y.prettyPrintParseException err)
|
||||
("Failed to load tag metadata from "
|
||||
++ fp
|
||||
++ ": "
|
||||
++ Y.prettyPrintParseException err)
|
||||
Right yml -> traverse_ go (KM.toList yml)
|
||||
where go :: (KM.Key, Y.Value) -> Site ()
|
||||
go (k, v') =
|
||||
|
@ -61,8 +63,10 @@ sourceTagMetaFile fp = do
|
|||
| v == ov = Just ov
|
||||
| otherwise =
|
||||
error
|
||||
("conflicting tag metadata for tag " ++ ks ++ " in " ++
|
||||
fp)
|
||||
("conflicting tag metadata for tag "
|
||||
++ ks
|
||||
++ " in "
|
||||
++ fp)
|
||||
ins Nothing = Just v
|
||||
in tagMeta %= M.alter ins kx
|
||||
|
||||
|
@ -87,10 +91,11 @@ sourceTags :: Site ()
|
|||
sourceTags = do
|
||||
sgat <-
|
||||
map
|
||||
(second $ map splitTag .
|
||||
(^.. pageMeta . key "tags" . values . _String . to T.unpack)) .
|
||||
M.assocs <$>
|
||||
use pages
|
||||
(second
|
||||
$ map splitTag
|
||||
. (^.. pageMeta . key "tags" . values . _String . to T.unpack))
|
||||
. M.assocs
|
||||
<$> use pages
|
||||
ehtags .= M.fromList (invExpandTags sgat)
|
||||
htags .= M.fromList (invTags sgat)
|
||||
|
||||
|
@ -115,19 +120,19 @@ htagRenderMeta makeLink htag = do
|
|||
links <- map fromString <$> traverse makeLink htags
|
||||
names <- map fromString <$> traverse getTagGroupName htags
|
||||
metas <- traverse htagMeta htags
|
||||
pure $
|
||||
Y.object
|
||||
[ ("href", last links)
|
||||
, ("name", last names)
|
||||
, ("meta", last metas)
|
||||
, ( "htag"
|
||||
, Y.array $
|
||||
zipWith3
|
||||
(\l n m -> Y.object [("href", l), ("name", n), ("meta", m)])
|
||||
links
|
||||
names
|
||||
metas)
|
||||
]
|
||||
pure
|
||||
$ Y.object
|
||||
[ ("href", last links)
|
||||
, ("name", last names)
|
||||
, ("meta", last metas)
|
||||
, ( "htag"
|
||||
, Y.array
|
||||
$ zipWith3
|
||||
(\l n m -> Y.object [("href", l), ("name", n), ("meta", m)])
|
||||
links
|
||||
names
|
||||
metas)
|
||||
]
|
||||
|
||||
data SortKey num
|
||||
= Negative num
|
||||
|
@ -151,8 +156,8 @@ genericTaggedPagesRenderMeta ::
|
|||
-> M.Map [String] [FilePath]
|
||||
-> Site Y.Value
|
||||
genericTaggedPagesRenderMeta makePageMeta htag tagmap =
|
||||
Y.array . map snd . sortOn (uncurry toSortKey) <$>
|
||||
traverse metaPair (maybe [] id $ tagmap M.!? htag)
|
||||
Y.array . map snd . sortOn (uncurry toSortKey)
|
||||
<$> traverse metaPair (maybe [] id $ tagmap M.!? htag)
|
||||
where
|
||||
metaPair x = do
|
||||
m <- makePageMeta x
|
||||
|
@ -190,6 +195,6 @@ htagRenderMetaWithSubtags makeLink extraMeta subtagMeta htag = do
|
|||
m <- subtagMeta x
|
||||
pure (joinPath x, m)
|
||||
subtagMetas <-
|
||||
Y.array . filter (/= Y.Null) . map snd . sortOn (uncurry toSortKey) <$>
|
||||
traverse metaPair subtags
|
||||
Y.array . filter (/= Y.Null) . map snd . sortOn (uncurry toSortKey)
|
||||
<$> traverse metaPair subtags
|
||||
pure $ meta `objMerge` Y.object [("subtags", subtagMetas)] `objMerge` em
|
||||
|
|
234
Types.hs
234
Types.hs
|
@ -32,46 +32,42 @@ import qualified Text.Mustache as Mu
|
|||
import qualified Text.Pandoc.Definition
|
||||
|
||||
-- | Information about a single deployed page (with metadata etc).
|
||||
data PageInfo =
|
||||
PageInfo
|
||||
{ _pagePath :: FilePath -- ^ original path to the markdown file
|
||||
, _pageMeta :: Y.Value -- ^ YAML metadata extracted from the file
|
||||
, _pageDoc :: Text.Pandoc.Definition.Pandoc -- ^ Page data
|
||||
}
|
||||
deriving (Show)
|
||||
data PageInfo = PageInfo
|
||||
{ _pagePath :: FilePath -- ^ original path to the markdown file
|
||||
, _pageMeta :: Y.Value -- ^ YAML metadata extracted from the file
|
||||
, _pageDoc :: Text.Pandoc.Definition.Pandoc -- ^ Page data
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''PageInfo
|
||||
|
||||
-- | Complete internal state of the deployment process that holds all data
|
||||
data SiteState =
|
||||
SiteState
|
||||
{ _pages :: M.Map FilePath PageInfo -- ^ Map of page mounts to `PageInfo`
|
||||
, _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
|
||||
, _ehtags :: M.Map [String] [FilePath] -- ^ Map of tags, assigning to each tag sequence a list of tagged page mounts. This one is expanded (tags imply parent categories).
|
||||
, _tagMeta :: M.Map [String] Y.Value -- ^ Map of tags to expanded human-friendly names
|
||||
, _installs :: S.Set (String, FilePath) -- ^ List of copy-installed files (among other, this enables sharing)
|
||||
, _targets :: S.Set FilePath -- ^ List of files installed to the target site (this allows us to throw an error in case anything would write to the same target twice)
|
||||
, _templates :: M.Map FilePath Mu.Template -- ^ Map of Mustache templates organized by template search path (within the template directory)
|
||||
, _outputDir :: FilePath -- ^ Directory for output
|
||||
, _searchDataOut :: Maybe FilePath -- ^ File to write the searchable versions of pages to (as JSON)
|
||||
, _assetDirs :: [FilePath] -- ^ Directory for output
|
||||
, _sourceDirs :: [FilePath] -- ^ Path to page source data
|
||||
, _notSourceDirs :: [FilePath] -- ^ Subdirectories of source dirs where pages should not be sourced
|
||||
, _tagMetaFile :: FilePath -- ^ Name of the "tag metadata" files to find in the source directories.
|
||||
, _templateDir :: FilePath -- ^ Path to template directory
|
||||
, _defaultTemplate :: FilePath -- ^ Name of the default template
|
||||
, _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 :: Y.Value -- ^ Extra metadata added to rendering of all templates
|
||||
, _metadataSuffix :: FilePath -- ^ File suffix to search for a extra metadata (e.g., if the suffix is ".extra", the extra metadata for file "page.md" will be looked for in "page.md.extra"). These are best autogenerated with a script that sources the data from git or so.
|
||||
, _indexFile :: FilePath -- ^ Name of the "index" files to be generated.
|
||||
, _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links.
|
||||
, _appendUrlIndex :: Bool -- ^ Append full index filenames to all page URLs
|
||||
, _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes.
|
||||
}
|
||||
deriving (Show)
|
||||
data SiteState = SiteState
|
||||
{ _pages :: M.Map FilePath PageInfo -- ^ Map of page mounts to `PageInfo`
|
||||
, _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
|
||||
, _ehtags :: M.Map [String] [FilePath] -- ^ Map of tags, assigning to each tag sequence a list of tagged page mounts. This one is expanded (tags imply parent categories).
|
||||
, _tagMeta :: M.Map [String] Y.Value -- ^ Map of tags to expanded human-friendly names
|
||||
, _installs :: S.Set (String, FilePath) -- ^ List of copy-installed files (among other, this enables sharing)
|
||||
, _targets :: S.Set FilePath -- ^ List of files installed to the target site (this allows us to throw an error in case anything would write to the same target twice)
|
||||
, _templates :: M.Map FilePath Mu.Template -- ^ Map of Mustache templates organized by template search path (within the template directory)
|
||||
, _outputDir :: FilePath -- ^ Directory for output
|
||||
, _searchDataOut :: Maybe FilePath -- ^ File to write the searchable versions of pages to (as JSON)
|
||||
, _assetDirs :: [FilePath] -- ^ Directory for output
|
||||
, _sourceDirs :: [FilePath] -- ^ Path to page source data
|
||||
, _notSourceDirs :: [FilePath] -- ^ Subdirectories of source dirs where pages should not be sourced
|
||||
, _tagMetaFile :: FilePath -- ^ Name of the "tag metadata" files to find in the source directories.
|
||||
, _templateDir :: FilePath -- ^ Path to template directory
|
||||
, _defaultTemplate :: FilePath -- ^ Name of the default template
|
||||
, _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 :: Y.Value -- ^ Extra metadata added to rendering of all templates
|
||||
, _metadataSuffix :: FilePath -- ^ File suffix to search for a extra metadata (e.g., if the suffix is ".extra", the extra metadata for file "page.md" will be looked for in "page.md.extra"). These are best autogenerated with a script that sources the data from git or so.
|
||||
, _indexFile :: FilePath -- ^ Name of the "index" files to be generated.
|
||||
, _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links.
|
||||
, _appendUrlIndex :: Bool -- ^ Append full index filenames to all page URLs
|
||||
, _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes.
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''SiteState
|
||||
|
||||
|
@ -82,98 +78,116 @@ type Site a = StateT SiteState IO a
|
|||
siteOptions' :: Parser SiteState
|
||||
siteOptions' = do
|
||||
_outputDir <-
|
||||
strOption $
|
||||
long "output" <>
|
||||
short 'd' <>
|
||||
help "Directory to render the site to" <> value "_site" <> showDefault
|
||||
strOption
|
||||
$ long "output"
|
||||
<> short 'd'
|
||||
<> help "Directory to render the site to"
|
||||
<> value "_site"
|
||||
<> showDefault
|
||||
_searchDataOut <-
|
||||
Just <$>
|
||||
(strOption $
|
||||
long "search-data-output" <>
|
||||
help "Output JSON with searchable page data to this file") <|>
|
||||
pure Nothing
|
||||
Just
|
||||
<$> (strOption
|
||||
$ long "search-data-output"
|
||||
<> help "Output JSON with searchable page data to this file")
|
||||
<|> pure Nothing
|
||||
_assetDirs <-
|
||||
many . strOption $
|
||||
long "assets" <>
|
||||
short 'a' <>
|
||||
help "Assets directory to be copied verbatim (possibly multiple paths)"
|
||||
many . strOption
|
||||
$ long "assets"
|
||||
<> short 'a'
|
||||
<> help
|
||||
"Assets directory to be copied verbatim (possibly multiple paths)"
|
||||
_sourceDirs <-
|
||||
many . strOption $
|
||||
long "source-directory" <>
|
||||
short 's' <>
|
||||
help "Path to the directory with source data (possibly multiple paths)"
|
||||
many . strOption
|
||||
$ long "source-directory"
|
||||
<> short 's'
|
||||
<> help
|
||||
"Path to the directory with source data (possibly multiple paths)"
|
||||
_notSourceDirs <-
|
||||
many . strOption $
|
||||
long "exclude-source-directory" <>
|
||||
help
|
||||
"Names of subdirectories of the sources that should never be used for sourcing pages (possibly multiple directory names)"
|
||||
many . strOption
|
||||
$ long "exclude-source-directory"
|
||||
<> help
|
||||
"Names of subdirectories of the sources that should never be used for sourcing pages (possibly multiple directory names)"
|
||||
_tagMetaFile <-
|
||||
strOption $
|
||||
long "tag-metadata-file" <>
|
||||
help "Name of files with tag metadata" <>
|
||||
value "tag-metadata.yml" <> showDefault
|
||||
strOption
|
||||
$ long "tag-metadata-file"
|
||||
<> help "Name of files with tag metadata"
|
||||
<> value "tag-metadata.yml"
|
||||
<> showDefault
|
||||
_templateDir <-
|
||||
strOption $
|
||||
long "template-directory" <>
|
||||
help "Path to the directory with templates" <>
|
||||
value "templates" <> showDefault
|
||||
strOption
|
||||
$ long "template-directory"
|
||||
<> help "Path to the directory with templates"
|
||||
<> value "templates"
|
||||
<> showDefault
|
||||
_defaultTemplate <-
|
||||
strOption $
|
||||
long "default-template" <>
|
||||
help "Default template to use for stuff (as found in templates directory)" <>
|
||||
value "default.html" <> showDefault
|
||||
strOption
|
||||
$ long "default-template"
|
||||
<> help
|
||||
"Default template to use for stuff (as found in templates directory)"
|
||||
<> value "default.html"
|
||||
<> showDefault
|
||||
_redirectTemplate <-
|
||||
strOption $
|
||||
long "redirect-template" <>
|
||||
help "Template for making redirect pages" <>
|
||||
value "redirect.html" <> showDefault
|
||||
strOption
|
||||
$ long "redirect-template"
|
||||
<> help "Template for making redirect pages"
|
||||
<> value "redirect.html"
|
||||
<> showDefault
|
||||
_tagTemplate <-
|
||||
strOption $
|
||||
long "tag-template" <>
|
||||
help "Template for making category view pages" <>
|
||||
value "tag.html" <> showDefault
|
||||
strOption
|
||||
$ long "tag-template"
|
||||
<> help "Template for making category view pages"
|
||||
<> value "tag.html"
|
||||
<> showDefault
|
||||
_listTemplate <-
|
||||
strOption $
|
||||
long "list-template" <>
|
||||
help "Template for making tag-listing pages" <>
|
||||
value "list.html" <> showDefault
|
||||
strOption
|
||||
$ long "list-template"
|
||||
<> help "Template for making tag-listing pages"
|
||||
<> value "list.html"
|
||||
<> showDefault
|
||||
_metadataSuffix <-
|
||||
strOption $
|
||||
long "metadata-suffix" <>
|
||||
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." <>
|
||||
value ".metadata.yml" <> showDefault
|
||||
strOption
|
||||
$ long "metadata-suffix"
|
||||
<> 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."
|
||||
<> value ".metadata.yml"
|
||||
<> showDefault
|
||||
_extraMeta <-
|
||||
let processKeyVal :: String -> Y.Value
|
||||
processKeyVal opt =
|
||||
case Y.decodeEither' $ Data.ByteString.UTF8.fromString opt of
|
||||
Right v -> v
|
||||
Left err ->
|
||||
error $
|
||||
"cannot parse YAML in --extra-metadata: " ++
|
||||
Y.prettyPrintParseException err
|
||||
in fmap (foldl objMerge Y.Null . map processKeyVal) . many . strOption $
|
||||
long "extra-metadata" <>
|
||||
help
|
||||
"Extra metadata to add to pages rendering in YAML format. May be specified multiple times."
|
||||
error
|
||||
$ "cannot parse YAML in --extra-metadata: "
|
||||
++ Y.prettyPrintParseException err
|
||||
in fmap (foldl objMerge Y.Null . map processKeyVal) . many . strOption
|
||||
$ long "extra-metadata"
|
||||
<> help
|
||||
"Extra metadata to add to pages rendering in YAML format. May be specified multiple times."
|
||||
_urlBase <-
|
||||
strOption $
|
||||
long "url-base" <>
|
||||
short 'u' <> help "Base absolute URL" <> value "/" <> showDefault
|
||||
strOption
|
||||
$ long "url-base"
|
||||
<> short 'u'
|
||||
<> help "Base absolute URL"
|
||||
<> value "/"
|
||||
<> showDefault
|
||||
_indexFile <-
|
||||
strOption $
|
||||
long "index-filename" <>
|
||||
help "Base absolute URL" <> value "index.html" <> showDefault
|
||||
strOption
|
||||
$ long "index-filename"
|
||||
<> help "Base absolute URL"
|
||||
<> value "index.html"
|
||||
<> showDefault
|
||||
_appendUrlIndex <-
|
||||
switch $
|
||||
long "append-url-index" <>
|
||||
help
|
||||
"Append 'index.html' to all urls, negating server problems with directory index settings."
|
||||
switch
|
||||
$ long "append-url-index"
|
||||
<> help
|
||||
"Append 'index.html' to all urls, negating server problems with directory index settings."
|
||||
_dumpFinalState <-
|
||||
switch $
|
||||
long "dump-state" <>
|
||||
short 'D' <>
|
||||
help "Print out the complete internal state after the site is built"
|
||||
switch
|
||||
$ long "dump-state"
|
||||
<> short 'D'
|
||||
<> help
|
||||
"Print out the complete internal state after the site is built"
|
||||
pure
|
||||
SiteState
|
||||
{ _pages = M.empty
|
||||
|
@ -191,6 +205,6 @@ siteOptions' = do
|
|||
siteOptions =
|
||||
info
|
||||
(siteOptions' <**> helper)
|
||||
(fullDesc <>
|
||||
progDesc "Build a R3 static site" <>
|
||||
header "reploy - the R3 static site builder")
|
||||
(fullDesc
|
||||
<> progDesc "Build a R3 static site"
|
||||
<> header "reploy - the R3 static site builder")
|
||||
|
|
12
Utils.hs
12
Utils.hs
|
@ -75,8 +75,12 @@ addHeadingLinks cls = Text.Pandoc.Walk.walk go
|
|||
Header
|
||||
lvl
|
||||
attr
|
||||
(inlines ++
|
||||
[Link ("", [cls], []) [Str "#"] ("#" <> id, "Link to this section")])
|
||||
(inlines
|
||||
++ [ Link
|
||||
("", [cls], [])
|
||||
[Str "#"]
|
||||
("#" <> id, "Link to this section")
|
||||
])
|
||||
go x = x
|
||||
|
||||
-- | @"https://example.com" `hasUriScheme` "https"@
|
||||
|
@ -132,8 +136,8 @@ sourcePaths fp process = do
|
|||
| null ds = False
|
||||
| last ds `elem` notSource = True
|
||||
| otherwise = False
|
||||
io (getRecursiveContents (pure . ignoreDir . splitDirectories) fp) >>=
|
||||
foldMapM process
|
||||
io (getRecursiveContents (pure . ignoreDir . splitDirectories) fp)
|
||||
>>= foldMapM process
|
||||
|
||||
-- | Given a path to a file, try to make the path writable by making all
|
||||
-- directories on the path. (Interned from Hakyll.)
|
||||
|
|
116
reploy.hs
116
reploy.hs
|
@ -81,8 +81,8 @@ loadPage fp = do
|
|||
io $ putStrLn $ "P <- " ++ fp
|
||||
txt <- io $ TIO.readFile fp
|
||||
{- tear out the metadata manually -}
|
||||
(T.take 4 txt == "---\n") `unless`
|
||||
error ("metadata block start missing in " ++ fp)
|
||||
(T.take 4 txt == "---\n")
|
||||
`unless` error ("metadata block start missing in " ++ fp)
|
||||
let (meta, markdown) = T.breakOn "\n---\n" (T.drop 4 txt)
|
||||
T.null meta `when` error ("metadata block bad in " ++ fp)
|
||||
{- parse everything -}
|
||||
|
@ -90,17 +90,16 @@ loadPage fp = do
|
|||
md <- io $ runIOorExplode $ readMarkdown markdownReadOpts (T.drop 5 markdown)
|
||||
{- find the main mount point for the page -}
|
||||
let mount =
|
||||
unAbsolute . T.unpack . just ("mount point of " ++ fp) $ yml ^?
|
||||
key "mount" .
|
||||
_String
|
||||
unAbsolute . T.unpack . just ("mount point of " ++ fp)
|
||||
$ yml ^? key "mount" . _String
|
||||
existing <- use $ pages . to (M.!? mount)
|
||||
case existing of
|
||||
Just pi ->
|
||||
error $ "mount for " ++ fp ++ " already exists from " ++ _pagePath pi
|
||||
_ -> pure ()
|
||||
{- save to the state -}
|
||||
pages %=
|
||||
M.insert mount PageInfo {_pagePath = fp, _pageMeta = yml, _pageDoc = md}
|
||||
pages
|
||||
%= M.insert mount PageInfo {_pagePath = fp, _pageMeta = yml, _pageDoc = md}
|
||||
|
||||
-- | Find which template to use for rendering a page.
|
||||
pageTemplate :: PageInfo -> Site FilePath
|
||||
|
@ -114,8 +113,8 @@ pageTemplates = do
|
|||
rt <- use redirectTemplate
|
||||
tt <- use tagTemplate
|
||||
lt <- use listTemplate
|
||||
nub . ([rt, tt, lt] ++) <$>
|
||||
(gets (^.. pages . traverse) >>= traverse pageTemplate)
|
||||
nub . ([rt, tt, lt] ++)
|
||||
<$> (gets (^.. pages . traverse) >>= traverse pageTemplate)
|
||||
|
||||
-- | Compile a single template in a directory
|
||||
compileTemplate ::
|
||||
|
@ -180,8 +179,8 @@ rootedLink = (<*>) rootedLink' . pure
|
|||
-- | Process a single link pointing out from a page.
|
||||
processLink :: FilePath -> FilePath -> Site String
|
||||
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
|
||||
else if isAbsolute l
|
||||
then rootedPageLink l
|
||||
|
@ -203,11 +202,12 @@ addGlobalMeta meta = do
|
|||
rtp <- rootedPageLink'
|
||||
Y.Object m <- (`objMerge` meta) <$> use extraMeta
|
||||
let l = map (\(k, v) -> (K.toText k, Mu.toMustache v)) $ KM.toList m
|
||||
pure . Mu.object $ l ++
|
||||
[ ("root", Mu.toMustache $ T.pack r)
|
||||
, ("rawRootUrl", Mu.overText $ T.pack . rt . T.unpack)
|
||||
, ("pageLink", Mu.overText $ T.pack . rtp . T.unpack)
|
||||
]
|
||||
pure . Mu.object
|
||||
$ l
|
||||
++ [ ("root", Mu.toMustache $ T.pack r)
|
||||
, ("rawRootUrl", Mu.overText $ T.pack . rt . T.unpack)
|
||||
, ("pageLink", Mu.overText $ T.pack . rtp . T.unpack)
|
||||
]
|
||||
|
||||
-- | Get the expected timestamp file for a given filepath
|
||||
metadataFile :: FilePath -> Site FilePath
|
||||
|
@ -226,8 +226,11 @@ addExtraMeta pi m = do
|
|||
em' <- io $ Y.decodeFileEither metaPath
|
||||
case em' of
|
||||
Left pe ->
|
||||
error $ "decoding " ++ metaPath ++ " failed: " ++
|
||||
Y.prettyPrintParseException pe
|
||||
error
|
||||
$ "decoding "
|
||||
++ metaPath
|
||||
++ " failed: "
|
||||
++ Y.prettyPrintParseException pe
|
||||
Right em -> pure $ objMerge em m
|
||||
else pure m
|
||||
|
||||
|
@ -237,11 +240,13 @@ addExtraMeta pi m = do
|
|||
addPageMeta :: PageInfo -> Y.Value -> Site Y.Value
|
||||
addPageMeta pi (Y.Object m) = do
|
||||
htagMeta <-
|
||||
traverse (htagRenderMeta tagLink) . sort $ pi ^.. pageMeta . key "tags" .
|
||||
values .
|
||||
_String .
|
||||
to T.unpack .
|
||||
to splitTag
|
||||
traverse (htagRenderMeta tagLink) . sort
|
||||
$ pi ^.. pageMeta
|
||||
. key "tags"
|
||||
. values
|
||||
. _String
|
||||
. to T.unpack
|
||||
. to splitTag
|
||||
addExtraMeta pi . Y.Object $ KM.insert "htags" (Y.array htagMeta) m
|
||||
|
||||
-- | 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') =
|
||||
let go n = do
|
||||
toc <-
|
||||
io . runIOorExplode $ writeHtml5String htmlWriteOpts $
|
||||
withPandocBlocks (pure . toTableOfContents (tocWriteOpts n)) doc
|
||||
io . runIOorExplode
|
||||
$ writeHtml5String htmlWriteOpts
|
||||
$ withPandocBlocks (pure . toTableOfContents (tocWriteOpts n)) doc
|
||||
pure . Y.Object $ KM.insert "toc" (Y.String toc) meta'
|
||||
in case ( pi ^? pageMeta . key "toc" . _Bool
|
||||
, join $ pi ^? pageMeta . key "toc" . _Number .
|
||||
to Data.Scientific.toBoundedInteger) of
|
||||
, join
|
||||
$ pi ^? pageMeta
|
||||
. key "toc"
|
||||
. _Number
|
||||
. to Data.Scientific.toBoundedInteger) of
|
||||
(Just False, _) -> pure meta
|
||||
(_, Nothing) -> go (3 :: Int)
|
||||
(_, Just n) -> go n
|
||||
|
@ -269,8 +278,9 @@ installPage mount pi = do
|
|||
walkURLs (processLink $ pi ^. pagePath . to takeDirectory) $ pi ^. pageDoc
|
||||
checkTarget file
|
||||
body <-
|
||||
io . runIOorExplode $ writeHtml5String htmlWriteOpts $
|
||||
addHeadingLinks "header-local-anchor" fixedUrlDoc
|
||||
io . runIOorExplode
|
||||
$ writeHtml5String htmlWriteOpts
|
||||
$ addHeadingLinks "header-local-anchor" fixedUrlDoc
|
||||
let Y.Object meta' = pi ^. pageMeta
|
||||
meta = Y.Object $ KM.insert "body" (Y.String body) meta'
|
||||
meta <- addTOC pi fixedUrlDoc meta >>= addPageMeta pi >>= addGlobalMeta
|
||||
|
@ -292,8 +302,8 @@ installRedirect target' from = do
|
|||
putStrLn $ "@ -> " ++ file ++ " -> " ++ target
|
||||
makeDirectories file
|
||||
txt <-
|
||||
checkedSubstitute templ $
|
||||
Mu.object [("target", Mu.toMustache $ T.pack target)]
|
||||
checkedSubstitute templ
|
||||
$ Mu.object [("target", Mu.toMustache $ T.pack target)]
|
||||
TIO.writeFile file txt
|
||||
|
||||
-- | Install all redirects required by one page.
|
||||
|
@ -347,8 +357,8 @@ installAsset ad fp = do
|
|||
-- | Copy all files from a given asset directory.
|
||||
installAssetDir :: FilePath -> Site ()
|
||||
installAssetDir ad =
|
||||
io (getRecursiveContents (pure . const False) ad) >>=
|
||||
traverse_ (installAsset ad)
|
||||
io (getRecursiveContents (pure . const False) ad)
|
||||
>>= traverse_ (installAsset ad)
|
||||
|
||||
-- | Copy all files from the asset directories.
|
||||
installAssets :: Site ()
|
||||
|
@ -375,9 +385,9 @@ makePageLinkRenderMeta :: FilePath -> Site Y.Value
|
|||
makePageLinkRenderMeta mount = do
|
||||
link <- rootedPageLink mount
|
||||
meta <- use $ pages . to (M.! mount) . pageMeta
|
||||
pure $
|
||||
Y.object
|
||||
[("mount", fromString mount), ("href", fromString link), ("meta", meta)]
|
||||
pure
|
||||
$ Y.object
|
||||
[("mount", fromString mount), ("href", fromString link), ("meta", meta)]
|
||||
|
||||
wrapPagesMeta :: Y.Value -> String -> FilePath -> Y.Value
|
||||
wrapPagesMeta x linkname link =
|
||||
|
@ -424,15 +434,23 @@ renderListing templName fileName makeMeta mark htag = do
|
|||
|
||||
renderTags = do
|
||||
lt <- use tagTemplate
|
||||
M.keys <$> use ehtags >>=
|
||||
traverse_
|
||||
(renderListing lt tagFilename (makeTagRenderMeta >=> addGlobalMeta) "#")
|
||||
M.keys <$> use ehtags
|
||||
>>= traverse_
|
||||
(renderListing
|
||||
lt
|
||||
tagFilename
|
||||
(makeTagRenderMeta >=> addGlobalMeta)
|
||||
"#")
|
||||
|
||||
renderLists = do
|
||||
lt <- use listTemplate
|
||||
M.keys <$> use ehtags >>=
|
||||
traverse_
|
||||
(renderListing lt listFilename (makeListRenderMeta >=> addGlobalMeta) "*")
|
||||
M.keys <$> use ehtags
|
||||
>>= traverse_
|
||||
(renderListing
|
||||
lt
|
||||
listFilename
|
||||
(makeListRenderMeta >=> addGlobalMeta)
|
||||
"*")
|
||||
|
||||
-- | Transform one mounted PageInfo to the base search data
|
||||
makeSearchData :: FilePath -> PageInfo -> Site [Y.Value]
|
||||
|
@ -447,14 +465,14 @@ makeSearchData mount pi = do
|
|||
let tagarray = Y.array . map (Y.array . map fromString) $ tagnames
|
||||
if pi ^? pageMeta . key "search" . _Bool == Just False -- `off` gets parsed as bool
|
||||
then pure []
|
||||
else pure $
|
||||
[ Y.object
|
||||
[ ("link", fromString link)
|
||||
, ("name", maybe (fromString mount) Y.String name)
|
||||
, ("tags", tagarray)
|
||||
, ("text", Y.String text)
|
||||
else pure
|
||||
$ [ Y.object
|
||||
[ ("link", fromString link)
|
||||
, ("name", maybe (fromString mount) Y.String name)
|
||||
, ("tags", tagarray)
|
||||
, ("text", Y.String text)
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
-- | Collect all pages' search data to the file
|
||||
renderSearchData :: Site ()
|
||||
|
|
Loading…
Reference in a new issue