From 1c4a4bc54ab8b2c7ad17e9942037a2ee8666458b Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Wed, 24 May 2023 19:31:54 +0200
Subject: [PATCH] check overwrites

---
 Types.hs |  5 +++++
 site.hs  | 31 ++++++++++++++++++++++++-------
 2 files changed, 29 insertions(+), 7 deletions(-)

diff --git a/Types.hs b/Types.hs
index 8e842f4..b46011e 100644
--- a/Types.hs
+++ b/Types.hs
@@ -34,11 +34,14 @@ data SiteState =
     , _htags :: M.Map [String] [FilePath]
     -- | List of installed files (prevents overwriting)
     , _installs :: S.Set FilePath
+    -- | List of installed pages (basically directories with index; prevents overwriting)
+    , _renders :: S.Set FilePath
     -- | Map of Mustache templates organized by template search path (within
     -- the template directory)
     , _templates :: M.Map FilePath Mu.Template
     , _outputDir :: FilePath -- ^ Directory for output
     , _defaultTemplate :: FilePath -- ^ Name of the default template
+    , _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages
     }
   deriving (Show)
 
@@ -51,9 +54,11 @@ emptySiteState =
     , _redirects = M.empty
     , _htags = M.empty
     , _installs = S.empty
+    , _renders = S.empty
     , _templates = M.empty
     , _outputDir = "_site"
     , _defaultTemplate = "default.html"
+    , _redirectTemplate = "redirect.html"
     }
 
 -- | Monad for running the site generator.
diff --git a/site.hs b/site.hs
index 7fd5195..ede7d45 100644
--- a/site.hs
+++ b/site.hs
@@ -12,6 +12,7 @@ import Data.List (nub)
 import Data.List.Extra (stripSuffix)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isJust)
+import qualified Data.Set as S
 import Data.String (fromString)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding
@@ -24,11 +25,11 @@ import Lens.Micro.Mtl
 import System.Environment (getArgs)
 import System.FilePath ((</>), splitPath)
 import qualified Text.Mustache as Mu
-import qualified Text.Parsec.Error
 import Text.Pandoc.Class (runIOorExplode)
 import qualified Text.Pandoc.Extensions
 import Text.Pandoc.Options (ReaderOptions(..))
 import Text.Pandoc.Readers.Markdown (readMarkdown)
+import qualified Text.Parsec.Error
 
 import Types
 
@@ -91,12 +92,18 @@ pageTemplate pi = do
 
 -- | Collect all templates required for rendering the currently loaded pages.
 pageTemplates :: Site [FilePath]
-pageTemplates = nub <$> (gets (^.. pages . traverse) >>= traverse pageTemplate)
+pageTemplates = do
+  rt <- use redirectTemplate
+  nub . (rt :) <$> (gets (^.. pages . traverse) >>= traverse pageTemplate)
 
-compileTemplate :: FilePath -> FilePath -> Site (Either Text.Parsec.Error.ParseError Mu.Template)
-compileTemplate templdir templ = io $ do
-  putStrLn $ "TTT " ++ (templdir </> templ)
-  Mu.automaticCompile [templdir] templ
+compileTemplate ::
+     FilePath
+  -> FilePath
+  -> Site (Either Text.Parsec.Error.ParseError Mu.Template)
+compileTemplate templdir templ =
+  io $ do
+    putStrLn $ "TTT " ++ (templdir </> templ)
+    Mu.automaticCompile [templdir] templ
 
 -- | Use a template set from a given directory.
 sourceTemplates :: FilePath -> Site ()
@@ -113,13 +120,23 @@ indexFilename mount = do
   od <- use outputDir
   pure (od </> mount </> "index.html")
 
+-- | Check that the page was not rendered before, and add it to the rendered set
+checkRender :: FilePath -> Site ()
+checkRender fp = do
+  found <- S.member fp <$> use renders
+  if found
+    then error $ "colliding renders for page: " ++ fp
+    else renders %= S.insert fp
+
 -- | Render a page using the current template.
 installPage :: FilePath -> PageInfo -> Site ()
-installPage mount pi = do
+installPage mount pi
   {- find the correct template and metadata -}
+ = do
   tname <- pageTemplate pi
   templ <- use $ templates . to (M.! fromString tname)
   file <- indexFilename mount
+  checkRender file
   io $ do
     putStrLn $ ">>> " ++ file
     makeDirectories file