redirect installation

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