guile-examples/shell/guile-shell/commands/cut.scm

(library (commands cut)
  (export cut)
  (import (except (rnrs base) error map)
          (only (guile)
                lambda* λ
                ;; control flow
                when
                unless
                ;; ports
                current-input-port
                current-output-port
                current-error-port
                with-input-from-port
                with-output-to-port
                with-error-to-port
                call-with-input-file
                eof-object?
                ;; string formatting
                simple-format
                ;; basic shell procedures guile provides
                getcwd
                chdir
                ;; strings
                string-split
                peek)
          (ice-9 exceptions)
          ;; pipes
          ;; (ice-9 popen)
          ;; (ice-9 textual-ports)
          ;; (ice-9 binary-ports)
          ;; ftw stands for file-tree-walk
          ;; for file-system-tree
          (ice-9 ftw)
          ;; for match-lambda
          (ice-9 match)
          ;; lists
          (srfi srfi-1)
          ;; receive form
          (srfi srfi-8)
          ;; strings
          (srfi srfi-13)
          (file)
          (alias)
          (list-helpers)
          (string-helpers)
          (alist-helpers)
          (shell-state)
          (exceptions)
          (commands utils))

  ;; TODO cleanup imports


  (define cut-single-line
    (λ (line fields delimiter output-delimiter)
      (let ([parts (string-split line (λ (c) (char=? c delimiter)))])

        (define cut-with-fields-list
          (λ ()
            (let ([selected-parts
                   (take-indices parts
                                 (map (λ (field) (- field 1))
                                      (unique fields #:eq-test = #:less <)))])
              (string-join selected-parts output-delimiter))))

        (define cut-with-fields-range
          (λ ()
            (string-join (take-range parts
                                     (- (car fields) 1)
                                     (- (cdr fields) 1))
                         output-delimiter)))

        (define cut-with-single-field
          (λ ()
            (let ([index (- fields 1)])
              ;; IDEA: Handle ranges with too high upper limit without error -- maybe.
              (guard (con [(eq? (exception-kind con) 'out-of-range)
                           (raise-exception
                            (make-exception
                             (make-error)
                             (make-exception-with-message
                              "passed out of bounds field number to cut")
                             (make-exception-with-irritants (list parts index))
                             (make-exception-with-origin 'cut)))])
                (let ([result (list-ref parts index)])
                  result)))))

        (cond
         [(list? fields)
          (cut-with-fields-list)]
         [(pair? fields)
          (cut-with-fields-range)]
         [(and (integer? fields) (positive? fields))
          (cut-with-single-field)]
         [else
          (raise-exception
           (make-exception
            (make-non-continuable-error)
            (make-exception-with-message "fields arguments not a list, pair, or integer")
            (make-exception-with-irritants (list fields))
            (make-exception-with-origin 'cut)))]))))


  (define cut
    (lambda* (fields
              #:optional
              (filename #f)
              #:key
              (delimiter "\t")
              (output-delimiter #f)
              ;; TODO: Implement taking the complement of fields. For
              ;; this we would need to know how many parts there are.
              (complement #f)
              ;; command interface
              (previous-result '())
              (shell-state default-shell-state)
              (silent #f))
      "Cuts INPUT into parts and selects the parts specified via
FIELDS. FIELDS can be a list of numbers or a pair of
numbers, representing a range."
      (let ([actual-output-delimiter
             (if output-delimiter output-delimiter (char->string delimiter))])
        (cond
         ;; read from input file
         [filename
          (values (call-with-input-file filename
                    (λ (port)
                      (process-input-port port
                                          (λ (line)
                                            (cut-single-line line
                                                             fields
                                                             delimiter
                                                             actual-output-delimiter)))))
                  shell-state)]
         ;; read from input port
         [(null? previous-result)
          ;; TODO: should this case exist?
          (values (let ([port (current-input-port)])
                    (process-input-port port
                                        (λ (line)
                                          (cut-single-line line
                                                           fields
                                                           delimiter
                                                           actual-output-delimiter))))
                  shell-state)]
         ;; use previous result
         [else
          (values
           (map (λ (line)
                  (cut-single-line line
                                   fields
                                   delimiter
                                   actual-output-delimiter))
                previous-result)
           shell-state)])))))

;; TODO: idea: allow list of delimiters