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] , _htags :: M.Map [String] [FilePath]
-- | List of installed files (prevents overwriting) -- | List of installed files (prevents overwriting)
, _installs :: S.Set FilePath , _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 -- | Map of Mustache templates organized by template search path (within
-- the template directory) -- the template directory)
, _templates :: M.Map FilePath Mu.Template , _templates :: M.Map FilePath Mu.Template
, _outputDir :: FilePath -- ^ Directory for output , _outputDir :: FilePath -- ^ Directory for output
, _defaultTemplate :: FilePath -- ^ Name of the default template , _defaultTemplate :: FilePath -- ^ Name of the default template
, _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages
} }
deriving (Show) deriving (Show)
@ -51,9 +54,11 @@ emptySiteState =
, _redirects = M.empty , _redirects = M.empty
, _htags = M.empty , _htags = M.empty
, _installs = S.empty , _installs = S.empty
, _renders = S.empty
, _templates = M.empty , _templates = M.empty
, _outputDir = "_site" , _outputDir = "_site"
, _defaultTemplate = "default.html" , _defaultTemplate = "default.html"
, _redirectTemplate = "redirect.html"
} }
-- | Monad for running the site generator. -- | Monad for running the site generator.

31
site.hs
View file

@ -12,6 +12,7 @@ import Data.List (nub)
import Data.List.Extra (stripSuffix) import Data.List.Extra (stripSuffix)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust) import Data.Maybe (fromMaybe, isJust)
import qualified Data.Set as S
import Data.String (fromString) import Data.String (fromString)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding import qualified Data.Text.Encoding
@ -24,11 +25,11 @@ import Lens.Micro.Mtl
import System.Environment (getArgs) import System.Environment (getArgs)
import System.FilePath ((</>), splitPath) import System.FilePath ((</>), splitPath)
import qualified Text.Mustache as Mu import qualified Text.Mustache as Mu
import qualified Text.Parsec.Error
import Text.Pandoc.Class (runIOorExplode) import Text.Pandoc.Class (runIOorExplode)
import qualified Text.Pandoc.Extensions import qualified Text.Pandoc.Extensions
import Text.Pandoc.Options (ReaderOptions(..)) import Text.Pandoc.Options (ReaderOptions(..))
import Text.Pandoc.Readers.Markdown (readMarkdown) import Text.Pandoc.Readers.Markdown (readMarkdown)
import qualified Text.Parsec.Error
import Types import Types
@ -91,12 +92,18 @@ pageTemplate pi = do
-- | Collect all templates required for rendering the currently loaded pages. -- | Collect all templates required for rendering the currently loaded pages.
pageTemplates :: Site [FilePath] 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 ::
compileTemplate templdir templ = io $ do FilePath
putStrLn $ "TTT " ++ (templdir </> templ) -> FilePath
Mu.automaticCompile [templdir] templ -> 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. -- | Use a template set from a given directory.
sourceTemplates :: FilePath -> Site () sourceTemplates :: FilePath -> Site ()
@ -113,13 +120,23 @@ indexFilename mount = do
od <- use outputDir od <- use outputDir
pure (od </> mount </> "index.html") 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. -- | Render a page using the current template.
installPage :: FilePath -> PageInfo -> Site () installPage :: FilePath -> PageInfo -> Site ()
installPage mount pi = do installPage mount pi
{- find the correct template and metadata -} {- find the correct template and metadata -}
= do
tname <- pageTemplate pi tname <- pageTemplate pi
templ <- use $ templates . to (M.! fromString tname) templ <- use $ templates . to (M.! fromString tname)
file <- indexFilename mount file <- indexFilename mount
checkRender file
io $ do io $ do
putStrLn $ ">>> " ++ file putStrLn $ ">>> " ++ file
makeDirectories file makeDirectories file