fork download
copy 
  1. ; grep-csv n regex -- read csv-formatted file line-by-line
  2. ; from standard input and write to standard output those
  3. ; lines for which the n'th field (counting from 1) matches
  4. ; the regular expression
  5.  
  6. ; --+----1----+----2----+----3----+----4----+----5----+----6---
  7.  
  8. ; READ-CSV-RECORD [DELIM] [PORT]
  9. (define (read-csv-record . args)
  10.   (define (read-csv delim port)
  11.     (define (add-field field fields)
  12.       (cons (list->string (reverse field)) fields))
  13.     (define (start field fields)
  14.       (let ((c (read-char port)))
  15.         (cond ((eof-object? c) (reverse fields))
  16.               ((char=? #\return c)
  17.                 (carriage-return field fields))
  18.               ((char=? #\newline c) (line-feed field fields))
  19.               ((char=? #\" c) (quoted-field field fields))
  20.               ((char=? delim c)
  21.                 (not-field '() (add-field field fields)))
  22.               (else (unquoted-field (cons c field) fields)))))
  23.     (define (not-field field fields)
  24.       (let ((c (read-char port)))
  25.         (cond ((eof-object? c) (cons "" fields))
  26.               ((char=? #\return c)
  27.                 (carriage-return '() (add-field field fields)))
  28.               ((char=? #\newline c)
  29.                 (line-feed '() (add-field field fields)))
  30.               ((char=? #\" c) (quoted-field field fields))
  31.               ((char=? delim c)
  32.                 (not-field '() (add-field field fields)))
  33.               (else (unquoted-field (cons c field) fields)))))
  34.     (define (quoted-field field fields)
  35.       (let ((c (read-char port)))
  36.         (cond ((eof-object? c) (add-field field fields))
  37.               ((char=? #\" c)
  38.                 (may-be-doubled-quotes field fields))
  39.               (else (quoted-field (cons c field) fields)))))
  40.     (define (may-be-doubled-quotes field fields)
  41.       (let ((c (read-char port)))
  42.         (cond ((eof-object? c) (add-field field fields))
  43.               ((char=? #\return c)
  44.                 (carriage-return '() (add-field field fields)))
  45.               ((char=? #\newline c)
  46.                 (line-feed '() (add-field field fields)))
  47.               ((char=? #\" c)
  48.                 (quoted-field (cons #\" field) fields))
  49.               ((char=? delim c)
  50.                 (not-field '() (add-field field fields)))
  51.               (else (unquoted-field (cons c field) fields)))))
  52.     (define (unquoted-field field fields)
  53.       (let ((c (read-char port)))
  54.         (cond ((eof-object? c) (add-field field fields))
  55.           ((char=? #\return c)
  56.             (carriage-return '() (add-field field fields)))
  57.           ((char=? #\newline c)
  58.             (line-feed '() (add-field field fields)))
  59.           ((char=? delim c)
  60.             (not-field '() (add-field field fields)))
  61.           (else (unquoted-field (cons c field) fields)))))
  62.     (define (carriage-return field fields)
  63.       (let ((c (peek-char port)))
  64.         (cond ((eof-object? c) fields)
  65.               ((char=? #\newline c) (read-char port) fields)
  66.               (else fields))))
  67.     (define (line-feed field fields)
  68.       (let ((c (peek-char port)))
  69.         (cond ((eof-object? c) fields)
  70.               ((char=? #\return c) (read-char port) fields)
  71.               (else fields))))
  72.     (if (eof-object? (peek-char port)) (peek-char port)
  73.       (reverse (start '() '()))))
  74.   (cond ((null? args) (read-csv #\, (current-input-port)))
  75.         ((and (null? (cdr args)) (char? (car args)))
  76.           (read-csv (car args) (current-input-port)))
  77.         ((and (null? (cdr args)) (port? (car args)))
  78.           (read-csv #\, (car args)))
  79.         ((and (pair? (cdr args)) (null? (cddr args))
  80.               (char? (car args)) (port? (cadr args)))
  81.           (read-csv (car args) (cadr args)))
  82.         (else (read-csv #\, (current-input-port)))))
  83.  
  84. ; FILTER-PORT READER PRED?
  85. (define (filter-port reader pred?)
  86.   (lambda args
  87.     (let loop ((x (apply reader args)))
  88.       (cond ((eof-object? x) x)
  89.             ((pred? x) x)
  90.             (else (loop (apply reader args)))))))
  91.  
  92. ; FOR-EACH-PORT READER PROC [PORT]
  93. (define (for-each-port reader proc . port)
  94.   (let ((p (if (null? port) (current-input-port) (car port))))
  95.     (let loop ((item (reader p)))
  96.       (if (not (eof-object? item))
  97.         (begin (proc item) (loop (reader p)))))))
  98.  
  99. ; QUOTE-CSV DELIM STR
  100. (define (quote-csv delim str)
  101.   (define (string-find str pat)
  102.     (let loop ((i 0))
  103.       (cond ((<= (string-length str) i) #f)
  104.             ((string=? (substring str i (+ i (string-length pat))) pat) i)
  105.             (else (loop (+ i 1))))))
  106.   (define (string-replace-all str pat repl)
  107.     (let ((len-str (string-length str))
  108.           (len-pat (string-length pat))
  109.           (spot (string-find str pat)))
  110.       (if spot
  111.           (string-append
  112.             (substring str 0 spot)
  113.             repl
  114.             (string-replace-all (substring (+ spot len-pat) len-str pat repl)))
  115.             str)))
  116.   (let ((new-str (string-replace-all str "\"" "\"\"")))
  117.     (if (or (string-find str (string delim))
  118.             (not (string=? str new-str))
  119.             (string-find str (string #\return))
  120.             (string-find str (string #\newline)))
  121.         (string-append "\"" new-str "\"")
  122.         str)))
  123.  
  124.  
  125.  
  126. ; WRITE-CSV-RECORD REC [DELIM] [PORT]
  127.  
  128. (define (write-csv-record rec . args)
  129.   (define (write-csv delim port)
  130.     (do ((rec rec (cdr rec)))
  131.         ((null? rec) (newline port))
  132.       (display (quote-csv delim (car rec)) port)
  133.       (if (pair? (cdr rec)) (display delim port))))
  134.   (cond ((null? args) (write-csv #\, (current-output-port)))
  135.         ((and (null? (cdr args)) (char? (car args)))
  136.           (write-csv (car args) (current-output-port)))
  137.         ((and (null? (cdr args)) (port? (car args)))
  138.           (write-csv #\, (car args)))
  139.         ((and (pair? (cdr args)) (null? (cddr args))
  140.               (char? (car args)) (port? (cadr args)))
  141.           (write-csv (car args) (cadr args)))
  142.         (else (write-csv #\, (current-output-port)))))
  143.  
  144. (define (trex regex text) ; tiny regular expression matcher
  145.   ;    c -- match the literal character c
  146.   ;    . -- (dot) match any single character
  147.   ;    * -- match zero or more of preceding character
  148.   ;    ^ -- match beginning of search string
  149.   ;    $ -- match end of search string
  150.   ; based on Kernighan/Pike -- The Practice of Programming
  151.   ; https://p...content-available-to-author-only...s.com/2009/09/11/beautiful-code/
  152.   (define (match regex text)
  153.     (cond ((null? regex) #t)
  154.           ((null? text) #f)
  155.           ((char=? (car regex) #\^)
  156.             (match-here (cdr regex) text))
  157.           (else (or (match-here regex text)
  158.                     (match regex (cdr text))))))
  159.   (define (match-here regex text)
  160.     (cond ((null? regex) #t)
  161.           ((and (pair? (cdr regex))
  162.                 (char=? (cadr regex) #\*))
  163.             (match-star (car regex) (cddr regex) text))
  164.           ((and (char=? (car regex) #\$)
  165.                 (null? (cdr regex)))
  166.             (null? text))
  167.           ((and (pair? text)
  168.                 (or (char=? (car regex) #\.)
  169.                     (char=? (car regex) (car text))))
  170.             (match-here (cdr regex) (cdr text)))
  171.           (else #f)))
  172.   (define (match-star c regex text)
  173.     (cond ((match-here regex text) #t)
  174.           ((and (pair? text)
  175.                 (or (char=? (car text) c)
  176.                     (char=? c #\.)))
  177.             (match-star c regex (cdr text)))
  178.           (else #f)))
  179.   (match (string->list regex) (string->list text)))
  180.  
  181. (define (grep-csv n regex)
  182.   (for-each-port
  183.     (filter-port read-csv-record
  184.       (lambda (line) (trex regex (list-ref line (- n 1)))))
  185.     (lambda (line) (write-csv-record line))))
  186.  
  187. (grep-csv 2 "e.*s")
Success #stdin #stdout 0.03s 50936KB
comments (?)
stdin
copy 
Charles,Dickens,Great Expectations,1861
Mark,Twain,The Adventures of Tom Sawyer,1876
William,Shakespeare,Julius Caesar,1599
Isaac,Newton,Philosophiae Naturalis Principia Mathematica,1687
stdout
copy 
Charles,Dickens,Great Expectations,1861
William,Shakespeare,Julius Caesar,1599
https://ideone.com/fGHhRb
language:
Scheme (guile 2.2.4)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!