Commit 3bd86865 authored by Nicolas Lenz's avatar Nicolas Lenz

Add pages building

parent ad1b62df
......@@ -80,14 +80,27 @@ instance Ord Summary where
|| (summaryDate x == summaryDate y && summaryTitle x == summaryTitle y && summaryLink x < summaryLink y)
|| (summaryDate x == summaryDate y && summaryTitle x == summaryTitle y && summaryLink x == summaryLink y && summaryContent x <= summaryContent y)
readArticle :: (PandocMonad m) => Text -> m Pandoc
readArticle = readMarkdown readerOptions where
read :: (PandocMonad m) => Text -> m Pandoc
read = readMarkdown readerOptions where
readerOptions = def {readerExtensions = pandocExtensions}
-- TODO: Deduplicate
readPages :: (PandocMonad m, MonadIO m) => Meta -> [(Path Rel File, Text)] -> m [(Path Rel File, Pandoc)]
readPages extraMeta inputs = do
outputs <- forM inputs $ \(path, content) -> do
contentR <- read content
return (path, contentR)
outputs <- forM outputs $ \(path, content) -> liftIO $ do
newPath <- setFileExtension ".html" path -- TODO: This should really be done without IO...
return (newPath, content)
let outputs' = addMeta extraMeta <$$> outputs
return outputs'
readArticles :: (PandocMonad m, MonadIO m) => Meta -> [(Path Rel File, Text)] -> m (Pandoc, [(Path Rel File, Pandoc)])
readArticles extraMeta inputs = do
outputs <- forM inputs $ \(path, content) -> do
contentR <- readArticle content
contentR <- read content
return (path, contentR)
outputs <- forM outputs $ \(path, content) -> liftIO $ do
newPath <- setFileExtension ".html" path -- TODO: This should really be done without IO...
......@@ -99,6 +112,16 @@ write :: (PandocMonad m) => Text -> Pandoc -> m Text
write template = writeHtml5String writerOptions where
writerOptions = def {writerExtensions = pandocExtensions, writerTemplate = Just $ unpack template}
buildPages :: (PandocMonad m, MonadIO m) => Text -> MetaValue -> [(Path Rel File, Text)] -> m [(Path Rel File, Text)]
buildPages template navbar inputs = do
pagesInput <- readPages extraMeta inputs
f `mapM` pagesInput
where
extraMeta = Meta $ Map.fromList [("navbar", navbar)]
f (path, content) = do
contentW <- write template content
return (path, contentW)
buildArticles :: (PandocMonad m, MonadIO m) => Text -> Text -> MetaValue -> [(Path Rel File, Text)] -> m (Text, [(Path Rel File, Text)])
buildArticles templateArticle templateIndex navbar inputs = do
(indexInput, articlesInput) <- readArticles extraMeta inputs
......@@ -169,13 +192,19 @@ build = loadConfig >>= \case
copyFolders config
compileStylesheet
templateArticle <- readFileUtf8 configTemplateArticle
-- templatePage <- readFileUtf8 configTemplatePage
templatePage <- readFileUtf8 configTemplatePage
templateIndex <- readFileUtf8 configTemplateIndex
articlesInput <- load [reldir|article|]
-- pagesInput <- load [reldir|page|]
runIO (buildArticles templateArticle templateIndex (getNavbarMeta $ configNavbar) articlesInput) >>= \case
pagesInput <- load [reldir|page|]
articlesOutputE <- runIO (buildArticles templateArticle templateIndex (getNavbarMeta $ configNavbar) articlesInput)
pagesOutputE <- runIO (buildPages templatePage (getNavbarMeta $ configNavbar) pagesInput)
let outputE = do{
(indexOutput, articlesOutput) <- articlesOutputE;
pagesOutput <- pagesOutputE;
return (indexOutput, articlesOutput, pagesOutput)}
case outputE of
Left ex -> fail $ "Error while processing articles: " <> show ex
Right (indexOutput, articlesOutput) -> do
Right (indexOutput, articlesOutput, pagesOutput) -> do
save [reldir|out/article|] articlesOutput
writeFileUtf8 "out/index.html" indexOutput
putStrLn "Success!"
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages: []
snapshots:
- completed:
size: 524127
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/6.yaml
sha256: dc70dfb45e2c32f54719819bd055f46855dd4b3bd2e58b9f3f38729a2d553fbb
original: lts-14.6
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment