From 5ee1c8b006e820489cd42b6630a8dc3a7105b672 Mon Sep 17 00:00:00 2001
From: valentin gagarin <valentin.gagarin@tweag.io>
Date: Wed, 13 Nov 2024 15:24:41 +0100
Subject: [PATCH] implement sectioning semantics

this was quite a beast to tame, but it now allows putting sections anywhere
in the tree without having to redundantly specify heading levels, which
will be computed automatically from the nesting depth.

the whole thing will also blow up if the maximum section nesting depth
is exceeded, just as the spec requires - albeit with an absolutely
impenetrable error message. this could in principle be improved with
lots of additional machinery, but this is by far not low-hanging fruit.

just don't nest your sections too much.
---
 website/presentation/default.nix |  28 ++++----
 website/presentation/dom.nix     | 120 ++++++++++++++++++++++++++++---
 2 files changed, 124 insertions(+), 24 deletions(-)

diff --git a/website/presentation/default.nix b/website/presentation/default.nix
index 9c78c0d..7410f3c 100644
--- a/website/presentation/default.nix
+++ b/website/presentation/default.nix
@@ -5,11 +5,13 @@ let
     types
     ;
   templates = import ./templates.nix { inherit lib; };
+  # TODO: optionally run the whole thing through the validator
+  # https://github.com/validator/validator
   render-html = document:
     let
       eval = lib.evalModules {
         class = "DOM";
-        modules = [ document (import ./dom.nix { inherit lib; }).document ];
+        modules = [ document (import ./dom.nix) ];
       };
     in
     toString eval.config;
@@ -53,13 +55,11 @@ in
             meta.description = page.description;
             link.canonical = lib.head page.locations;
           };
-          body.content = ''
-            ${config.menus.main.outputs.html page}
-
-            <h1>${page.title}</h1>
-
-            ${builtins.readFile (commonmark page.name page.body)}
-          '';
+          body.content = [
+            (config.menus.main.outputs.html page)
+            { section.heading.content = page.title; }
+            (builtins.readFile (commonmark page.name page.body))
+          ];
         };
       });
       article = lib.mkDefault (config: page: render-html {
@@ -70,13 +70,11 @@ in
             meta.authors = if lib.isList page.author then page.author else [ page.author ];
             link.canonical = lib.head page.locations;
           };
-          body.content = ''
-            ${config.menus.main.outputs.html page}
-
-            <h1>${page.title}</h1>
-
-            ${builtins.readFile (commonmark page.name page.body)}
-          '';
+          body.content = [
+            (config.menus.main.outputs.html page)
+            { section.heading.content = page.title; }
+            (builtins.readFile (commonmark page.name page.body))
+          ];
         };
       });
     };
diff --git a/website/presentation/dom.nix b/website/presentation/dom.nix
index 7e52a81..0f583b7 100644
--- a/website/presentation/dom.nix
+++ b/website/presentation/dom.nix
@@ -5,8 +5,9 @@
   Inspired by https://github.com/knupfer/type-of-html by @knupfer (BSD-3-Clause)
   Similar work from the OCaml ecosystem: https://github.com/ocsigen/tyxml
 */
-{ lib, ... }:
+{ config, lib, ... }:
 let
+  cfg = config;
   inherit (lib) mkOption types;
 
   # https://html.spec.whatwg.org/multipage/dom.html#content-models
@@ -25,8 +26,16 @@ let
     "scripting" # https://html.spec.whatwg.org/multipage/dom.html#script-supporting-elements
   ];
 
+  get-section-depth = content: with lib; foldl'
+    (acc: elem:
+      if isAttrs elem
+      then max acc (lib.head (attrValues elem)).section-depth
+      else acc # TODO: parse with e.g. https://github.com/remarkjs/remark to avoid raw strings
+    ) 0
+    content;
+
   # base type for all DOM elements
-  element = { name, config, ... }: {
+  element = { ... }: {
     # TODO: add fields for upstream documentation references
     # TODO: programmatically generate documentation
     options = with lib; {
@@ -40,6 +49,15 @@ let
     };
   };
 
+  # TODO: rename to something about sectioning
+  content-element = { ... }: {
+    options.section-depth = mkOption {
+      type = types.ints.unsigned;
+      default = 0;
+      internal = true;
+    };
+  };
+
   # options with types for all the defined DOM elements
   element-types = lib.mapAttrs
     (name: value: mkOption { type = types.submodule value; })
@@ -53,7 +71,7 @@ let
       (category:
         (mapAttrs (_: e: mkOption { type = types.submodule e; })
           # HACK: don't evaluate the submodule types, just grab the config directly
-          (filterAttrs (_: e: elem category (e { name = "dummy"; }).config.categories) elements))
+          (filterAttrs (_: e: elem category (e { name = "dummy"; config = { }; }).config.categories) elements))
       );
 
   global-attrs = lib.mapAttrs (name: value: mkOption value) {
@@ -140,6 +158,7 @@ let
           attrs)
       );
     in
