From f1e30047af67ae6a1827c625c0327609976c1d1d Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 25 Jul 2023 20:51:44 +0100
Subject: doc: Add docstring-function-documentation.

docstring-function-documentation lets us generate function
documentation from the docstrings of functions.

* doc/skribilo.scm: Import (texinfo).
(<function>): New record type.
(find-function-definition, stexi->skribe): New functions.
(docstring-function-documentation): New public function.
---
 doc/skribilo.scm | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 50 insertions(+), 1 deletion(-)

diff --git a/doc/skribilo.scm b/doc/skribilo.scm
index a666eed..45f35a8 100644
--- a/doc/skribilo.scm
+++ b/doc/skribilo.scm
@@ -27,6 +27,7 @@
   #:use-module (srfi srfi-171)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (texinfo)
   #:use-module (skribilo ast)
   #:use-module (skribilo engine)
   #:use-module (skribilo lib)
@@ -41,7 +42,8 @@
             scheme-source-form
             source-ref
             record-documentation
-            record-field))
+            record-field
+            docstring-function-documentation))
 
 ;; Constants
 (define %source-uri-base
@@ -291,6 +293,53 @@ are a list of <record-field> objects."
                                 (record-field-documentation documented-field))))
                       fields)))))
 
+(define-record-type <function>
+  (function name arguments docstring)
+  function?
+  (name function-name)
+  (arguments function-arguments)
+  (docstring function-docstring))
+
+(define (find-function-definition file name)
+  "Return a @code{<function>} object describing a function named
+@var{name} in @var{file}."
+  (call-with-input-file file
+    (cut port-transduce
+         (tmap identity)
+         (rany (match-lambda
+                 (((or 'define 'define* 'define-lazy)
+                   ((? (cut eq? name <>)) arguments ...)
+                    docstring
+                    body ...)
+                  (function name arguments docstring))
+                 (_ #f)))
+         read
+         <>)))
+
+(define (stexi->skribe stexi)
+  "Convert @var{stexi}, a stexinfo tree, to a skribe tree."
+  (match stexi
+    (('*fragment* children ...)
+     (map stexi->skribe children))
+    (('para children ...)
+     (cons 'paragraph children))))
+
+(define (docstring-function-documentation file name)
+  "Document function of @var{name} from @var{file} using its docstring."
+  (let ((function (or (find-function-definition file name)
+                      (error "Function not found in file:" name file))))
+    (item #:key (code (list "("
+                            (bold (symbol->string name))
+                            (unless (null? (function-arguments function))
+                              " ")
+                            (string-join (map expression->string
+                                              (function-arguments function)))
+                            ")"))
+          (map (cut eval <> (current-module))
+               (stexi->skribe
+                (texi-fragment->stexi
+                 (function-docstring function)))))))
+
 ;; HTML engine customizations
 (let ((html-engine (find-engine 'html)))
   (engine-custom-set! html-engine 'css "/style.css")
-- 
cgit v1.2.3