86 lines
3.6 KiB
Scheme
86 lines
3.6 KiB
Scheme
|
(define (join-adjacent type? type-append list)
|
||
|
|
(let loop ((new-list '()) (list list))
|
||
|
|
(if (null? list) (reverse new-list)
|
||
|
|
(loop (if (and (not (null? new-list))
|
||
|
|
(type? (car new-list))
|
||
|
|
(type? (car list)))
|
||
|
|
(cons (type-append (car new-list)
|
||
|
|
(car list))
|
||
|
|
(cdr new-list))
|
||
|
|
(cons (car list) new-list))
|
||
|
|
(cdr list)))))
|
||
|
|
|
||
|
|
(define (vector-refs vec . indexes)
|
||
|
|
(let loop ((obj vec) (indexes indexes))
|
||
|
|
(if (null? indexes) obj
|
||
|
|
(loop (vector-ref obj (car indexes))
|
||
|
|
(cdr indexes)))))
|
||
|
|
|
||
|
|
(define (pandoc-json->sxml json)
|
||
|
|
(define (convert-block-or-inline element)
|
||
|
|
(if (string? element) element (convert-block element)))
|
||
|
|
(define (convert-block block)
|
||
|
|
(let ((type (cdr (assq 't block))))
|
||
|
|
(define (contents) (cdr (assq 'c block)))
|
||
|
|
(define (contents-list) (vector->list (contents)))
|
||
|
|
(cond ((equal? type "Space")
|
||
|
|
" ")
|
||
|
|
((equal? type "Str")
|
||
|
|
(contents))
|
||
|
|
((equal? type "Code")
|
||
|
|
`(code ,@(convert-many (cdr (contents-list)))))
|
||
|
|
((equal? type "Header")
|
||
|
|
(let* ((level (car (contents-list)))
|
||
|
|
(h-tag (string->symbol
|
||
|
|
(string-append "h" (number->string level)))))
|
||
|
|
`(,h-tag ,@(convert-many (vector->list
|
||
|
|
(list-ref (contents-list) 2))))))
|
||
|
|
((equal? type "Plain")
|
||
|
|
`(span ,@(convert-many (contents-list))))
|
||
|
|
((equal? type "Para")
|
||
|
|
`(p ,@(convert-many (contents-list))))
|
||
|
|
((equal? type "SoftBreak")
|
||
|
|
"\n")
|
||
|
|
((equal? type "Table")
|
||
|
|
(let ((headings (vector-refs (contents) 3 1 0 1)))
|
||
|
|
`(table
|
||
|
|
(tr
|
||
|
|
,@(map (lambda (cell)
|
||
|
|
(let ((elements (vector->list
|
||
|
|
(vector-refs cell 4))))
|
||
|
|
`(th ,@(map convert-block-or-inline elements))))
|
||
|
|
(vector->list headings)))
|
||
|
|
,@(map (lambda (row)
|
||
|
|
`(tr ,@(map (lambda (cell)
|
||
|
|
(let ((elements
|
||
|
|
(vector->list
|
||
|
|
(vector-refs cell 4))))
|
||
|
|
`(td ,@(map convert-block-or-inline
|
||
|
|
elements))))
|
||
|
|
(vector->list (vector-refs row 1)))))
|
||
|
|
(vector->list (vector-refs (contents) 4 0 3))))))
|
||
|
|
(else
|
||
|
|
(error "Unknown type" type)))))
|
||
|
|
(define (convert-many elements)
|
||
|
|
(join-adjacent string? string-append
|
||
|
|
(map convert-block-or-inline elements)))
|
||
|
|
(convert-many (vector->list (cdr (assq 'blocks json)))))
|
||
|
|
|
||
|
|
(define (pandoc-port->json input-format input-port)
|
||
|
|
(run-read-write (append (pandoc-command-line)
|
||
|
|
(list "--from" (symbol->string input-format)
|
||
|
|
"--to" "json"))
|
||
|
|
input-port
|
||
|
|
json-read))
|
||
|
|
|
||
|
|
(define (pandoc-port->sxml input-format input-port)
|
||
|
|
(pandoc-json->sxml (pandoc-port->json input-format input-port)))
|
||
|
|
|
||
|
|
(define (pandoc-file->json input-format input-filename)
|
||
|
|
(call-with-binary-input-file
|
||
|
|
input-filename
|
||
|
|
(lambda (input-port) (pandoc-port->json input-format input-port))))
|
||
|
|
|
||
|
|
(define (pandoc-file->sxml input-format input-filename)
|
||
|
|
(pandoc-json->sxml (pandoc-file->json input-format input-filename)))
|