From 98c97ee570d7228ef486db41b542887124eb989b Mon Sep 17 00:00:00 2001
From: nik gaffney <nik@fo.am>
Date: Wed, 24 Aug 2022 13:16:39 +0200
Subject: [PATCH] help file parsers (for .scm and .schelp)

---
 util/schelp2scrbl.rkt | 344 ++++++++++++++++++++++++++++++++++++++++++
 util/scm2scrbl.rkt    | 166 ++++++++++++++++++++
 2 files changed, 510 insertions(+)
 create mode 100755 util/schelp2scrbl.rkt
 create mode 100755 util/scm2scrbl.rkt

diff --git a/util/schelp2scrbl.rkt b/util/schelp2scrbl.rkt
new file mode 100755
index 0000000..6fe469f
--- /dev/null
+++ b/util/schelp2scrbl.rkt
@@ -0,0 +1,344 @@
+#! /usr/bin/env racket
+#lang racket
+
+;; Parse .schelp files and convert to .scrbl
+;;
+;; Copyright (C) 2022 FoAM
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see http://www.gnu.org/licenses/
+
+
+;; Author(s)
+;;  - nik gaffney <nik@fo.am>
+
+
+;; Commentary
+;;
+;;  -> schelp -> racket (scribble)
+;;  This is a q&d parser to convert .schelp files to scribble with the
+;;  renaming seen in rsc3 (as closely as possible) adn should be usable
+;;  as part of the racket documentation system which uses the scribble
+;;  format as described at
+;;                    https://docs.racket-lang.org/scribble/index.html
+;;
+;;  partially complete. partially automated.
+
+
+(require parsack)
+
+;; cli options
+(define filename (make-parameter ""))
+(define verbose? (make-parameter #f))
+(define loglevel (make-parameter 0))
+;; help is relative (or not at all)
+(define help-path (make-parameter
+                   (path->string (current-directory))))
+(define output-path (make-parameter
+                     (path->string (current-directory))))
+
+(define getopt
+  (when (not (vector-empty?
+              (current-command-line-arguments))) ;; i.e. cli or not?
+    (command-line
+     #:program "schelp2scrbl"
+     #:once-each
+     (("-v" "--verbose")   "various verbose messages" (verbose? #t))
+     (("-l" "--loglevel")  level "level of verbosity (1->inf)" (loglevel level)) 
+     (("-p" "--help-path") folder "path to the directory containing help files" (help-path folder))
+     (("-o" "--output")    folder "path to write converted help files" (output-path folder))
+
+     #:args (input-file)
+     (filename input-file)
+     (if (file-exists? (filename))
+         (printf "Converting .schelp to scribble: ~a\n" (filename))
+         (raise-user-error 'scm2scrbl "File '~a' does not exist." (filename))))))
+
+;; echoing verbosity
+(define (verbose str #:level (n 0) . fmt )
+  (when (and (verbose?) (<= n (loglevel)))
+    (if (empty? fmt)
+        (printf str)
+        (apply printf str fmt))))
+
+;;;;;;; ; ;; ;;;;  ;;;;;    ;;  ;; ;
+;;
+;;  parsack parsers for SuperCollider help files
+;;  - fragile and error prone
+;;  - tags as seen in SCDoc/SCDoc.[ly]
+;;  - uses block:: to determine formatting
+;;  - name remapping (sc3->rsc3) may need another pass?
+;;  - minimal xref info
+;;  - no validation or recovery (vaguely informative $err)
+;;
+;;  the grammar is described in the yacc and lex files at
+;;   - https://github.com/supercollider/supercollider/blob/develop/SCDoc/SCDoc.y
+;;   - https://github.com/supercollider/supercollider/blob/develop/SCDoc/SCDoc.l
+;;
+;;;; ;; ;;   ;   
+
+
+;; block labels don't need to be explicitly closed (but sometimes are)
+(define $block-tag
+  (try (oneOfStringsAnyCase
+        "anchor::"
+        "argument::"
+        "categories::"
+        "class::"
+        "classmethods::"
+        "classtree::"
+        "code::"
+        "copymethod::"
+        "definitionlist::"
+        "description::"
+        "discussion::"
+        "examples::"
+        "footnote::"
+        "image::"
+        "instancemethods::"
+        "keyword::"
+        "list::"
+        "method::"
+        "note::"
+        "numberedlist::"
+        "private::"
+        "redirect::"
+        "related::"
+        "returns::"
+        "section::"
+        "subsection::"
+        "summary::"
+        "table::"
+        "title::"
+        "tree::"
+        "warning::")))
+
+;; inline stuff like 'emphasis' etc. (need to be explicitly closed)
+(define $inline-tag
+  (try (oneOfStringsAnyCase
+        "emphasis::"
+        "link::"
+        "soft::"
+        "strong::"
+        "teletype::")))
+
+;;  most of these 'sections' can use generic formatting (parsed via $section)
+;;  remove any specifics from this list when adding a specialised parser...
+
+(define $section-name
+  (try (oneOfStringsAnyCase
+        "anchor::"
+        "argument::"
+        "categories::"
+        "classmethods::"
+        "classtree::"
+        "copymethod::"
+        "definitionlist::"
+        "discussion::"
+        "examples::"
+        "footnote::"
+        "image::"
+        "instancemethods::"
+        "keyword::"
+        "list::"
+        "method::"
+        "note::"
+        "numberedlist::"
+        "private::"
+        "redirect::"
+        "related::"
+        "returns::"
+        "section::"
+        "subsection::"
+        "table::"
+        "tree::"
+        "warning::")))
+
+(define $endtag (try (string "::")))
+
+;; a line ends when it ends (and ignores inline tags)
+(define $line-terminator
+  (<?> (<or> $eol $newline)
+       "line terminator"))
+
+;; a block ends when it's closed with "::" or
+;; another another block starts, or it just ends...
+(define $block-terminator
+  (<?> (<or> (lookAhead $block-tag)
+             ;; $endtag ;; optional, but only after parsing inline tags
+             $eof)
+       "block terminator"))
+
+;; a line of zero or more characters
+(define $line
+  (manyUntil $anyChar $line-terminator))
+
+;; inline styling
+(define $markup
+  (parser-compose
+   (t <- $inline-tag)
+   (x <- (many $anyChar))
+   $endtag
+   (return (inline-markup t x))))
+
+(define $line-inline
+  (<or> $markup
+        $line))
+
+;; just unfomratted "for now" (dispatch on t to format x)
+(define  (inline-markup t x)
+  (verbose "markup: ~a~n" t #:level 1)
+  (format x))
+
+;; a block is multiple lines (etc...)
+(define $block
+  (parser-compose
+   (x <- (manyUntil $anyChar $block-terminator))
+   (return x)))
+
+;; specifics
+(define $title
+  (parser-compose
+   (oneOfStringsAnyCase "class::" "title::")
+   (x <- $line)
+   (return (format-title x))))
+
+(define $summary
+  (parser-compose
+   (oneOfStringsAnyCase "summary::")
+   (x <- $line)
+   (return (format-summary x))))
+
+(define $description
+  (parser-compose
+   (oneOfStringsAnyCase "description::")
+   (x <- $block)
+   (return (format-description x))))
+
+(define $code
+  (parser-compose
+   (oneOfStringsAnyCase  "code::")
+   (x <- $block)
+   (return (format-racketblock x))))
+
+;; generics
+(define $section
+  (parser-compose
+   (s <- $section-name) ;; catch undefined?
+   (x <- $block)
+   (return (format-block s x))))
+
+;; a help file usually starts with a title or class name followed by a new line
+;; then usually (zero or more) sections of text
+
+(define $schelp-file
+  (parser-seq
+   (many $title)
+   (many (<or> $summary
+               $description
+               $section
+               $code
+               $newline
+               ))
+   $eof))
+
+;; parse a string with given parser
+(define (parse->string p s)
+  (verbose "parse->string~n parser: ~a~n string: ~a~n" #:level 1)
+  (string-append (parse-result p s)))
+
+;;;;;;; ; ;; ;;;;;;;;;    ;;  ;; ;
+;;
+;;   scribbling & formatting
+;;
+;;;;; ;   ; ;  ;;;    ;
+
+;; any header or footer info required for the scribble file
+(define scribble-preamble
+  "#lang scribble/manual\n@(require (for-label racket))")
+
+(define scribble-postamble "")
+
+
+(define (format-summary s)
+  (verbose "format-summary: ~a~n" s  #:level 0)
+  (format "~a" (format-result s)))
+
+(define (format-description s)
+  (verbose "format-description: ~a~n" s #:level 0)
+  (format "@section{description}~n~a" (format-result s)))
+
+;; wrap codeblock
+(define (format-racketblock a . z)
+  (verbose "format-racketblock: ~a~n" (cons a z) #:level 0)
+  (format "~n@racketblock[~a]~n" (format-result (cons a z))))
+
+;; wrap title
+(define (format-title s)
+  (verbose "format-title: ~a~n" s #:level 0)
+  (format "~n@title{~a}~n" (string-trim (format-result s))))
+
+;; generic text
+(define (format-block s x)
+  (verbose "format-block: ~a :: ~a~n" s x #:level 0)
+  (format "~a ~a"  (format-section-name s) (format-result x)))
+
+(define (format-result l)
+  (verbose "format-result: ~s~n" l  #:level 2)
+  (string-trim 
+   (foldl (lambda (e acc)
+            (cond
+              ((string? e) (string-append acc e))
+              ((char? e) (string-append acc (~a e )))
+              (else (verbose "~nunformatted?: ~a~n" e))))
+          ""
+          (flatten l))
+   "::" ));; remove any stray $endtag (fix w. $inline)
+
+(define (format-section-name s)
+  (format "@section{~a}~n" (string-trim (format-result s) "::"))) ;; drop tag suffix
+
+
+;; parse an .schelp file into a formatted string
+(define (parse-help-file f)
+  (if (non-empty-string? f)
+      (let* ((path (build-path (help-path) f))
+             (body (port->string
+                    (open-input-file path))))
+        (printf "parsing file: ~a~n" path)
+        (format-result
+         (parse-result $schelp-file body)))
+      (printf "No help file.")))
+
+
+;; read a help file, write a scribble file
+(define (read-write-scribble f)
+  (let ((body (parse-help-file f))
+        (path (string-replace
+               (string-append (output-path) f) ".schelp" ".scrbl")))
+    (printf "writing file: ~a~n" path)
+    (with-output-to-file
+        #:exists 'replace
+      path
+      (lambda ()
+        (printf "~a~n" scribble-preamble)
+        (printf "~a~n" body)
+        (printf "~a~n" scribble-postamble)))))
+
+
+;;;;;;; ; ;; ;;;;;;;;;;;;; ;
+;;
+;; cli edition
+;;
+
+(read-write-scribble (filename))
diff --git a/util/scm2scrbl.rkt b/util/scm2scrbl.rkt
new file mode 100755
index 0000000..f3bbf80
--- /dev/null
+++ b/util/scm2scrbl.rkt
@@ -0,0 +1,166 @@
+#! /usr/bin/env racket
+#lang racket
+
+;; Parse .schelp.scm files and convert to .scrbl
+;;
+;; Copyright (C) 2022 FoAM
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see http://www.gnu.org/licenses/
+
+
+;; Author(s)
+;;  - nik gaffney <nik@fo.am>
+
+
+;; Commentary
+;;
+;;  (schelp -> scm ) -> racket (scribble)
+;;  This is a q&d parser to convert .help.scm files as seen in rsc3
+;;  to something usable as part of the racket documentation system
+;;  which uses the scribble format as described at
+;;                   https://docs.racket-lang.org/scribble/index.html
+;;
+;;  partially complete. partially automated.
+
+
+(require parsack)
+
+;; cli options
+(define filename (make-parameter ""))
+(define verbose? (make-parameter #f))
+;; help is relative (or not at all)
+(define help-path (make-parameter
+                    (path->string (current-directory))))
+
+(define getopt
+  (command-line
+   #:program "scm2scrbl"
+   #:once-each
+   (("-v" "--verbose")   "various verbose messages" (verbose? #t))
+   (("-p" "--help-path") folder "path to the directory containing help files" (help-path folder))
+   #:args (input-file)
+   (filename input-file)
+   (if (file-exists? (filename))
+       (printf "Converting .help.scm to scribble: ~a\n" (filename))
+       (raise-user-error 'scm2scrbl "File '~a' does not exist." (filename)))))
+
+;; echoing verbosity
+(define-syntax verbose
+  (syntax-rules ()
+    ((verbose str ...) (when (verbose?) (printf str ...)))))
+
+
+;; parsack parser for base case, assuming well formatted input...
+;;  - fragile and error prone
+;;  - assume first line is title
+;;  - all comments are considered 'text'
+;;  - any code is wrapped in a racketblock
+;;  - multiline examples
+;;  - minimal xref info
+
+
+;; title as first comment line
+(define $title
+  (parser-compose
+   (manyTill (char #\;) $space) ;; assume a space separation
+   (x <- (many1 (and $anyChar (noneOf ";"))))
+   (return (format-title x))))
+
+;; text as any scheme comment line
+(define $text
+  (parser-compose
+   (manyTill (char #\;) $space) ;; assume a space separation
+   (x <- (many1 (and $anyChar (noneOf ";"))))
+   (return (format-text x))))
+
+;; s-expressions (not strictly, but...)
+(define $sexp
+  (parser-seq
+   (char #\() (many1 (<or> (noneOf "()") $eol $sexp)) (char #\))))
+
+;; code block formatting
+(define $code
+  (parser-seq $sexp #:combine-with format-racketblock))
+
+;; a help file usually starts with a one line function followed by a new line
+;; then either text blocks (as comments) and/or example code.
+
+(define $help-file
+  (parser-seq
+   $title
+   (many (<or> $code $text $eol))
+   $eof))
+
+;; parser -> string -> string
+(define (parse->string p s)
+  (string-append (parse-result p s)))
+
+;; scribbling & formatting
+
+;; any header or footer info required for the scribble file
+(define  scribble-preamble
+  "#lang scribble/manual\n@(require (for-label racket))")
+
+(define  scribble-postamble "")
+
+;; wrap codeblock
+(define format-racketblock
+  (lambda (a . z)
+    (format "~n@racketblock[~n~a~n]" (format-result (cons a z)))))
+
+;; wrap title
+(define (format-title s)
+  (format "~n@title{~a}~n~n" (string-trim (list->string s))))
+
+;; generic text
+(define (format-text s)
+  (format "~a" (list->string s)))
+
+(define (format-result l)
+  (verbose "formatting result: ~s~n" l)
+  (foldl (lambda (e acc)
+           (cond
+             ((string? e) (string-append acc e))
+             ((char? e) (string-append acc (~a e )))
+             (else (verbose "~nunformatted?: ~n" e))))
+         ""
+         (flatten l)))
+
+;; parse a .help.scm file into formatted string
+(define (parse-help-file f)
+  (let* ((path (build-path help-path f))
+         (body (port->string
+                (open-input-file path))))
+    (printf "parsing file: ~a~n" path)
+    (format-result
+     (parse-result $help-file body))))
+
+
+;; read a help file, write a scribble file
+(define (read-write-scribble f)
+  (let ((body (parse-help-file f))
+        (path (string-replace
+               (string-append help-path f) ".scm" ".scrbl")))
+    (printf "writing file: ~a~n" path)
+    (with-output-to-file
+        #:exists 'replace
+        path
+        (lambda ()
+	  (printf "~a~n" scribble-preamble)
+          (printf "~a~n" body)
+          (printf "~a~n" scribble-postamble)))))
+
+
+;; cli edition
+(read-write-scribble (filename))