+    if attrs == null then throw "wat" else
     optionalString (stringLength result > 0) " " + result
   ;
 
@@ -310,7 +329,7 @@ let
 
     link = { name, ... }: {
       imports = [ element ];
-      options = mkAttrs {
+      options = global-attrs // {
         # TODO: more attributes
         # https://html.spec.whatwg.org/multipage/semantics.html#the-link-element:concept-element-attributes
         inherit (attrs) href;
@@ -349,21 +368,104 @@ let
       config.__toString = self: "<link${print-attrs self}>";
     };
 
-    body = { name, ... }: {
-      imports = [ element ];
+    body = { config, name, ... }: {
+      imports = [ element content-element ];
       options = {
         attrs = mkAttrs { };
         content = mkOption {
           type = with types;
             # HACK: bail out for now
             # TODO: find a reasonable cut-off for where to place raw content
-            either str (listOf (attrTag categories.flow));
+            listOf (either str (attrTag categories.flow));
+          default = [ ];
         };
       };
+      config.section-depth = get-section-depth config.content;
       config.categories = [ ];
       config.__toString = self: with lib;
-        if isList self.content then join "\n" (toString self.content) else self.content;
+        print-element name self.attrs (
+          join "\n" (map
+            (e:
+              if isAttrs e
+              then toString (lib.head (attrValues e))
+              else e
+            )
+            self.content)
+        );
+    };
+    section = { config, name, ... }: {
+      imports = [ element content-element ];
+      options = {
+        # setting to an attribute set will wrap the section in <section>
+        attrs = mkOption {
+          type = with types; nullOr (submodule { options = global-attrs; });
+          default = null;
+        };
+        # TODO: make `pre-`/`post-heading` wrap the heading in `<hgroup>` if non-empty
+        # https://html.spec.whatwg.org/multipage/sections.html#the-hgroup-element
+        pre-heading = mkOption {
+          type = with types; listOf (attrTag ({ inherit p; } // categories.scripting));
+          default = [ ];
+        };
+        heading = mkOption {
+          type = with types; submodule ({ ... }: {
+            imports = [ element ];
+            options = {
+              attrs = mkAttrs { };
+              content = mkOption {
+                type = with types; either str (listOf (attrTag categories.phrasing));
+              };
+            };
+          });
+        };
+        post-heading = mkOption {
+          type = with types;
+            listOf (attrTag ({ inherit p; } // categories.scripting));
+          default = [ ];
+        };
+        # https://html.spec.whatwg.org/multipage/sections.html#headings-and-outlines
+        content = mkOption {
+          type = with types; listOf (either str (attrTag categories.flow));
+          default = [ ];
+        };
+      };
+      config.section-depth = get-section-depth config.content + 1;
+      options.heading-level = mkOption {
+        # XXX: this will proudly fail if the invariant is violated,
+        #      but the error message will be inscrutable
+        type = with types; ints.between 1 6;
+        internal = true;
+      };
+      config.heading-level = cfg.section-depth - config.section-depth + 1;
+      config.categories = [ "flow" "sectioning" "palpable" ];
+      config.__toString = self: with lib;
+        let
+          n = toString config.heading-level;
+          content =
+            "<h${n}${print-attrs self.heading.attrs}>${self.heading.content}</h${n}>" + join "\n" (map
+              (e:
+                if isAttrs e
+                then toString (lib.head (attrValues e))
+                else e
+              )
+              self.content);
+        in
+        if !isNull self.attrs
+        then print-element name self.attrs content
+        else content;
     };
   };
 in
-elements
+{
+  imports = [ element content-element ];
+  options = {
+    inherit (element-types) html;
+  };
+
+  config.section-depth = config.html.body.section-depth;
+  config.categories = [ ];
+  config.__toString = self: ''
+    <!DOCTYPE HTML >
+    ${self.html}
+  '';
+}