diff --git a/Casket.hs b/Casket.hs deleted file mode 100644 index c05cba8..0000000 --- a/Casket.hs +++ /dev/null @@ -1,651 +0,0 @@ -{- HakyllLite.hs - Haskell-powered static site generator - - "HakyllLite" - Functional elegance in site generation - - A simplified Hakyll-inspired SSG showcasing Haskell's: - - Pure functions for predictable transformations - - Pattern matching for elegant parsing - - Lazy evaluation for efficient processing --} - -module Main where - -import Data.List (isPrefixOf, isSuffixOf, foldl') -import Data.Char (isSpace) -import System.Environment (getArgs) -import System.Directory (listDirectory, createDirectoryIfMissing, doesFileExist, doesDirectoryExist, copyFile) -import System.FilePath ((), takeBaseName, takeExtension, takeFileName) -import Control.Monad (forM_, when, filterM) -import System.Process (readProcess) -import System.Exit (ExitCode(..)) - --- ============================================================================ --- Types --- ============================================================================ - -data Frontmatter = Frontmatter - { fmTitle :: String - , fmDate :: String - , fmTags :: [String] - , fmDraft :: Bool - , fmTemplate :: String - } deriving (Show) - -emptyFrontmatter :: Frontmatter -emptyFrontmatter = Frontmatter "" "" [] False "default" - -data SiteConfig = SiteConfig - { cfgTitle :: String - , cfgUrl :: String - , cfgAuthor :: String - , cfgInputDir :: String - , cfgOutputDir :: String - , cfgSpellCheck :: Bool - , cfgDefaultLang :: String - } deriving (Show) - -defaultConfig :: SiteConfig -defaultConfig = SiteConfig "My Site" "" "Author" "content" "_site" False "en" - -data I18nStrings = I18nStrings - { i18nReadMore :: String - , i18nPublished :: String - , i18nTags :: String - , i18nHome :: String - } deriving (Show) - -defaultI18n :: I18nStrings -defaultI18n = I18nStrings "Read more" "Published" "Tags" "Home" - -data ParserState = ParserState - { stHtml :: String - , stInPara :: Bool - , stInCode :: Bool - , stInList :: Bool - } deriving (Show) - -initState :: ParserState -initState = ParserState "" False False False - --- ============================================================================ --- String Utilities --- ============================================================================ - -trim :: String -> String -trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse - -stripPrefix' :: String -> String -> String -stripPrefix' prefix str - | prefix `isPrefixOf` str = drop (length prefix) str - | otherwise = str - -escapeHtml :: String -> String -escapeHtml = concatMap esc - where - esc '<' = "<" - esc '>' = ">" - esc '&' = "&" - esc '"' = """ - esc c = [c] - -splitOn :: Char -> String -> [String] -splitOn _ "" = [""] -splitOn c s = case break (== c) s of - (a, "") -> [a] - (a, _:b) -> a : splitOn c b - --- ============================================================================ --- Frontmatter Parser --- ============================================================================ - -parseFmLine :: String -> Frontmatter -> Frontmatter -parseFmLine line fm = case break (== ':') line of - (_, "") -> fm - (key, _:val) -> - let k = trim key - v = trim val - in case k of - "title" -> fm { fmTitle = v } - "date" -> fm { fmDate = v } - "template" -> fm { fmTemplate = v } - "draft" -> fm { fmDraft = v `elem` ["true", "yes"] } - "tags" -> fm { fmTags = parseTags v } - _ -> fm - where - parseTags s - | "[" `isPrefixOf` s = map trim $ splitOn ',' $ init $ tail s - | otherwise = map trim $ splitOn ',' s - -parseFrontmatter :: String -> (Frontmatter, String) -parseFrontmatter content = - let allLines = lines content - in case allLines of - (first:rest) | trim first == "---" -> findEnd rest emptyFrontmatter - _ -> (emptyFrontmatter, content) - where - findEnd [] fm = (fm, "") - findEnd (l:ls) fm - | trim l == "---" = (fm, unlines ls) - | otherwise = findEnd ls (parseFmLine l fm) - --- ============================================================================ --- Markdown Parser --- ============================================================================ - -processInline :: String -> String -processInline = go False False - where - go _ _ [] = [] - go bold ital ('[':rest) = - -- Try to parse markdown link [text](url) - let (text, afterText) = span (/= ']') rest - in case afterText of - (']':'(':moreRest) -> - let (url, afterUrl) = span (/= ')') moreRest - in case afterUrl of - (')':remaining) -> "" ++ text ++ "" ++ go bold ital remaining - _ -> '[' : go bold ital rest - _ -> '[' : go bold ital rest - go bold ital ('*':'*':rest) - | bold = "" ++ go False ital rest - | otherwise = "" ++ go True ital rest - go bold ital ('*':rest) - | ital = "" ++ go bold False rest - | otherwise = "" ++ go bold True rest - go bold ital ('`':rest) = - let (code, remaining) = span (/= '`') rest - in case remaining of - ('`':r) -> "" ++ code ++ "" ++ go bold ital r - _ -> '`' : go bold ital rest - go bold ital (c:rest) = c : go bold ital rest - -processLine :: String -> ParserState -> ParserState -processLine line st = - let trimmed = trim line - in - -- Code fence - if "```" `isPrefixOf` trimmed then - if stInCode st - then st { stHtml = stHtml st ++ "\n", stInCode = False } - else let st' = closePara $ closeList st - in st' { stHtml = stHtml st' ++ "
", stInCode = True }
-
-    -- Inside code block
-    else if stInCode st then
-      st { stHtml = stHtml st ++ escapeHtml line ++ "\n" }
-
-    -- Empty line
-    else if null trimmed then
-      closeList $ closePara st
-
-    -- Headers (check longest first)
-    else if "######" `isPrefixOf` trimmed then
-      processHeader 6 "######" trimmed st
-    else if "#####" `isPrefixOf` trimmed then
-      processHeader 5 "#####" trimmed st
-    else if "####" `isPrefixOf` trimmed then
-      processHeader 4 "####" trimmed st
-    else if "###" `isPrefixOf` trimmed then
-      processHeader 3 "###" trimmed st
-    else if "##" `isPrefixOf` trimmed then
-      processHeader 2 "##" trimmed st
-    else if "#" `isPrefixOf` trimmed then
-      processHeader 1 "#" trimmed st
-
-    -- List items
-    else if "- " `isPrefixOf` trimmed || "* " `isPrefixOf` trimmed then
-      let st' = closePara st
-          st'' = if not (stInList st')
-                   then st' { stHtml = stHtml st' ++ "
    \n", stInList = True }
-                   else st'
-          item = processInline $ trim $ drop 2 trimmed
-      in st'' { stHtml = stHtml st'' ++ "
  • " ++ item ++ "
    • \n" }
-
-    -- Paragraph
-    else
-      let st' = if not (stInPara st)
-                  then st { stHtml = stHtml st ++ "
    ", stInPara = True }
-                  else st { stHtml = stHtml st ++ " " }
-      in st' { stHtml = stHtml st' ++ processInline trimmed }
-
-  where
-    processHeader n prefix text state =
-      let st' = closeList $ closePara state
-          content = processInline $ trim $ stripPrefix' prefix text
-          tag = show n
-      in st' { stHtml = stHtml st' ++ "" ++ content ++ "\n" }
-
-closePara :: ParserState -> ParserState
-closePara st
-  | stInPara st = st { stHtml = stHtml st ++ "
    \n", stInPara = False }
-  | otherwise = st
-
-closeList :: ParserState -> ParserState
-closeList st
-  | stInList st = st { stHtml = stHtml st ++ "
\n", stInList = False }
-  | otherwise = st
-
-parseMarkdown :: String -> String
-parseMarkdown content =
-  let allLines = lines content
-      final = foldl' (flip processLine) initState allLines
-      st' = closeList $ closePara final
-      st'' = if stInCode st'
-               then st' { stHtml = stHtml st' ++ "
\n" } - else st' - in stHtml st'' - --- ============================================================================ --- Template Engine --- ============================================================================ - -defaultTemplate :: String -defaultTemplate = unlines - [ "" - , "{{title}}" - , "" - , "

{{title}}

" - , "{{content}}" - , "
" - ] - -replaceAll :: String -> String -> String -> String -replaceAll "" _ str = str -replaceAll needle replacement str = go str - where - nLen = length needle - go s - | length s < nLen = s - | needle `isPrefixOf` s = replacement ++ go (drop nLen s) - | otherwise = head s : go (tail s) - -applyTemplate :: Frontmatter -> String -> String -applyTemplate fm html = - let t1 = replaceAll "{{title}}" (fmTitle fm) defaultTemplate - t2 = replaceAll "{{date}}" (fmDate fm) t1 - t3 = replaceAll "{{content}}" html t2 - in t3 - --- ============================================================================ --- Tests --- ============================================================================ - -testMarkdown :: IO () -testMarkdown = do - putStrLn "=== Test: Markdown ===" - let md = unlines - [ "# Hello World" - , "" - , "This is a **bold** test with *italic* text." - , "" - , "- Item 1" - , "- Item 2" - , "" - , "```" - , "code block" - , "```" - ] - putStrLn $ parseMarkdown md - -testFrontmatter :: IO () -testFrontmatter = do - putStrLn "=== Test: Frontmatter ===" - let content = unlines - [ "---" - , "title: My Post" - , "date: 2024-01-15" - , "tags: [haskell, ssg]" - , "draft: false" - , "---" - , "" - , "Content here" - ] - let (fm, body) = parseFrontmatter content - putStrLn $ "Title: " ++ fmTitle fm - putStrLn $ "Date: " ++ fmDate fm - putStrLn $ "Tags: " ++ show (fmTags fm) - putStrLn $ "Draft: " ++ show (fmDraft fm) - putStrLn $ "Body: " ++ body - -testFull :: IO () -testFull = do - putStrLn "=== Test: Full Pipeline ===" - let content = unlines - [ "---" - , "title: Welcome" - , "date: 2024-01-15" - , "---" - , "" - , "# Welcome" - , "" - , "This is **HakyllLite**, a Haskell SSG." - , "" - , "- Pure functional" - , "- Type safe" - , "- Elegant" - ] - let (fm, body) = parseFrontmatter content - let html = parseMarkdown body - let output = applyTemplate fm html - putStrLn output - --- ============================================================================ --- Build System --- ============================================================================ - --- | Load template from file or use default -loadTemplate :: String -> IO String -loadTemplate templateName = do - let templatePath = "templates" templateName ++ ".html" - exists <- doesFileExist templatePath - if exists - then readFile templatePath - else return defaultTemplate - --- | Check if file should use a2ml processing (.a2ml extension) -isA2ML :: FilePath -> Bool -isA2ML path = takeExtension path == ".a2ml" - --- | Process a2ml content (typed, verifiable markup) --- Currently stub - will integrate with a2ml compiler -processA2ML :: String -> IO String -processA2ML content = do - putStrLn " [a2ml] Type-checking content..." - -- TODO: Call a2ml compiler to validate and convert - -- For now, return as-is - return content - --- | Validate content with k9-svc (self-validating components) --- Currently stub - will integrate with k9-svc validator -validateK9SVC :: FilePath -> String -> IO Bool -validateK9SVC path content = do - -- Check for k9-svc directives in content - let hasK9SVC = "k9-svc:" `isPrefixOf` content - when hasK9SVC $ do - putStrLn $ " [k9-svc] Validating " ++ path ++ "..." - -- TODO: Parse k9-svc schema and validate - -- For now, always pass - return True - --- | Process content with Pandoc if available, fallback to built-in parser -processContent :: FilePath -> String -> IO String -processContent path content = do - -- Try Pandoc first for better compatibility - pandocResult <- tryPandoc path content - case pandocResult of - Just html -> return html - Nothing -> return $ parseMarkdown content -- Fallback to built-in - --- | Try to use Pandoc for processing -tryPandoc :: FilePath -> String -> IO (Maybe String) -tryPandoc path content = do - let ext = takeExtension path - let format = case ext of - ".md" -> "markdown" - ".adoc" -> "asciidoc" - ".rst" -> "rst" - ".org" -> "org" - _ -> "markdown" - result <- try $ readProcess "pandoc" ["-f", format, "-t", "html"] content - case result of - Left (_ :: IOError) -> return Nothing - Right html -> return $ Just html - where - try :: IO a -> IO (Either IOError a) - try action = catch (Right <$> action) (return . Left) - catch :: IO (Either IOError a) -> (IOError -> IO (Either IOError a)) -> IO (Either IOError a) - catch action handler = do - result <- action - case result of - Left e -> handler e - Right v -> return $ Right v - --- | Process a single file with full feature set -processFile :: FilePath -> FilePath -> IO () -processFile inputPath outputPath = do - content <- readFile inputPath - let (fm, body) = parseFrontmatter content - -- Skip draft posts - when (not $ fmDraft fm) $ do - -- Validate with k9-svc if enabled - valid <- validateK9SVC inputPath content - when (not valid) $ do - putStrLn $ " ERROR: k9-svc validation failed for " ++ inputPath - error "Build stopped due to validation failure" - - -- Spell check if enabled - -- TODO: Make this configurable via site config - -- errors <- spellCheck inputPath body - -- when (not $ null errors) $ do - -- putStrLn $ " WARNING: Spelling errors in " ++ inputPath - -- forM_ (take 5 errors) $ \err -> putStrLn $ " - " ++ err - - -- Process based on file type - html <- if isA2ML inputPath - then processA2ML body -- a2ml content - else processContent inputPath body -- Pandoc or built-in - - -- Load template (use frontmatter template name or "default") - let templateName = if null (fmTemplate fm) then "default" else fmTemplate fm - template <- loadTemplate templateName - let output = applyTemplateStr template fm html - writeFile outputPath output - putStrLn $ " " ++ inputPath ++ " -> " ++ outputPath - --- | Apply template string with variables -applyTemplateStr :: String -> Frontmatter -> String -> String -applyTemplateStr template fm html = - let t1 = replaceAll "{{title}}" (fmTitle fm) template - t2 = replaceAll "{{date}}" (fmDate fm) t1 - t3 = replaceAll "{{content}}" html t2 - in t3 - --- | Copy assets from assets/ or static/ directories to output -copyAssets :: FilePath -> IO () -copyAssets outputDir = do - let assetDirs = ["assets", "static", "css", "images", "js"] - forM_ assetDirs $ \assetDir -> do - exists <- doesDirectoryExist assetDir - when exists $ do - putStrLn $ "Copying " ++ assetDir ++ "/ to " ++ outputDir - copyDirectory assetDir (outputDir assetDir) - --- | Recursively copy directory contents -copyDirectory :: FilePath -> FilePath -> IO () -copyDirectory src dst = do - createDirectoryIfMissing True dst - files <- listDirectory src - forM_ files $ \file -> do - let srcPath = src file - let dstPath = dst file - isDir <- doesDirectoryExist srcPath - if isDir - then copyDirectory srcPath dstPath - else do - copyFile srcPath dstPath - putStrLn $ " " ++ srcPath ++ " -> " ++ dstPath - --- | Load site configuration from config.yaml or use defaults -loadConfig :: IO SiteConfig -loadConfig = do - let configPaths = ["config.yaml", "site.yaml", "config.yml"] - configs <- filterM doesFileExist configPaths - case configs of - (path:_) -> do - putStrLn $ "Loading config from: " ++ path - content <- readFile path - return $ parseConfig content - [] -> do - putStrLn "No config file found, using defaults" - return defaultConfig - --- | Parse simple YAML-like config (key: value format) -parseConfig :: String -> SiteConfig -parseConfig content = - let lns = lines content - pairs = map parseLine $ filter (not . null) lns - getValue key = lookup key pairs - getBool key = maybe False (\v -> v `elem` ["true", "yes", "1"]) $ getValue key - in SiteConfig - (maybe "My Site" id $ getValue "title") - (maybe "" id $ getValue "url") - (maybe "Author" id $ getValue "author") - (maybe "content" id $ getValue "input") - (maybe "_site" id $ getValue "output") - (getBool "spell_check") - (maybe "en" id $ getValue "language") - where - parseLine line = - case break (== ':') line of - (k, ':':v) -> (trim k, trim v) - _ -> ("", "") - --- | Load i18n strings from locales/{lang}.txt -loadI18n :: String -> IO I18nStrings -loadI18n lang = do - let i18nPath = "locales" lang ++ ".txt" - exists <- doesFileExist i18nPath - if exists - then do - content <- readFile i18nPath - return $ parseI18n content - else return defaultI18n - --- | Parse i18n file (key: value format) -parseI18n :: String -> I18nStrings -parseI18n content = - let pairs = map parseLine $ filter (not . null) $ lines content - getValue key = maybe "" id $ lookup key pairs - in I18nStrings - (getValue "read_more") - (getValue "published") - (getValue "tags") - (getValue "home") - where - parseLine line = - case break (== ':') line of - (k, ':':v) -> (trim k, trim v) - _ -> ("", "") - --- | Spell check content using hunspell or aspell -spellCheck :: FilePath -> String -> IO [String] -spellCheck path content = do - -- Try hunspell first, fall back to aspell - result <- trySpellChecker "hunspell" content - case result of - Just errors -> return errors - Nothing -> do - result2 <- trySpellChecker "aspell" content - return $ maybe [] id result2 - --- | Try a spell checker (hunspell or aspell) -trySpellChecker :: String -> String -> IO (Maybe [String]) -trySpellChecker checker content = do - -- Check if checker is available - let checkCmd = if checker == "hunspell" - then "hunspell -l" - else "aspell list" - result <- try $ readProcess "sh" ["-c", "echo '" ++ content ++ "' | " ++ checkCmd] "" - case result of - Left (_ :: IOError) -> return Nothing - Right output -> return $ Just $ filter (not . null) $ lines output - where - try :: IO a -> IO (Either IOError a) - try action = catch (Right <$> action) (return . Left) - catch :: IO (Either IOError a) -> (IOError -> IO (Either IOError a)) -> IO (Either IOError a) - catch action handler = do - result <- action - case result of - Left e -> handler e - Right v -> return $ Right v - --- | Build site from input directory to output directory -buildSite :: FilePath -> FilePath -> IO () -buildSite inputDir outputDir = do - putStrLn $ "Building site: " ++ inputDir ++ " -> " ++ outputDir - createDirectoryIfMissing True outputDir - - files <- listDirectory inputDir - let contentFiles = filter (\f -> takeExtension f `elem` [".md", ".a2ml", ".adoc", ".rst", ".org"]) files - - if null contentFiles - then putStrLn "No content files found." - else do - putStrLn $ "Found " ++ show (length contentFiles) ++ " content files:" - forM_ contentFiles $ \file -> do - let inputPath = inputDir file - let outputPath = outputDir takeBaseName file ++ ".html" - processFile inputPath outputPath - - -- Copy assets - copyAssets outputDir - - putStrLn "Build complete!" - --- | Generate an index page listing all posts (only if no index.md exists) -generateIndex :: FilePath -> FilePath -> IO () -generateIndex inputDir outputDir = do - files <- listDirectory inputDir - let mdFiles = filter (\f -> takeExtension f == ".md") files - - -- Don't generate if index.md exists (it will have its own index.html) - let hasIndexMd = "index.md" `elem` mdFiles - when hasIndexMd $ - putStrLn "Skipping index generation (index.md exists)" - - when (not hasIndexMd) $ do - -- Read frontmatter from each file to build index - entries <- mapM (\f -> do - content <- readFile (inputDir f) - let (fm, _) = parseFrontmatter content - return (takeBaseName f, fm) - ) mdFiles - - let validEntries = filter (not . fmDraft . snd) entries - let listItems = map (\(name, fm) -> - "
  • " ++ - (if null (fmTitle fm) then name else fmTitle fm) ++ - "" ++ - (if null (fmDate fm) then "" else " (" ++ fmDate fm ++ ")") ++ - "
    • ") validEntries - - let indexHtml = unlines - [ "" - , "Index" - , "" - , "" - , "

    Site Index

    " - , "" - , "" - ] - - writeFile (outputDir "index.html") indexHtml - putStrLn $ "Generated index.html with " ++ show (length validEntries) ++ " entries" - --- ============================================================================ --- Main --- ============================================================================ - -main :: IO () -main = do - args <- getArgs - case args of - ["build", inputDir, outputDir] -> do - buildSite inputDir outputDir - generateIndex inputDir outputDir - ["build", inputDir] -> do - buildSite inputDir "_site" - generateIndex inputDir "_site" - ["test-markdown"] -> testMarkdown - ["test-frontmatter"] -> testFrontmatter - ["test-full"] -> testFull - _ -> do - putStrLn "casket-ssg - Pure functional static site generator in Haskell" - putStrLn "" - putStrLn "Usage:" - putStrLn " casket-ssg build [output-dir] Build site (default output: _site)" - putStrLn " casket-ssg test-markdown Test markdown parser" - putStrLn " casket-ssg test-frontmatter Test frontmatter parser" - putStrLn " casket-ssg test-full Test full pipeline" diff --git a/README.adoc b/README.adoc index 294a9ce..7a61fe5 100644 --- a/README.adoc +++ b/README.adoc @@ -3,6 +3,7 @@ // SPDX-FileCopyrightText: 2025-2026 Jonathan D.A. Jewell = casket-ssg +image:https://img.shields.io/badge/Sponsor-%E2%9D%A4-pink?logo=github[Sponsor,link="https://github.com/sponsors/hyperpolymath"] image:https://img.shields.io/badge/OpenSSF-Best_Practices-green?logo=opensourcesecurity[OpenSSF Best Practices,link="https://www.bestpractices.dev/en/projects/new?repo_url=https://github.com/hyperpolymath/casket-ssg"] image:https://img.shields.io/badge/License-MPL_2.0--1.0-blue.svg[License: MPL-2.0,link="https://github.com/hyperpolymath/palimpsest-license"] image:https://api.thegreenwebfoundation.org/greencheckimage/github.com[Green Web,link="https://www.thegreenwebfoundation.org/green-web-check/?url=github.com"] diff --git a/README.md b/README.md deleted file mode 100644 index b8a98fd..0000000 --- a/README.md +++ /dev/null @@ -1,89 +0,0 @@ -[![Sponsor](https://img.shields.io/badge/Sponsor-%E2%9D%A4-pink?logo=github)](https://github.com/sponsors/hyperpolymath) - -// SPDX-License-Identifier: MPL-2.0 -// SPDX-FileCopyrightText: 2025-2026 Jonathan D.A. Jewell - -= casket-ssg -image:https://img.shields.io/badge/OpenSSF-Best_Practices-green?logo=opensourcesecurity[OpenSSF Best Practices,link="https://www.bestpractices.dev/en/projects/new?repo_url=https://github.com/hyperpolymath/casket-ssg"] -image:https://img.shields.io/badge/License-PMPL--1.0-blue.svg[License: PMPL-1.0,link="https://github.com/hyperpolymath/palimpsest-license"] -image:https://api.thegreenwebfoundation.org/greencheckimage/github.com[Green Web,link="https://www.thegreenwebfoundation.org/green-web-check/?url=github.com"] - - - - -image:https://img.shields.io/badge/Philosophy-Palimpsest-indigo.svg[Palimpsest,link="https://github.com/hyperpolymath/palimpsest-license"] - - -:toc: auto -:toclevels: 2 - -image:https://img.shields.io/badge/RSR-compliant-gold[RSR Compliant,link=https://github.com/hyperpolymath/rhodium-standard-repositories] - -**Pure functional static site generator in Haskell.** - -== Who Is This For? - -* **Haskell developers** who want to build sites with tools they know and love -* **Functional programming enthusiasts** who appreciate compositional design -* **Teams requiring reliability** where type safety prevents runtime surprises -* **Anyone frustrated** by dynamic language site builders that fail at deploy time - -== Why casket-ssg? - -=== Type Safety That Matters - -Your site structure is checked at compile time. Missing templates, broken links, malformed frontmatter - all caught before deployment, not discovered by users. - -=== Composable Pipelines - -Content transformations compose like functions should. Chain markdown processing, templating, and asset handling with confidence that types align. - -=== Lazy Large-Site Builds - -Haskell's lazy evaluation means casket-ssg only processes what's needed. Incremental builds are natural, not bolted on. - -=== Pandoc Integration - -Best-in-class document conversion with full Pandoc support. Markdown, reStructuredText, Org-mode - your content, your format. - -== Quick Start - -[source,bash] ----- -# Install -cabal update -cabal install casket-ssg - -# Create a site -casket-ssg init my-site -cd my-site - -# Build -casket-ssg build - -# Preview locally -casket-ssg serve ----- - -== Features - -* **Compile-time template validation** - broken templates don't build -* **Strong frontmatter types** - YAML parsing with schema enforcement -* **Asset pipeline** - CSS/JS processing with hash-based cache busting -* **Incremental builds** - only rebuild what changed -* **Live reload** - instant preview during development -* **RSS/Atom feeds** - generated automatically from content -* **Sitemap generation** - SEO-ready output - -== Requirements - -* GHC 9.0 or later -* Cabal 3.0 or Stack 2.0 - -== Part of poly-ssg - -casket-ssg is part of the https://github.com/hyperpolymath/poly-ssg[poly-ssg] family of language-native static site generators, unified through https://github.com/hyperpolymath/poly-ssg-mcp[MCP integration]. - -== License - -MPL-2.0 diff --git a/assets/style.css b/assets/style.css new file mode 100644 index 0000000..87db0e1 --- /dev/null +++ b/assets/style.css @@ -0,0 +1,130 @@ +/* SPDX-License-Identifier: MPL-2.0 */ +/* Copyright (c) 2025-2026 Jonathan D.A. Jewell */ +/* + * Canonical accessible theme for casket-ssg / ddraig-ssg. + * Target: WCAG 2.2 AAA on the engine-owned surface. + * All text/link/UI colours are contrast-verified (see ACCESSIBILITY-CHECKLIST): + * light: body #1a1b26/17.1:1, muted #3a3d4d/10.7:1, link #3730a3/9.9:1 + * dark : body #e6e8f2/15.6:1, muted #a0a4bd/7.75:1, link #b9c2ff/11.1:1 + * All >= 7:1 (AAA 1.4.6). Focus ring >= 3:1 (2.4.11/2.4.13). + */ + +:root { + --bg: #ffffff; + --bg-soft: #f4f5f9; + --bg-code: #eceef5; + --fg: #1a1b26; /* 17.09:1 on --bg */ + --fg-muted: #3a3d4d; /* 10.74:1 on --bg (AAA for normal text) */ + --link: #3730a3; /* 9.93:1 on --bg */ + --link-hover: #1f1b6b; + --border: #5a5e73; /* 4.9:1 — non-text UI, needs >=3:1 (1.4.11) */ + --focus: #3730a3; /* focus ring, 9.93:1 vs --bg */ + --radius: 6px; + --maxw: 70rem; + --measure: 38rem; /* readable line length */ +} + +@media (prefers-color-scheme: dark) { + :root { + --bg: #0e0f1a; + --bg-soft: #181a2a; + --bg-code: #1c1f33; + --fg: #e6e8f2; /* 15.60:1 on --bg */ + --fg-muted: #a0a4bd; /* 7.75:1 on --bg */ + --link: #b9c2ff; /* 11.09:1 on --bg */ + --link-hover: #dde2ff; + --border: #8c91ad; /* >=3:1 vs --bg */ + --focus: #b9c2ff; /* 11.09:1 vs --bg */ + } +} + +/* 1.4.12 text spacing: never clip when users override; use rem + generous line-height. */ +*, *::before, *::after { box-sizing: border-box; } +html { font-size: 100%; -webkit-text-size-adjust: 100%; } +body { + margin: 0; + font-family: system-ui, -apple-system, "Segoe UI", Roboto, sans-serif; + font-size: 1.0625rem; + line-height: 1.6; /* >= 1.5 (1.4.12) */ + color: var(--fg); + background: var(--bg); + overflow-wrap: break-word; /* 1.4.10 reflow: no horizontal scroll at 320px */ +} +p, li { max-width: var(--measure); } +p { margin: 0 0 1rem; } /* paragraph spacing >= 2x font (1.4.12) */ + +/* 2.4.1 skip link — visible on focus, high contrast, large target. */ +.skip-link { + position: absolute; left: -9999px; top: 0; + background: var(--link); color: #ffffff; + padding: .75rem 1.25rem; border-radius: 0 0 var(--radius) 0; + font-weight: 600; z-index: 100; min-height: 44px; line-height: 1.4; +} +.skip-link:focus { left: 0; } + +/* 2.4.7/2.4.11/2.4.13 visible focus — thick, offset, >=3:1, never removed. */ +:focus-visible { + outline: 3px solid var(--focus); + outline-offset: 2px; + border-radius: 2px; +} +/* keep a focus indicator even for browsers without :focus-visible */ +a:focus, button:focus, input:focus, [tabindex]:focus { outline: 3px solid var(--focus); outline-offset: 2px; } + +.container { width: 100%; max-width: var(--maxw); margin-inline: auto; padding-inline: 1.25rem; } + +/* Header / nav landmark */ +.site-header { border-bottom: 1px solid var(--border); } +.nav { display: flex; flex-wrap: wrap; align-items: center; gap: 1rem; padding-block: .75rem; } +.brand { font-weight: 700; font-size: 1.2rem; color: var(--fg); text-decoration: none; } +.nav-links { list-style: none; display: flex; flex-wrap: wrap; gap: .5rem 1.25rem; margin: 0; padding: 0; } +/* 2.5.8/2.5.5 target size: interactive nav targets >= 44x44. */ +.nav-links a, .brand { display: inline-flex; align-items: center; min-height: 44px; } + +/* 1.4.1 use of colour: links are underlined, not colour-only. */ +a { color: var(--link); text-decoration: underline; text-underline-offset: 2px; } +a:hover { color: var(--link-hover); } +.brand, .nav-links a { text-decoration: none; } +.nav-links a:hover, .nav-links a:focus { text-decoration: underline; } + +main { display: block; } +.prose { padding-block: 2rem; } +.prose h1 { font-size: 2rem; line-height: 1.25; margin: 0 0 1rem; } +.prose h2 { font-size: 1.5rem; line-height: 1.3; margin: 2rem 0 .75rem; } +.prose h3 { font-size: 1.25rem; margin: 1.5rem 0 .5rem; } +.prose :is(h1,h2,h3,h4) { max-width: var(--measure); } + +/* Code */ +code { background: var(--bg-code); padding: .15em .35em; border-radius: 4px; font-size: .9em; } +pre { background: var(--bg-code); padding: 1rem; border-radius: var(--radius); overflow-x: auto; } +pre code { background: none; padding: 0; } + +/* Tables — caption + scoped headers handled in markup; styling here. */ +.prose table { border-collapse: collapse; width: 100%; max-width: 100%; margin: 1rem 0; } +.prose caption { text-align: left; font-weight: 600; color: var(--fg-muted); padding: .5rem 0; } +.prose th, .prose td { border: 1px solid var(--border); padding: .5rem .75rem; text-align: left; } +.prose th { background: var(--bg-soft); } + +blockquote { + margin: 1rem 0; padding: .5rem 1rem; border-left: 4px solid var(--border); + color: var(--fg-muted); background: var(--bg-soft); +} + +img { max-width: 100%; height: auto; } +hr { border: none; border-top: 1px solid var(--border); margin: 2rem 0; } + +.muted { color: var(--fg-muted); } + +.site-footer { border-top: 1px solid var(--border); margin-top: 3rem; padding-block: 1.5rem; color: var(--fg-muted); font-size: .95rem; } +.site-footer a { color: var(--link); } + +/* 2.3.3 / user comfort: honour reduced-motion. */ +@media (prefers-reduced-motion: reduce) { + *, *::before, *::after { animation-duration: .001ms !important; animation-iteration-count: 1 !important; transition-duration: .001ms !important; scroll-behavior: auto !important; } +} + +/* 1.4.10 reflow: stack nav on narrow viewports, no fixed widths. */ +@media (max-width: 30rem) { + .nav { gap: .5rem; } + body { font-size: 1rem; } +} diff --git a/docs/ACCESSIBILITY-CHECKLIST.adoc b/docs/ACCESSIBILITY-CHECKLIST.adoc new file mode 100644 index 0000000..47c4321 --- /dev/null +++ b/docs/ACCESSIBILITY-CHECKLIST.adoc @@ -0,0 +1,61 @@ +// SPDX-License-Identifier: CC-BY-SA-4.0 +// Copyright (c) 2025-2026 Jonathan D.A. Jewell += Accessibility Conformance — casket-ssg / ddraig-ssg +:toc: macro + +This SSG aims to be *WCAG 2.2 Level AAA-capable*: the engine and its default +theme provide everything an engine can own toward AAA, but *AAA conformance is +a property of each published page*, and several success criteria are +inherently the author's responsibility. There is no "WCAG 2.3"; 2.2 is the +current W3C Recommendation and 3.0 is a draft. + +toc::[] + +== Engine-owned (handled by the engine + default theme) + +[cols="1,3",options="header"] +|=== +| WCAG 2.2 SC | How it is met + +| 1.3.1 Info & Relationships (A) | Semantic HTML5 landmarks (`header`/`nav`/`main`/`footer`), heading hierarchy, lists, `` + `` on generated tables. +| 1.4.1 Use of Colour (A) | Links are underlined, not colour-only. +| 1.4.3 Contrast (AA) / 1.4.6 Contrast Enhanced (AAA) | Default palette is contrast-verified ≥ 7:1 for all text (light & dark): body 17.1:1, muted 10.7:1, links 9.9:1. +| 1.4.10 Reflow (AA) | Fluid layout, `rem` units, `overflow-wrap`, no fixed widths — no horizontal scroll at 320px. +| 1.4.11 Non-text Contrast (AA) | UI borders / focus ring ≥ 3:1. +| 1.4.12 Text Spacing (AA) | `line-height` 1.6, paragraph spacing, no clipping on user overrides. +| 2.1.1 Keyboard (A) | No scripted traps; native focusable elements only. +| 2.4.1 Bypass Blocks (A) | "Skip to content" link in every layout; `main#main`. +| 2.4.7 Focus Visible (AA) / 2.4.11 Focus Not Obscured (AA) / 2.4.13 Focus Appearance (AAA) | Thick (3px) offset `:focus-visible` outline, ≥ 3:1, never removed. +| 2.5.5 Target Size (AAA) / 2.5.8 (AA) | Interactive nav targets ≥ 44×44 px. +| 2.3.3 Animation from Interactions (AAA) | `prefers-reduced-motion` honoured. +| 3.1.1 Language of Page (A) | ``. +| 4.1.2 Name, Role, Value (A) | Native elements + `aria-label` on nav landmark. +|=== + +== Author-owned (you MUST satisfy these per page/site — no engine can guarantee them) + +[cols="1,3",options="header"] +|=== +| WCAG 2.2 SC | What you must do + +| 1.1.1 Non-text Content (A) | Provide meaningful `alt` for every informative image (`![meaningful description](…)`); use `alt=""` only for decorative images. +| 1.2.x Time-based Media (A–AAA) | Provide captions, transcripts, audio description, and (AAA 1.2.6) sign-language for any audio/video you embed. +| 1.4.5 / 1.4.9 Images of Text (AA/AAA) | Do not put text in images; use real text. AAA (1.4.9) allows no exceptions except logotypes. +| 2.4.9 Link Purpose, Link Only (AAA) | Write link text that makes sense out of context — avoid "click here"/"read more". +| 2.4.10 Section Headings (AAA) | Organise content with descriptive headings in logical order (don't skip levels). +| 3.1.2 Language of Parts (AA) | Mark inline foreign-language phrases with `lang` (raw-HTML ``). +| 3.1.3 Unusual Words / 3.1.4 Abbreviations / 3.1.6 Pronunciation (AAA) | Provide definitions/glossary; expand abbreviations on first use. +| 3.1.5 Reading Level (AAA) | Keep prose at lower-secondary reading level, or supply a simpler alternative. +| 2.3.1 Three Flashes (A) / 2.3.2 (AAA) | Do not embed flashing content. +| Heading order / colour in custom CSS | If you override the theme palette, re-verify ≥ 7:1; if you author custom HTML, keep one `

    ` and a logical heading order. +|=== + +== Verifying a build + +* Markup validity: `java -jar vnu.jar --also-check-css /**/*.html` +* Contrast: recompute any custom colours to ≥ 7:1 (AAA) before shipping. +* Manual: keyboard-only walkthrough (Tab order, visible focus, skip link), and a screen-reader pass on key pages. + +Automated DOM checkers (axe, pa11y) are Node tools and are not used here +(npm/Node is banned estate-wide); the W3C Nu validator (`vnu.jar`, Java) covers +markup, and the remaining AAA criteria are reviewed manually against this list. diff --git a/src/CasketGnosis.hs b/src/CasketGnosis.hs index 1eb919b..4b7f2ea 100644 --- a/src/CasketGnosis.hs +++ b/src/CasketGnosis.hs @@ -7,14 +7,39 @@ License : MPL-2.0 Maintainer : hyperpolymath Casket-SSG with Gnosis integration for 6scm metadata-driven static sites. + +This is a full-featured static site generator built on Pandoc: + + * recursive multi-page build mirroring the source tree into the output; + * YAML-ish frontmatter (title, date, description, layout, draft, tags, + slug, plus arbitrary keys exposed as template vars); + * rich Markdown via Pandoc (anchors, pipe tables, fenced code, footnotes, + task lists, strikethrough, smart punctuation) with syntax highlighting; + * file-based templates with per-page @layout@ selection and partials; + * a site-wide config file (@site.conf@, simple @key = value@) exposed as + @{{site.*}}@ template vars; + * collections (a directory index sorted by date) and per-tag pages; + * @sitemap.xml@ and an Atom @feed.xml@ built from @site.baseurl@; + * optional clean URLs (@foo.md@ -> @foo/index.html@). + +The Gnosis layer ((:placeholder) rendering, {{#if}}/{{#for}} DAX, 6scm +metadata) is preserved and runs over the Markdown body before Pandoc. -} module Main where -import System.Environment (getArgs) -import System.Directory (listDirectory, createDirectoryIfMissing, doesFileExist) -import System.FilePath ((), takeBaseName, takeExtension) -import Control.Monad (forM_) +import System.Environment (getArgs, lookupEnv) +import System.Directory + ( listDirectory, createDirectoryIfMissing, doesFileExist + , doesDirectoryExist, copyFile, removeDirectoryRecursive ) +import System.FilePath + ( (), takeBaseName, takeExtension, takeDirectory + , splitDirectories, joinPath ) +import Control.Monad (forM_, forM, when, unless, filterM) +import Data.List (isPrefixOf, sortBy, nub, intercalate, foldl') +import Data.Maybe (fromMaybe, mapMaybe, catMaybes) +import Data.Ord (comparing, Down(..)) +import Data.Char (toLower, isSpace, isAlphaNum) import qualified Gnosis.SixSCM as Gnosis import qualified Gnosis.Render as Render @@ -22,38 +47,116 @@ import qualified Gnosis.DAX as DAX import qualified Gnosis.Types as Types import qualified Data.Map.Strict as Map import qualified Text.Pandoc as Pandoc +import Text.Pandoc.Options (HighlightMethod(Skylighting)) +import qualified Text.Pandoc.Highlighting as Highlighting import qualified Data.Text as T --- | Main entry point for casket-ssg with Gnosis +-- --------------------------------------------------------------------------- +-- Build configuration +-- --------------------------------------------------------------------------- + +-- | Site-wide configuration, parsed from @site.conf@ and merged with defaults. +type SiteConfig = Map.Map String String + +-- | Options governing a single build run. +data BuildOpts = BuildOpts + { optIncludeDrafts :: !Bool -- ^ Emit @draft: true@ pages too. + , optCleanUrls :: !Bool -- ^ foo.md -> foo/index.html. + } + +-- | The fully-parsed representation of one source page. +data Page = Page + { pgSrcPath :: !FilePath -- ^ Source @.md@ path. + , pgRelHtml :: !FilePath -- ^ Output path relative to out root. + , pgUrl :: !String -- ^ Site-absolute URL (e.g. @/posts/x/@). + , pgMeta :: !(Map.Map String String) -- ^ Frontmatter key/value map. + , pgBody :: !String -- ^ Markdown body (frontmatter stripped). + , pgHtml :: !String -- ^ Rendered HTML fragment (no layout). + , pgToc :: !String -- ^ Table-of-contents HTML fragment. + , pgTitle :: !String -- ^ Resolved title. + , pgDate :: !String -- ^ Resolved date (may be empty). + , pgTags :: ![String] -- ^ Parsed tags. + , pgDraft :: !Bool -- ^ True if @draft: true@. + } + +-- --------------------------------------------------------------------------- +-- Entry point +-- --------------------------------------------------------------------------- + +-- | Main entry point for casket-ssg with Gnosis. main :: IO () main = do args <- getArgs case args of - ["build", inputDir, outputDir] -> do - buildSiteWithGnosis inputDir outputDir - - ["build", inputDir] -> do - buildSiteWithGnosis inputDir "_site" - - ["--version"] -> - putStrLn "Casket-SSG v1.0.0 with Gnosis integration" - - _ -> do - putStrLn "Casket-SSG - Metadata-driven static site generator" - putStrLn "" - putStrLn "Usage:" - putStrLn " casket-ssg build [output-dir]" - putStrLn " casket-ssg --version" - putStrLn "" - putStrLn "Features:" - putStrLn " - 6scm metadata integration" - putStrLn " - (:placeholder) rendering" - putStrLn " - FlexiText accessibility" - putStrLn " - Markdown processing" - --- | Build site with Gnosis metadata integration -buildSiteWithGnosis :: FilePath -> FilePath -> IO () -buildSiteWithGnosis inputDir outputDir = do + ("build" : rest) -> do + let (flags, positional) = span ("--" `isPrefixOf`) rest + opts <- mkBuildOpts flags + case positional of + [inputDir, outputDir] -> buildSiteWithGnosis opts inputDir outputDir + [inputDir] -> buildSiteWithGnosis opts inputDir "_site" + _ -> usage + + ["clean", outputDir] -> cleanOutput outputDir + ["clean"] -> cleanOutput "_site" + + ["--version"] -> putStrLn "Casket-SSG v1.0.0 with Gnosis integration" + ["version"] -> putStrLn "Casket-SSG v1.0.0 with Gnosis integration" + + _ -> usage + +-- | Resolve build options from CLI flags and environment. +mkBuildOpts :: [String] -> IO BuildOpts +mkBuildOpts flags = do + envDrafts <- lookupEnv "CASKET_DRAFTS" + let flagDrafts = "--drafts" `elem` flags + envOn = maybe False ((`elem` ["1", "true", "yes"]) . map toLower) envDrafts + noClean = "--no-clean-urls" `elem` flags + return BuildOpts + { optIncludeDrafts = flagDrafts || envOn + , optCleanUrls = not noClean + } + +-- | Print usage / help. +usage :: IO () +usage = mapM_ putStrLn + [ "Casket-SSG - Metadata-driven static site generator" + , "" + , "Usage:" + , " casket-ssg build [flags] [output-dir] Build the site (default out: _site)" + , " casket-ssg clean [output-dir] Remove the output directory" + , " casket-ssg --version Print version" + , "" + , "Build flags:" + , " --drafts Include pages marked 'draft: true' (or set CASKET_DRAFTS=1)" + , " --no-clean-urls Emit foo.html instead of foo/index.html" + , "" + , "Features:" + , " - Recursive multi-page build mirroring the source tree" + , " - Frontmatter: title, date, description, layout, draft, tags, slug, + custom keys" + , " - Rich Markdown via Pandoc: anchors, tables, fenced code, footnotes, task lists," + , " strikethrough, smart punctuation, syntax highlighting (/assets/highlight.css)" + , " - Templates in templates/ with per-page 'layout' and partials ({{> name}})" + , " - Site config (site.conf) exposed as {{site.*}}; {{nav}} and {{toc}}" + , " - Collections (directory index by date) and per-tag pages (/tags//)" + , " - sitemap.xml and Atom feed.xml from site.baseurl" + , " - 6scm metadata, (:placeholder) rendering, {{#if}}/{{#for}} DAX, FlexiText" + ] + +-- | @clean@ command: remove the output directory if present. +cleanOutput :: FilePath -> IO () +cleanOutput outputDir = do + exists <- doesDirectoryExist outputDir + if exists + then removeDirectoryRecursive outputDir >> putStrLn ("Removed " ++ outputDir) + else putStrLn (outputDir ++ " does not exist; nothing to clean.") + +-- --------------------------------------------------------------------------- +-- Build orchestration +-- --------------------------------------------------------------------------- + +-- | Build site with Gnosis metadata integration. +buildSiteWithGnosis :: BuildOpts -> FilePath -> FilePath -> IO () +buildSiteWithGnosis opts inputDir outputDir = do putStrLn "Casket-SSG: Building site with Gnosis metadata integration" putStrLn $ " Input: " ++ inputDir putStrLn $ " Output: " ++ outputDir @@ -63,117 +166,780 @@ buildSiteWithGnosis inputDir outputDir = do ctx <- Gnosis.loadAll6SCM scmPath putStrLn $ " Loaded 6scm context from: " ++ scmPath - -- Create output directory + -- Load site config (input-root or CWD), merged with sensible defaults. + site <- loadSiteConfig inputDir + putStrLn $ " Site title: " ++ siteVar site "title" + putStrLn $ " Base URL: " ++ siteVar site "baseurl" + createDirectoryIfMissing True outputDir - -- Find all markdown files - files <- listDirectory inputDir - let mdFiles = filter (\f -> takeExtension f `elem` [".md", ".markdown"]) files + -- Discover all markdown sources recursively. + srcFiles <- findMarkdown inputDir + putStrLn $ "Found " ++ show (length srcFiles) ++ " markdown source(s)." - if null mdFiles - then putStrLn "No markdown files found." - else do - putStrLn $ "Found " ++ show (length mdFiles) ++ " markdown files:" - forM_ mdFiles $ \file -> do - let inputPath = inputDir file - let outputPath = outputDir takeBaseName file ++ ".html" - processFileWithGnosis ctx inputPath outputPath + -- Parse + render every page (frontmatter, Gnosis, Pandoc, TOC). + allPages <- forM srcFiles $ \src -> renderPage opts ctx inputDir src + + -- Draft filtering happens AFTER render so we can report what was skipped. + let (drafts, live) = span' pgDraft allPages + publishable = if optIncludeDrafts opts then allPages else live + unless (optIncludeDrafts opts) $ + forM_ drafts $ \p -> putStrLn $ " (skipped draft) " ++ pgSrcPath p + + -- Build nav once (config-driven, with a generated fallback). + let navHtml = buildNav site publishable + + -- Write every page through its chosen layout. + forM_ publishable $ \p -> do + putStrLn $ " " ++ pgSrcPath p ++ " -> " ++ (outputDir pgRelHtml p) + writePage ctx site navHtml outputDir p + + -- Collections: a list page for any directory containing >1 dated page. + collectionIndexes <- writeCollections ctx site navHtml inputDir outputDir opts publishable + + -- Tag pages under /tags//. + tagPages <- writeTagPages ctx site navHtml outputDir opts publishable + + -- Feeds + discovery from the full publishable set (+ generated indexes). + let discoverable = publishable ++ collectionIndexes ++ tagPages + writeSitemap site outputDir discoverable + writeFeed site outputDir publishable + + -- Theme assets, highlight CSS, and public/ verbatim. + copyAssets outputDir + writeHighlightCss outputDir + copyPublic inputDir outputDir putStrLn "Build complete!" + where + -- partition preserving order: (matching, non-matching) + span' f = foldr (\x (ys, ns) -> if f x then (x:ys, ns) else (ys, x:ns)) ([], []) --- | Process a single file with Gnosis rendering -processFileWithGnosis :: Types.Context -> FilePath -> FilePath -> IO () -processFileWithGnosis ctx inputPath outputPath = do - putStrLn $ " " ++ inputPath ++ " -> " ++ outputPath +-- --------------------------------------------------------------------------- +-- Source discovery +-- --------------------------------------------------------------------------- - -- Read template file - content <- readFile inputPath +-- | Recursively collect every @.md@/@.markdown@ file under a directory, +-- skipping the @public/@ tree (copied verbatim) and dotfiles. +findMarkdown :: FilePath -> IO [FilePath] +findMarkdown root = go root + where + go dir = do + entries <- listDirectory dir + fmap concat $ forM (filter (not . ("." `isPrefixOf`)) entries) $ \e -> do + let p = dir e + isDir <- doesDirectoryExist p + if isDir + then if e == "public" then return [] else go p + else return [p | takeExtension p `elem` [".md", ".markdown"]] - -- Parse frontmatter and content - let (frontmatter, bodyContent) = parseFrontmatter content +-- --------------------------------------------------------------------------- +-- Page rendering +-- --------------------------------------------------------------------------- - -- Merge frontmatter into context (frontmatter takes precedence) - let mergedCtx = mergeFrontmatter ctx frontmatter +-- | Parse, Gnosis-process, Pandoc-render a single source file into a 'Page'. +renderPage :: BuildOpts -> Types.Context -> FilePath -> FilePath -> IO Page +renderPage opts ctx inputDir src = do + raw <- readFile src + let (frontmatter, body) = parseFrontmatter raw + mergedCtx = mergeFrontmatter ctx frontmatter + title = Map.findWithDefault (takeBaseName src) "title" frontmatter + date = Map.findWithDefault "" "date" frontmatter + tags = parseList (Map.findWithDefault "" "tags" frontmatter) + draft = boolVal (Map.findWithDefault "false" "draft" frontmatter) + rel = relOutputPath opts inputDir src frontmatter - -- Get page title from frontmatter or fallback to filename - let pageTitle = Map.findWithDefault (takeBaseName inputPath) "title" frontmatter + -- Gnosis pipeline over the markdown source (DAX loops/ifs, then placeholders). + let withDAX = DAX.processTemplate mergedCtx body + withPlaceholders = Render.renderWithBadges mergedCtx withDAX - -- Step 1: Process DAX features first ({{#if}}, {{#for}}) - -- This expands loops with literal values and evaluates conditionals - let withDAX = DAX.processTemplate mergedCtx bodyContent + (html, toc) <- markdownToHtml withPlaceholders - -- Step 2: Apply Gnosis rendering ((:placeholder)) - -- This renders remaining 6scm placeholders and applies filters - let withPlaceholders = Render.renderWithBadges mergedCtx withDAX + return Page + { pgSrcPath = src + , pgRelHtml = rel + , pgUrl = urlForRel opts rel + , pgMeta = frontmatter + , pgBody = body + , pgHtml = html + , pgToc = toc + , pgTitle = title + , pgDate = date + , pgTags = tags + , pgDraft = draft + } - -- Step 3: Convert Markdown to HTML using Pandoc - htmlContent <- markdownToHtml withPlaceholders +-- | Output path (relative to out root) for a source file. Honours @slug@, +-- index files, and the clean-URLs toggle. +relOutputPath :: BuildOpts -> FilePath -> FilePath -> Map.Map String String -> FilePath +relOutputPath opts inputDir src fm = + let relDir = makeRelative inputDir (takeDirectory src) + base0 = takeBaseName src + base = fromMaybe base0 (Map.lookup "slug" fm) + isIndex = base == "index" + in if isIndex + then normJoin relDir "index.html" + else if optCleanUrls opts + then normJoin relDir (base "index.html") + else normJoin relDir (base ++ ".html") + where + normJoin "" f = f + normJoin "." f = f + normJoin d f = d f - -- Step 4: Wrap in simple HTML template - let html = wrapInTemplate pageTitle htmlContent +-- | The site-absolute URL for a relative output path. +urlForRel :: BuildOpts -> FilePath -> String +urlForRel _ rel = + let parts = splitDirectories rel + in case reverse parts of + ("index.html" : rest) -> "/" ++ intercalate "/" (reverse rest) ++ slash (reverse rest) + _ -> "/" ++ intercalate "/" parts + where + slash [] = "" + slash _ = "/" - -- Write output - writeFile outputPath html +-- | Compute a path relative to a base directory (simple prefix strip). +makeRelative :: FilePath -> FilePath -> FilePath +makeRelative base path = + let b = splitDirectories base + p = splitDirectories path + in if b `isPrefixOf` p then joinPath (drop (length b) p) else path --- | Convert Markdown to HTML using Pandoc -markdownToHtml :: String -> IO String +-- --------------------------------------------------------------------------- +-- Markdown -> HTML (Pandoc) with TOC and highlighting +-- --------------------------------------------------------------------------- + +-- | Convert Markdown to (HTML body, TOC HTML) using Pandoc with a strong +-- extension set, auto heading IDs, syntax highlighting and a table of contents. +markdownToHtml :: String -> IO (String, String) markdownToHtml markdown = do let readerOpts = Pandoc.def - let writerOpts = Pandoc.def - result <- Pandoc.runIOorExplode $ do + { Pandoc.readerExtensions = Pandoc.pandocExtensions } + bodyOpts = Pandoc.def + { Pandoc.writerExtensions = Pandoc.pandocExtensions + , Pandoc.writerHighlightMethod = Skylighting Highlighting.pygments + } + -- A Pandoc template that emits ONLY the table of contents (wrapped in a + -- nav). $body$ is intentionally omitted so the page body is never doubled. + -- compileTemplate must run in plain IO (it has no PandocIO instance). + tmplResult <- Pandoc.compileTemplate "" + (T.pack "$if(toc)$$endif$") + tmpl <- either (fail . ("TOC template error: " ++)) return tmplResult + (body, toc) <- Pandoc.runIOorExplode $ do doc <- Pandoc.readMarkdown readerOpts (T.pack markdown) - Pandoc.writeHtml5String writerOpts doc - return (T.unpack result) + -- Body fragment (no standalone template): rich HTML with anchors, + -- tables, fenced highlighted code, footnotes, task lists, etc. + bodyTxt <- Pandoc.writeHtml5String bodyOpts doc + -- A standalone render whose ONLY output is the table of contents, + -- so we can expose {{toc}} independently of the page body. + let tocOpts = bodyOpts + { Pandoc.writerTableOfContents = True + , Pandoc.writerTemplate = Just tmpl + } + tocTxt <- Pandoc.writeHtml5String tocOpts doc + return (T.unpack bodyTxt, T.unpack (T.strip tocTxt)) + return (addThScope body, toc) + +-- | Add @scope="col"@ to every table header cell that lacks an explicit +-- @scope@. Pandoc emits @\@ / @\@ without a scope, which +-- weakens WCAG 1.3.1 (Info & Relationships) for screen-reader table navigation. +-- This is a conservative string rewrite over the rendered body HTML: +-- +-- * @\@ -> @\@ +-- * @\@ -> @\@ +-- * @\@ -> left untouched (never double-added) +-- +-- Captions emitted by Pandoc (@\@) are preserved as-is. +addThScope :: String -> String +addThScope = go + where + go [] = [] + go s@(c:cs) + -- Match an opening "'. This avoids matching + -- "') after + in if hasScope attrs + then "' + -- immediately, or attribute whitespace. + startsTag (x:_) = x == '>' || x == ' ' || x == '\t' || x == '\n' || x == '\r' || x == '/' + startsTag [] = False + + -- Detect an existing scope attribute within the gathered attribute text. + hasScope attrs = "scope=" `isInfixOfStr` attrs + isInfixOfStr n h = any (n `isPrefixOf`) (tailsS h) + tailsS [] = [[]] + tailsS s@(_:xs) = s : tailsS xs + +-- --------------------------------------------------------------------------- +-- Templates & partials +-- --------------------------------------------------------------------------- + +-- | Load a named layout from @templates/@, falling back to +-- @templates/default.html@ and then the built-in template. +loadLayout :: String -> IO String +loadLayout layout = do + let name = if "." `isInfixOfStr` layout then layout else layout ++ ".html" + path = "templates" name + defPath = "templates" "default.html" + hasLayout <- doesFileExist path + if hasLayout + then expandPartials =<< readFile path + else do + hasDef <- doesFileExist defPath + if hasDef then expandPartials =<< readFile defPath + else return builtinTemplate + where isInfixOfStr n h = any (n `isPrefixOf`) (tails' h) + tails' [] = [[]] + tails' s@(_:xs) = s : tails' xs + +-- | Expand partial includes: @{{> name}}@ or @{{include:name}}@ read +-- @templates/partials/.html@. One level deep is enough for our needs, +-- but we recurse so partials may include partials. +expandPartials :: String -> IO String +expandPartials = go (0 :: Int) + where + go depth s + | depth > 8 = return s -- guard against include cycles + | otherwise = do + case findPartial s of + Nothing -> return s + Just (before, name, after) -> do + frag <- loadPartial name + rest <- go (depth + 1) after + return (before ++ frag ++ rest) + + -- Find the first {{> name}} or {{include:name}} token. + findPartial s = case scan s of + Just (b, tok, a) -> Just (b, tok, a) + Nothing -> Nothing + where + scan str = look "" str + look acc str + | "{{>" `isPrefixOf` str = + let inner = drop 3 str + (tok, rest) = breakClose inner + in Just (reverse acc, trimStr tok, rest) + | "{{include:" `isPrefixOf` str = + let inner = drop 10 str + (tok, rest) = breakClose inner + in Just (reverse acc, trimStr tok, rest) + | otherwise = case str of + (c:cs) -> look (c:acc) cs + [] -> Nothing + breakClose str = case breakOnStr "}}" str of + Just (b, a) -> (b, drop 2 a) + Nothing -> (str, "") + + loadPartial name = do + let path = "templates" "partials" (name ++ ".html") + exists <- doesFileExist path + if exists then readFile path + else return ("") + +-- --------------------------------------------------------------------------- +-- Page emission +-- --------------------------------------------------------------------------- + +-- | Render and write a single page through its layout. +writePage :: Types.Context -> SiteConfig -> String -> FilePath -> Page -> IO () +writePage _ctx site navHtml outputDir p = do + let layout = Map.findWithDefault "default" "layout" (pgMeta p) + template <- loadLayout layout + let html = fillTemplate site navHtml p template + outPath = outputDir pgRelHtml p + createDirectoryIfMissing True (takeDirectory outPath) + writeFile outPath html + +-- | Fill a template for a page: all frontmatter keys, the standard vars, +-- site.* vars, nav and toc, with {{content}} substituted last. +fillTemplate :: SiteConfig -> String -> Page -> String -> String +fillTemplate site navHtml p template = + let brand = Map.findWithDefault (siteVar site "title") "site" + (Map.insert "site" (Map.findWithDefault "" "site" (pgMeta p)) (pgMeta p)) + brand' = if null brand then pgTitle p else brand + -- 1. site.* config vars + s1 = foldl' (\t (k, v) -> replaceAll ("{{site." ++ k ++ "}}") v t) template (Map.toList site) + -- 2. arbitrary frontmatter keys (skip content/title/brand/date handled below) + s2 = foldl' (\t (k, v) -> replaceAll ("{{" ++ k ++ "}}") v t) s1 + (Map.toList (Map.delete "content" (pgMeta p))) + -- Collapse the canonical "" idiom to valid HTML: + -- an empty