Paste number 9931: FAQ conversion program

Paste number 9931: FAQ conversion program
Pasted by: mmmdonuts
When:12 years, 3 months ago
Share:Tweet this! |
Paste contents:
Raw Source | XML | Display As
; this is a first draft. many formatting issues still to take care of.
; it was used to generate the scheme-faq-general page on the csw.
; see also previous paste at

; imports for PLT - all portable libraries
(require (lib "" "ssax")
         (lib "" "sxml-match")
         (lib "" "srfi")
         (lib "" "srfi"))

; TODO: process all FAQ XML files
(define sxml (call-with-input-file "~/dev/schemefaq/general.xml"
               (lambda (port) (ssax:xml->sxml port '()))))

(define (filter-newlines s)
  ; SRFI-13 standard says: (string-delete s #\newline)
  ; SRFI-13 reference implementation and PLT uses:
  (string-delete #\newline s))

; easier to do this with a native regex procedure, but this is portable
(define (compress-spaces s)
     (lambda (c t)
       (if (and (char=? c #\space)
                (or (null? t)
                    (char-whitespace? (car t))))
           (cons c t)))

(define (convert-para body)
  (let ((output (fold 
                 (lambda (frag output)
                    (sxml-match frag
                      [(ulink (@ (url ,url)))
                       (format "[~a] " url)]
                      [(emphasis ,text)
                       (format "''~a'' " text)]
                      [(quote ,text)
                       (format "\"~a\" " (compress-spaces text))]
                          (title ,title ...)
                          (para ,body ...)))
                        (format ":~a:~a\n" (convert-header title) (convert-para body))
                        (if (string? other) 
                            (string-trim (compress-spaces other))
    ; TODO: this is overkill, for sanitizing output during development:
    (apply string-append 
           (map (lambda (x) (format "~a" x))
                (reverse output)))))

(define (convert-header frags)
  (if (null? (cdr frags))
      (filter-newlines (compress-spaces (car frags)))
      (error "Unexpected header format")))

(define (transform nodes)
   (lambda (sxml)
     (sxml-match sxml
       [(para ,body ...) body]
       [,else (error "no match")]))

(define (sxml->faq sxml)
  (sxml-match sxml
      (title ,title) 
       (question ,q1 ...)
       (answer ,a1 ...))
      (format "* ~a\n\n" title)
      (format "** ~a\n\n~a\n"
              (convert-header (transform q1))
              (convert-para (transform a1)))
    [,else (error "match failed: " sxml)]))

(for-each display (sxml->faq (cadr sxml)))

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.