Rewrite as R7RS libraries, try to revive Gauche support
This commit is contained in:
parent
8b79ac1c69
commit
3fa52ef6e4
|
@ -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"))
|
|
@ -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)))))
|
54
pandoc.egg
54
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"))))
|
||||
|
|
|
@ -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))))
|
|
@ -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))))))))))
|
15
pandoc.sld
15
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"))
|
||||
|
|
|
@ -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)))))))))
|
|
@ -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)))))))
|
|
@ -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))))))
|
|
@ -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))))))))
|
|
@ -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)))
|
||||
|
||||
;;
|
|
@ -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)))))))))
|
|
@ -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"))))
|
|
@ -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))))))
|
|
@ -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)))))))))))
|
Loading…
Reference in New Issue