docs: autogenerate code part of table of contents

Change-Id: I6a6a6964ec580d2403029e21ce785da000830c3d

docs/docread/default.nix

@@ -5,6 +5,7 @@ eggDerivation {
 
   buildInputs = with chickenPackages.chickenEggs; [
     r7rs
+    srfi-132
     (pkgs.callPackage ../../core {})
   ];
 }

docs/docread/docread.egg

@@ -1,7 +1,7 @@
 ((version "0.0.1")
  (synopsis "read doc comments")
  (author "puck")
- (dependencies r7rs zilch)
+ (dependencies r7rs srfi-132 zilch)
  (component-options 
   (csc-options "-X" "r7rs" "-R" "r7rs" "-optimize-level" "3"))
  (components

docs/docread/docread.scm

@@ -1,4 +1,4 @@
-(import (scheme base) (scheme file) (scheme write) (chicken read-syntax) (chicken process-context) (chicken irregex) (chicken format) (chicken process) (chicken file) (zilch zexpr))
+(import (scheme base) (scheme file) (scheme write) (chicken read-syntax) (chicken process-context) (chicken irregex) (chicken format) (chicken process) (chicken file) (zilch zexpr) (srfi 132))
 
 ;; Return a string version of the passed-in val, but properly quoted as s-expression.
 (define (quotify val)
@@ -72,6 +72,35 @@
  (call-with-port (open-output-string)
   (lambda (p) (render-lambda-doc p doc) (get-output-string p))))
 
+(define table-of-contents
+ '(((zilch lang rust) . ())
+   ((zilch lang ninja) . ())
+   ((zilch lang go) . ())
+   ((zilch nix) . ())
+   ((zilch lib) . ())
+   ((zilch) . ())))
+
+; Returns whether `left` is a prefix of `right`.
+(define (is-prefix left right)
+  (define
+   res
+   (let loop ((left left) (right right))
+    (cond
+     ((and (null? left) (null? right)) #t)
+     ((null? left) #t)
+     ((null? right) #f)
+     ((equal? (car left) (car right)) (loop (cdr left) (cdr right)))
+     (else #f))))
+  res)
+
+(define (add-to-toc name path)
+  (let loop ((item table-of-contents))
+    (cond
+     ((null? item) (error "Unknown TOC root" name))
+     ((equal? name (caar item)) (set-cdr! (car item) (cons (sprintf "** xref:generated:~A[++~A++]\n" path name) (cdar item))))
+     ((is-prefix (caar item) name) (set-cdr! (car item) (cons (sprintf "*** xref:generated:~A[++~A++]\n" path name) (cdar item))))
+     (else (loop (cdr item))))))
+
 ;; Iterate over the contents of a define-library, and collect comments on certain defines.
 (define (parse-library-contents fname contents lib-comments)
     (define comments '())
@@ -141,10 +170,12 @@
                               (cdr j)))))
               contents)
 
-    (define out-path (string-append root "/docs/modules/generated/pages"))
     (define first #t)
-    (for-each (lambda (l) (set! out-path (string-append out-path (if first "/" ".") (symbol->string l))) (set! first #f)) (car contents))
-    (set! out-path (string-append out-path ".adoc"))
+    (define file-path "")
+    (for-each (lambda (l) (set! file-path (string-append file-path (if first "" ".") (symbol->string l))) (set! first #f)) (car contents))
+    (set! file-path (string-append file-path ".adoc"))
+    (define out-path (string-append root "/docs/modules/generated/pages/" file-path))
+    (add-to-toc (car contents) file-path)
 
     (define out-file (open-output-file out-path))
     ; Print out the comments
@@ -178,3 +209,14 @@
 
 
 (find-files root #:test ".*\\.(sld|scm)" #:action process-file)
+
+(call-with-output-file (string-append root "/docs/modules/generated/partials/nav.adoc")
+ (lambda (p)
+  (for-each
+   (lambda (chunk)
+    (define sorted (list-sort string<? (cdr chunk)))
+    (when (or (null? sorted) (not (string=? (string-copy (car sorted) 0 3) "** ")))
+     (fprintf p "** ++~A++\n" (car chunk)))
+    (for-each (lambda (line) (write-string line p)) sorted)
+    (write-string "\n" p))
+   (reverse table-of-contents))))