From 3fa52ef6e4c9d8e88226418322ab3fd47705002a Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Fri, 10 Sep 2021 16:13:36 +0300 Subject: [PATCH] Rewrite as R7RS libraries, try to revive Gauche support --- pandoc.chicken.scm | 53 -------- pandoc.cli.chicken.scm | 19 --- pandoc.egg | 54 ++++++-- pandoc.gauche.scm | 7 -- pandoc.server.chicken.scm | 44 ------- pandoc.sld | 15 +-- pandoc.tar.chicken.scm | 144 ---------------------- pandoc/cli.sld | 19 +++ pandoc/internal/json.sld | 16 +++ pandoc/internal/subprocess.sld | 20 +++ pandoc.r5rs.scm => pandoc/pandoc.r5rs.scm | 3 +- pandoc/server.chicken.scm | 29 +++++ pandoc/server.sld | 14 +++ pandoc/tar.r7rs.scm | 98 +++++++++++++++ pandoc/tar.sld | 33 +++++ 15 files changed, 277 insertions(+), 291 deletions(-) delete mode 100644 pandoc.chicken.scm delete mode 100644 pandoc.cli.chicken.scm delete mode 100644 pandoc.gauche.scm delete mode 100644 pandoc.server.chicken.scm delete mode 100644 pandoc.tar.chicken.scm create mode 100644 pandoc/cli.sld create mode 100644 pandoc/internal/json.sld create mode 100644 pandoc/internal/subprocess.sld rename pandoc.r5rs.scm => pandoc/pandoc.r5rs.scm (98%) create mode 100644 pandoc/server.chicken.scm create mode 100644 pandoc/server.sld create mode 100644 pandoc/tar.r7rs.scm create mode 100644 pandoc/tar.sld diff --git a/pandoc.chicken.scm b/pandoc.chicken.scm deleted file mode 100644 index 58a49ac..0000000 --- a/pandoc.chicken.scm +++ /dev/null @@ -1,53 +0,0 @@ -(module pandoc - - (#;export - - pandoc-json->sxml - - pandoc-port->json - pandoc-port->sxml - - pandoc-file->json - pandoc-file->sxml - - pandoc-files->json - pandoc-files->sxml - - pandoc-bytevector->json - pandoc-bytevector->sxml - - pandoc-bytevectors->json - pandoc-bytevectors->sxml - - pandoc-string->json - pandoc-string->sxml - - pandoc-strings->json - pandoc-strings->sxml) - - (import (scheme) - (chicken base) - (only (scheme base) - bytevector - bytevector-append - read-bytevector - string->utf8) - (only (chicken io) read-byte write-byte) - (only (chicken port) copy-port with-input-from-string) - (only (chicken process) process process-wait) - (only (scsh-process) run/port) - (only (medea) read-json)) - - (define (read-bytevector-all port) - (let loop ((whole (bytevector))) - (let ((part (read-bytevector 1000 port))) - (if (eof-object? part) whole - (loop (bytevector-append whole part)))))) - - (define (call-with-binary-input-file filename proc) - (let ((port (open-input-file filename #:binary))) - (dynamic-wind (lambda () #f) - (lambda () (proc port)) - (lambda () (close-input-port port))))) - - (include "pandoc.r5rs.scm")) diff --git a/pandoc.cli.chicken.scm b/pandoc.cli.chicken.scm deleted file mode 100644 index f69d79b..0000000 --- a/pandoc.cli.chicken.scm +++ /dev/null @@ -1,19 +0,0 @@ -(module (pandoc cli) - - (#;export - pandoc-cli) - - (import (scheme) - (chicken base) - (only (medea) read-json) - (only (scheme base) utf8->string) - (only (scsh-process) run/port)) - - (define (pandoc-cli #!optional command-name) - (let ((command-name (or command-name "pandoc"))) - (lambda (input-format bytevectors) - (map (lambda (bytevector) - (read-json - (run/port (,command-name --from ,input-format --to json) - (<< ,(utf8->string bytevector))))) - bytevectors))))) diff --git a/pandoc.egg b/pandoc.egg index 9459ff7..b269504 100644 --- a/pandoc.egg +++ b/pandoc.egg @@ -10,21 +10,53 @@ (dependencies cjson http-client medea r7rs scsh-process) (test-dependencies) (distribution-files - "pandoc.r5rs.scm" - "pandoc.chicken.scm" - "pandoc.server.chicken.scm" - "pandoc.tar.chicken.scm" + "pandoc.sld" + "pandoc/cli.sld" + "pandoc/internal/json.sld" + "pandoc/internal/subprocess.sld" + "pandoc/server.sld" + "pandoc/tar.sld" + + "pandoc/pandoc.r5rs.scm" + "pandoc/server.chicken.scm" + "pandoc/tar.r7rs.scm" + "pandoc.egg" "pandoc.release-info") (components + (extension pandoc - (source "pandoc.chicken.scm")) + (source "pandoc.sld") + (source-dependencies "pandoc/pandoc.r5rs.scm") + (csc-options "-R" "r7rs" "-X" "r7rs")) + (extension pandoc.cli - (source "pandoc.cli.chicken.scm") - (component-dependencies pandoc)) + (source "pandoc/cli.sld") + (component-dependencies + pandoc + pandoc.internal.json + pandoc.internal.subprocess) + (csc-options "-R" "r7rs" "-X" "r7rs")) + (extension pandoc.server - (source "pandoc.server.chicken.scm") - (component-dependencies pandoc)) + (source "pandoc/server.sld") + (source-dependencies "pandoc/server.chicken.scm") + (component-dependencies pandoc) + (csc-options "-R" "r7rs" "-X" "r7rs")) + (extension pandoc.tar - (source "pandoc.tar.chicken.scm") - (component-dependencies pandoc)))) + (source "pandoc/tar.sld") + (source-dependencies "pandoc/tar.r7rs.scm") + (component-dependencies + pandoc + pandoc.internal.json + pandoc.internal.subprocess) + (csc-options "-R" "r7rs" "-X" "r7rs")) + + (extension pandoc.internal.json + (source "pandoc/internal/json.sld") + (csc-options "-R" "r7rs" "-X" "r7rs")) + + (extension pandoc.internal.subprocess + (source "pandoc/internal/subprocess.sld") + (csc-options "-R" "r7rs" "-X" "r7rs")))) diff --git a/pandoc.gauche.scm b/pandoc.gauche.scm deleted file mode 100644 index e354c70..0000000 --- a/pandoc.gauche.scm +++ /dev/null @@ -1,7 +0,0 @@ -(define (run-read-write args input-port read-output) - (call-with-process-io - args - (lambda (from-sub to-sub) - (copy-port input-port to-sub) - (close-output-port to-sub) - (read-output from-sub)))) diff --git a/pandoc.server.chicken.scm b/pandoc.server.chicken.scm deleted file mode 100644 index b29ff4f..0000000 --- a/pandoc.server.chicken.scm +++ /dev/null @@ -1,44 +0,0 @@ -(module (pandoc server) - - (#;export - pandoc-server) - - (import (scheme) - (chicken base) - (cjson) - (only (scheme base) utf8->string) - (only (chicken io) read-string) - (only (http-client) with-input-from-request) - (only (intarweb) headers make-request) - (only (medea) write-json) - (only (uri-common) uri-reference)) - - (define (pandoc-server base-url) - (lambda (input-format bytevectors) - (with-input-from-request - (make-request - method: 'POST - uri: (uri-reference (string-append base-url "convert-batch")) - headers: (headers '((content-type "application/json") - (accept "application/json")))) - (lambda () - (let ((input-format (symbol->string input-format))) - (write-json - (list->vector - (map (lambda (bytevector) - (list (cons 'from input-format) - (cons 'to "json") - (cons 'text (utf8->string bytevector)))) - bytevectors))))) - (lambda () - (let ((array (string->cjson (read-string)))) - (unless (eq? cjson/array (cjson-type array)) - (error "Got unexpected JSON from pandoc-server")) - (let loop ((i (- (cjson-array-size array) 1)) (results '())) - (if (< i 0) results - (loop (- i 1) - (cons (cjson-schemify - (string->cjson - (cjson-schemify - (cjson-array-ref array i)))) - results)))))))))) diff --git a/pandoc.sld b/pandoc.sld index 0e3e145..ef57b49 100644 --- a/pandoc.sld +++ b/pandoc.sld @@ -26,20 +26,11 @@ (import (scheme base) (scheme file) (scheme write)) - (cond-expand - (gauche (import (only (srfi 180) json-read) - (only (gauche base) copy-port) - (only (gauche process) call-with-process-io)))) - (cond-expand - (gauche (include "pandoc.gauche.scm"))) (begin (define inexact->exact exact) - (define (call-with-binary-input-file filename proc) - (call-with-port (open-binary-input-file filename) proc)) - - (define (read-bytevector-all binary-input-port) + (define (read-bytevector-all port) (let loop ((whole (bytevector))) - (let ((part (read-bytevector 1000))) + (let ((part (read-bytevector 1000 port))) (if (eof-object? part) whole (loop (bytevector-append whole part))))))) - (include "pandoc.r5rs.scm")) + (include "pandoc/pandoc.r5rs.scm")) diff --git a/pandoc.tar.chicken.scm b/pandoc.tar.chicken.scm deleted file mode 100644 index f7451bd..0000000 --- a/pandoc.tar.chicken.scm +++ /dev/null @@ -1,144 +0,0 @@ -(module (pandoc tar) - - (#;export - pandoc-tar) - - (import (scheme) - (chicken base) - (cjson) - ;;(srfi 4) - (only (scheme base) - bytevector - bytevector-append - bytevector-length - bytevector-u8-ref - eof-object - make-bytevector - read-bytevector - string->utf8 - truncate-remainder - utf8->string - write-bytevector) - (only (chicken io) read-byte read-string write-byte write-string) - (only (chicken port) - copy-port with-input-from-string with-output-to-string) - (only (scsh-process) run/port run/string) - (only (pandoc) pandoc-json->sxml)) - - (define (generator->list generator) ; SRFI 158 - (let loop ((list '())) - (let ((elem (generator))) - (if (eof-object? elem) (reverse list) (loop (cons elem list)))))) - - (define (bytevector-every? predicate bytes) - (let loop ((i 0)) - (or (= i (bytevector-length bytes)) - (and (predicate (bytevector-u8-ref bytes i)) - (loop (+ i 1)))))) - - (define (tar-read-file) - - (define (read-exactly-n-bytes n) - (let ((bytes (read-bytevector n))) - (if (or (eof-object? bytes) (< (bytevector-length bytes) n)) - (error "Short read") - bytes))) - - (let ((header (read-bytevector 512))) - - (define (tar-octal-ref offset len) - (let loop ((offset offset) (len len) (value 0)) - (if (<= len 0) value - (let ((dig0 (char->integer #\0)) - (dig7 (char->integer #\7)) - (byte (bytevector-u8-ref header offset))) - (loop (+ offset 1) (- len 1) - (if (<= dig0 byte dig7) - (let ((digit (- byte dig0))) - (+ digit (* value 8))) - value)))))) - - (cond ((eof-object? header) - (eof-object)) - ((bytevector-every? zero? header) - (eof-object)) - (else - (unless (= 512 (bytevector-length header)) - (error "Short read")) - (let* ((nbyte (tar-octal-ref 124 12)) - (nnull (- 512 (truncate-remainder nbyte 512))) - (bytes (read-exactly-n-bytes nbyte))) - (read-exactly-n-bytes nnull) - bytes))))) - - (define (tar-write-file filename bytes) - - (define nulls (make-bytevector 512 0)) - (define blank-checksum (make-bytevector 7 (char->integer #\space))) - - (define (bytevector-sum bv) - (let loop ((i (- (bytevector-length bv) 1)) (sum 0)) - (if (< i 0) sum (loop (- i 1) (+ sum (bytevector-u8-ref bv i)))))) - - (define (tar-string nbyte string) - (let* ((bytes (string->utf8 string)) - (nnull (- nbyte (bytevector-length bytes)))) - (when (< nnull 1) (error "tar: string too long")) - (bytevector-append bytes (make-bytevector nnull 0)))) - - (define (tar-octal nbyte number) - (let* ((bytes (string->utf8 (number->string number 8))) - (nzero (- nbyte 1 (bytevector-length bytes)))) - (bytevector-append (make-bytevector nzero (char->integer #\0)) - bytes (bytevector 0)))) - - (let* ((nbyte (bytevector-length bytes)) - (nnull (- 512 (truncate-remainder nbyte 512))) - (header-before-checksum - (bytevector-append - (tar-string 100 filename) - (tar-octal 8 #o444) - (tar-octal 8 0) - (tar-octal 8 0) - (tar-octal 12 nbyte) - (tar-octal 12 0))) - (header-after-checksum - (bytevector-append - (bytevector (char->integer #\space)) - (bytevector (char->integer #\0)) - (tar-string 100 "") - (tar-string 8 "ustar ") - (tar-string 32 "") - (tar-string 32 "") - (make-bytevector 183 0))) - (checksum - (let ((sum (+ (bytevector-sum header-before-checksum) - (bytevector-sum blank-checksum) - (bytevector-sum header-after-checksum)))) - (tar-octal 7 (truncate-remainder sum (expt 8 6)))))) - (write-bytevector header-before-checksum) - (write-bytevector checksum) - (write-bytevector header-after-checksum) - (write-bytevector bytes) - (write-bytevector nulls (current-output-port) 0 nnull))) - - (define (write-all-to-tar inputs) - (let loop ((i 0) (inputs inputs)) - (unless (null? inputs) - (let ((filename (string-append (number->string i) ".md"))) - (tar-write-file filename (car inputs)) - (loop (+ i 1) (cdr inputs)))))) - - (define (pandoc-tar #!optional command-name) - (let ((command-name (or command-name "pandoc-tar"))) - (lambda (input-format bytevectors) - (let* ((stdin - (with-output-to-string - (lambda () (write-all-to-tar bytevectors)))) - (stdout - (run/string (,command-name --from ,input-format --to json) - (<< ,stdin)))) - (map (lambda (bytes) - (cjson-schemify (string->cjson (utf8->string bytes)))) - (with-input-from-string stdout - (lambda () (generator->list tar-read-file))))))))) diff --git a/pandoc/cli.sld b/pandoc/cli.sld new file mode 100644 index 0000000..91b7748 --- /dev/null +++ b/pandoc/cli.sld @@ -0,0 +1,19 @@ +(define-library (pandoc cli) + (export pandoc-cli) + (import (scheme base) (scheme case-lambda) + (pandoc internal json) + (pandoc internal subprocess)) + (begin + (define pandoc-cli + (case-lambda + (() + (pandoc-cli "pandoc")) + ((command-name) + (lambda (input-format bytevectors) + (map (lambda (bytevector) + (subprocess (list command-name + "--from" (symbol->string input-format) + "--to" "json") + bytevector + json-read)) + bytevectors))))))) diff --git a/pandoc/internal/json.sld b/pandoc/internal/json.sld new file mode 100644 index 0000000..40e1fc2 --- /dev/null +++ b/pandoc/internal/json.sld @@ -0,0 +1,16 @@ +(define-library (pandoc internal json) + (export json-read + json-read-from-bytevector) + (import (scheme base)) + (cond-expand + (chicken + (import (cjson) + (rename (only (medea) read-json) + (read-json json-read))) + (begin (define (json-read-from-bytevector bytes) + (cjson-schemify (string->cjson (utf8->string bytes)))))) + (gauche + (import (only (srfi 180) json-read)) + (begin (define (json-read-from-bytevector bytes) + (call-with-port (open-input-bytevector bytes) + json-read)))))) diff --git a/pandoc/internal/subprocess.sld b/pandoc/internal/subprocess.sld new file mode 100644 index 0000000..b40f74b --- /dev/null +++ b/pandoc/internal/subprocess.sld @@ -0,0 +1,20 @@ +(define-library (pandoc internal subprocess) + (export subprocess) + (import (scheme base)) + (cond-expand + (chicken + (import (only (scsh-process) run/port)) + (begin + (define (subprocess command-line stdin-bytevector read-stdout) + (read-stdout (run/port (,(car command-line) ,@(cdr command-line)) + (<< ,(utf8->string stdin-bytevector))))))) + (gauche + (import (only (gauche process) call-with-process-io)) + (begin + (define (subprocess command-line stdin-bytevector read-stdout) + (call-with-process-io + command-line + (lambda (from-sub to-sub) + (write-bytevector stdin-bytevector to-sub) + (close-output-port to-sub) + (read-stdout from-sub)))))))) diff --git a/pandoc.r5rs.scm b/pandoc/pandoc.r5rs.scm similarity index 98% rename from pandoc.r5rs.scm rename to pandoc/pandoc.r5rs.scm index 3d615e0..1e29c4f 100644 --- a/pandoc.r5rs.scm +++ b/pandoc/pandoc.r5rs.scm @@ -130,7 +130,8 @@ (pandoc-bytevectors->json pandoc input-format (map (lambda (filename) - (call-with-binary-input-file filename read-bytevector-all)) + (call-with-port (open-binary-input-file filename) + read-bytevector-all)) filenames))) ;; diff --git a/pandoc/server.chicken.scm b/pandoc/server.chicken.scm new file mode 100644 index 0000000..bcc8142 --- /dev/null +++ b/pandoc/server.chicken.scm @@ -0,0 +1,29 @@ +(define (pandoc-server base-url) + (lambda (input-format bytevectors) + (with-input-from-request + (make-request + method: 'POST + uri: (uri-reference (string-append base-url "convert-batch")) + headers: (headers '((content-type "application/json") + (accept "application/json")))) + (lambda () + (let ((input-format (symbol->string input-format))) + (write-json + (list->vector + (map (lambda (bytevector) + (list (cons 'from input-format) + (cons 'to "json") + (cons 'text (utf8->string bytevector)))) + bytevectors))))) + (lambda () + (let ((array (string->cjson (read-string)))) + (unless (eq? cjson/array (cjson-type array)) + (error "Got unexpected JSON from pandoc-server")) + (let loop ((i (- (cjson-array-size array) 1)) (results '())) + (if (< i 0) results + (loop (- i 1) + (cons (cjson-schemify + (string->cjson + (cjson-schemify + (cjson-array-ref array i)))) + results))))))))) diff --git a/pandoc/server.sld b/pandoc/server.sld new file mode 100644 index 0000000..b18d849 --- /dev/null +++ b/pandoc/server.sld @@ -0,0 +1,14 @@ +(define-library (pandoc server) + (export pandoc-server) + (cond-expand + (chicken + (import (scheme) + (chicken base) + (cjson) + (only (scheme base) utf8->string) + (only (chicken io) read-string) + (only (http-client) with-input-from-request) + (only (intarweb) headers make-request) + (only (medea) write-json) + (only (uri-common) uri-reference)) + (include "pandoc/server.chicken.scm")))) diff --git a/pandoc/tar.r7rs.scm b/pandoc/tar.r7rs.scm new file mode 100644 index 0000000..16e87e2 --- /dev/null +++ b/pandoc/tar.r7rs.scm @@ -0,0 +1,98 @@ +(define (bytevector-every? predicate bytes) + (let loop ((i 0)) + (or (= i (bytevector-length bytes)) + (and (predicate (bytevector-u8-ref bytes i)) + (loop (+ i 1)))))) + +(define (tar-read-file) + + (define (read-exactly-n-bytes n) + (let ((bytes (read-bytevector n))) + (if (or (eof-object? bytes) (< (bytevector-length bytes) n)) + (error "Short read") + bytes))) + + (let ((header (read-bytevector 512))) + + (define (tar-octal-ref offset len) + (let loop ((offset offset) (len len) (value 0)) + (if (<= len 0) value + (let ((dig0 (char->integer #\0)) + (dig7 (char->integer #\7)) + (byte (bytevector-u8-ref header offset))) + (loop (+ offset 1) (- len 1) + (if (<= dig0 byte dig7) + (let ((digit (- byte dig0))) + (+ digit (* value 8))) + value)))))) + + (cond ((eof-object? header) + (eof-object)) + ((bytevector-every? zero? header) + (eof-object)) + (else + (unless (= 512 (bytevector-length header)) + (error "Short read")) + (let* ((nbyte (tar-octal-ref 124 12)) + (nnull (- 512 (truncate-remainder nbyte 512))) + (bytes (read-exactly-n-bytes nbyte))) + (read-exactly-n-bytes nnull) + bytes))))) + +(define (tar-write-file filename bytes) + + (define nulls (make-bytevector 512 0)) + (define blank-checksum (make-bytevector 7 (char->integer #\space))) + + (define (bytevector-sum bv) + (let loop ((i (- (bytevector-length bv) 1)) (sum 0)) + (if (< i 0) sum (loop (- i 1) (+ sum (bytevector-u8-ref bv i)))))) + + (define (tar-string nbyte string) + (let* ((bytes (string->utf8 string)) + (nnull (- nbyte (bytevector-length bytes)))) + (when (< nnull 1) (error "tar: string too long")) + (bytevector-append bytes (make-bytevector nnull 0)))) + + (define (tar-octal nbyte number) + (let* ((bytes (string->utf8 (number->string number 8))) + (nzero (- nbyte 1 (bytevector-length bytes)))) + (bytevector-append (make-bytevector nzero (char->integer #\0)) + bytes (bytevector 0)))) + + (let* ((nbyte (bytevector-length bytes)) + (nnull (- 512 (truncate-remainder nbyte 512))) + (header-before-checksum + (bytevector-append + (tar-string 100 filename) + (tar-octal 8 #o444) + (tar-octal 8 0) + (tar-octal 8 0) + (tar-octal 12 nbyte) + (tar-octal 12 0))) + (header-after-checksum + (bytevector-append + (bytevector (char->integer #\space)) + (bytevector (char->integer #\0)) + (tar-string 100 "") + (tar-string 8 "ustar ") + (tar-string 32 "") + (tar-string 32 "") + (make-bytevector 183 0))) + (checksum + (let ((sum (+ (bytevector-sum header-before-checksum) + (bytevector-sum blank-checksum) + (bytevector-sum header-after-checksum)))) + (tar-octal 7 (truncate-remainder sum (expt 8 6)))))) + (write-bytevector header-before-checksum) + (write-bytevector checksum) + (write-bytevector header-after-checksum) + (write-bytevector bytes) + (write-bytevector nulls (current-output-port) 0 nnull))) + +(define (write-all-to-tar inputs) + (let loop ((i 0) (inputs inputs)) + (unless (null? inputs) + (let ((filename (string-append (number->string i) ".md"))) + (tar-write-file filename (car inputs)) + (loop (+ i 1) (cdr inputs)))))) diff --git a/pandoc/tar.sld b/pandoc/tar.sld new file mode 100644 index 0000000..e746005 --- /dev/null +++ b/pandoc/tar.sld @@ -0,0 +1,33 @@ +(define-library (pandoc tar) + (export pandoc-tar) + (import (scheme base) (scheme case-lambda) + (pandoc internal json) + (pandoc internal subprocess)) + (include "tar.r7rs.scm") + (begin + + (define (generator->list generator) ; SRFI 158 + (let loop ((list '())) + (let ((elem (generator))) + (if (eof-object? elem) (reverse list) (loop (cons elem list)))))) + + (define pandoc-tar + (case-lambda + (() + (pandoc-tar "pandoc-tar")) + ((command-name) + (lambda (input-format bytevectors) + (subprocess + (list command-name + "--from" (symbol->string input-format) + "--to" "json") + (call-with-port + (open-output-bytevector) + (lambda (out) + (parameterize ((current-output-port out)) + (write-all-to-tar bytevectors) + (get-output-bytevector out)))) + (lambda (port) + (map json-read-from-bytevector + (parameterize ((current-input-port port)) + (generator->list tar-read-file)))))))))))