(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 (string->symbol (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)))))))))