Paste number 9931: FAQ conversion program

Paste number 9931: FAQ conversion program
Pasted by: mmmdonuts
When:12 years, 4 months ago
Share:Tweet this! | http://paste.lisp.org/+7NV
Channel:#scheme
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 http://paste.lisp.org/display/9927
;

; imports for PLT - all portable libraries
(require (lib "ssax.ss" "ssax")
         (lib "sxml-match.ss" "sxml-match")
         (lib "1.ss" "srfi")
         (lib "13.ss" "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)
  (list->string
   (reverse
    (string-fold
     (lambda (c t)
       (if (and (char=? c #\space)
                (or (null? t)
                    (char-whitespace? (car t))))
           t
           (cons c t)))
     '()
     s))))

(define (convert-para body)
  (let ((output (fold 
                 (lambda (frag output)
                   (cons
                    (sxml-match frag
                      [(ulink (@ (url ,url)))
                       (format "[~a] " url)]
                      [(emphasis ,text)
                       (format "''~a'' " text)]
                      [(quote ,text)
                       (format "\"~a\" " (compress-spaces text))]
                      [(itemizedlist
                        (listitem
                         (formalpara 
                          (title ,title ...)
                          (para ,body ...)))
                        ...)
                       (string-append
                        (format ":~a:~a\n" (convert-header title) (convert-para body))
                        ...)]
                      [,other 
                        (if (string? other) 
                            (string-trim (compress-spaces other))
                            other)])
                    output))
                 '()
                 body)))
    ; 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)
  (append-map 
   (lambda (sxml)
     (sxml-match sxml
       [(para ,body ...) body]
       [,else (error "no match")]))
   nodes))

(define (sxml->faq sxml)
  (sxml-match sxml
    [(qandadiv  
      (title ,title) 
      (qandaentry 
       (question ,q1 ...)
       (answer ,a1 ...))
      ...)
     (list
      (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.