aboutsummaryrefslogtreecommitdiff
path: root/site.hs
diff options
context:
space:
mode:
Diffstat (limited to 'site.hs')
-rw-r--r--site.hs34
1 files changed, 26 insertions, 8 deletions
diff --git a/site.hs b/site.hs
index ede7d45..a1e03b5 100644
--- a/site.hs
+++ b/site.hs
@@ -142,20 +142,37 @@ installPage mount pi
makeDirectories file
TIO.writeFile file . Mu.substitute templ $ pi ^. pageMeta
+{- | Install a simple redirect handler page. -}
+installRedirect :: FilePath -> FilePath -> Site ()
+installRedirect target from = do
+ tname <- use redirectTemplate
+ templ <- use $ templates . to (M.! fromString tname)
+ file <- indexFilename from
+ checkRender file
+ io $ do
+ putStrLn $ "@@@ " ++ file ++ " -> " ++ target
+ makeDirectories file
+ TIO.writeFile file . Mu.substitute templ $
+ Y.object [("target", Y.String $ T.pack target)]
+
+-- | Install all redirects required by one page.
+installPageRedirects :: FilePath -> PageInfo -> Site ()
+installPageRedirects target pi = do
+ traverse_
+ (installRedirect target . T.unpack)
+ (pi ^.. pageMeta . key "redirects" . values . _String)
+
+-- | Install all redirects required by all pages.
+installRedirects :: Site ()
+installRedirects =
+ use pages >>= traverse_ (uncurry installPageRedirects) . M.assocs
+
{- | Install a file. Files are installed into a single shared location. That
- prevents file duplication and also gives a bit of control for where the
- files reside and what are their names. -}
installFile :: FilePath -> Site FilePath
installFile = undefined
-{- | Install a simple redirect handler page. -}
-installRedirect :: FilePath -> FilePath -> Site ()
-installRedirect = undefined
-
--- | Install all redirects required by pages.
-installRedirects :: Site ()
-installRedirects = undefined
-
-- | Render a site for a given tag string.
renderTag :: [String] -> Site ()
renderTag = undefined
@@ -169,5 +186,6 @@ main =
flip runStateT emptySiteState $ do
traverse sourcePages ["external"]
sourceTemplates "templates"
+ installRedirects
use pages >>= traverse (uncurry installPage) . M.assocs
get >>= io . print