Welcome to the CHICKEN Scheme pasting service

(module procter
*

(import chicken scheme ports extras)

(use srfi-1 irregex)

(define (make-exn-condition loc msg . args)
  (make-property-condition 'exn 'location loc 'message msg 'arguments args))

(define (make-procter-condition type)
  (make-property-condition 'procter ' sta))

(define (make-procter-error-condition  type loc msg  . args)
  (make-composite-condition
   (apply make-exn-condition loc msg args)
   (make-property-condition 'procter)
   (make-property-condition type)))

(define (make-fully-qualified-reader path reader)
  (let ((reader (make-reader reader)))
    (lambda ()
      (reader path))))

(define ((make-reader reader #!key (path-prefix "")) path)
  (let ((full-path (string-append path-prefix path)))
    (unless (file-exists? path)
      (signal (make-procter-error-condition
               'path-not-found
               'proc-reader
               "The given path does not exist" full-path)))
    (call-with-input-file full-path reader)))

(define (port-map* io proc)
  (with-input-from-port io (cut port-map proc read-line)))

(define ((make-table-reader #!key (horizontal-headers #f) (vertical-headers #f) (delimiter '(+ whitespace))) io)
  (let* ((line-reader (make-table-line-reader delimiter)))
    (remove
     null?
     (port-map* io (cond
                    (horizontal-headers
                     (with-horizontal-headers line-reader (columnize (read-line io) delimiter)))
                    (vertical-headers
                     (with-vertical-headers line-reader))
                    (else line-reader))))))

(define ((make-table-line-reader delimiter) line)
  (columnize line delimiter))

(define (columnize line delimiter)
  (irregex-split delimiter line))

(define ((with-horizontal-headers reader headers) line)
  (zip headers (reader line)))

(define ((with-vertical-headers reader) line)
  (let ((line (reader line)))
    (if (null? line)
        line
        (cons (car line) (list (cdr line))))))

)

;; examples
(import procter)

(define proc/partitions (make-fully-qualified-reader "/proc/partitions" (make-table-reader horizontal-headers: #t)))
(define property-table-reader (make-reader (make-table-reader vertical-headers: #t delimiter: '(seq (+ whitespace) ":" (* whitespace)))))
(define table-reader (make-reader (make-table-reader horizontal-headers: #t)))


(print "Partitions")
(pp (proc/partitions))

(print "Crypto")
(pp (property-table-reader "/proc/crypto"))

(print "Swaps")
(pp (table-reader "/proc/swaps"))