diff options
Diffstat (limited to 'reploy.hs')
| -rw-r--r-- | reploy.hs | 116 |
1 files changed, 67 insertions, 49 deletions
@@ -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 () |