check overwrites

This commit is contained in:
Mirek Kratochvil 2023-05-24 19:31:54 +02:00
parent c0e5feaa37
commit 1c4a4bc54a
2 changed files with 29 additions and 7 deletions

View file

@ -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.

27
site.hs
View file

@ -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,10 +92,16 @@ 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
compileTemplate ::
FilePath
-> FilePath
-> Site (Either Text.Parsec.Error.ParseError Mu.Template)
compileTemplate templdir templ =
io $ do
putStrLn $ "TTT " ++ (templdir </> templ)
Mu.automaticCompile [templdir] templ
@ -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