From 8d5bd6b1ed97408280ea3a6b7ec30519a3fd8ea2 Mon Sep 17 00:00:00 2001
From: Lassi Kortela <lassi@lassi.io>
Date: Wed, 25 Aug 2021 09:17:40 +0300
Subject: [PATCH] Add more Pandoc JSON types

---
 pandoc.r5rs.scm | 32 +++++++++++++++++++++++++++++---
 1 file changed, 29 insertions(+), 3 deletions(-)

diff --git a/pandoc.r5rs.scm b/pandoc.r5rs.scm
index 8b2f411..07a5a7b 100644
--- a/pandoc.r5rs.scm
+++ b/pandoc.r5rs.scm
@@ -10,6 +10,9 @@
                   (cons (car list) new-list))
               (cdr list)))))
 
+(define (join-adjacent-strings list)
+  (join-adjacent string? string-append list))
+
 (define (vector-refs vec . indexes)
   (let loop ((obj vec) (indexes indexes))
     (if (null? indexes) obj
@@ -17,8 +20,10 @@
               (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)))
@@ -27,20 +32,41 @@
              " ")
             ((equal? type "Str")
              (contents))
+            ((equal? type "BulletList")
+             `(ul
+               ,@(map (lambda (list-element)
+                        `(li ,@(convert-many (vector->list list-element))))
+                      (contents-list))))
+            ((equal? type "BlockQuote")
+             `(blockquote
+               ,@(convert-many (contents-list))))
             ((equal? type "Code")
              `(code ,@(convert-many (cdr (contents-list)))))
+            ((equal? type "CodeBlock")
+             `(pre (@ (data-syntax ,(join-adjacent-strings
+                                     (vector->list
+                                      (vector-refs (contents) 0 1)))))
+                   ,@(convert-many (cdr (contents-list)))))
+            ((equal? type "Emph")
+             `(em ,@(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 "Link")
+             `(a (@ (href ,(join-adjacent-strings
+                            (vector->list (vector-ref (contents) 2)))))
+                 ,@(convert-many (vector->list (vector-ref (contents) 1)))))
             ((equal? type "Plain")
              `(span ,@(convert-many (contents-list))))
             ((equal? type "Para")
              `(p ,@(convert-many (contents-list))))
             ((equal? type "SoftBreak")
              "\n")
+            ((equal? type "Strong")
+             `(strong ,@(convert-many (contents-list))))
             ((equal? type "Table")
              (let ((headings (vector-refs (contents) 3 1 0 1)))
                `(table
@@ -60,10 +86,10 @@
                                       (vector->list (vector-refs row 1)))))
                         (vector->list (vector-refs (contents) 4 0 3))))))
             (else
-             (error "Unknown type" type)))))
+             (error "Unknown type in pandoc JSON" type)))))
+
   (define (convert-many elements)
-    (join-adjacent string? string-append
-                   (map convert-block-or-inline elements)))
+    (join-adjacent-strings (map convert-block-or-inline elements)))
   (convert-many (vector->list (cdr (assq 'blocks json)))))
 
 (define (pandoc-port->json input-format input-port)