(use magic-pipes)
(use args)
(use irregex)
(use alist-lib)
(use chicken-syntax)

(define opts
  (list
   (args:make-option (p pcre) #:none
                     "Parse the regexp as a pcre regexp string rather than as an SRE")
   (args:make-option (o output) (required: "PROCEDURE-EXPR")
                     "Pass the matches to the provided regexp to produce output sexprs")))

(define (default-out-proc m)
  ;; The order in which irregex gives us the names isn't defined,
  ;; but reversal seems to produce the order encountered in the regexp.
  (let ((names (reverse! (map car (irregex-match-names m)))))
    (if (null? names)
        (if (> (irregex-match-num-submatches m) 0)
            ;; No named submatches, so return a list of numbered ones
            (list-tabulate (irregex-match-num-submatches m)
                           (lambda (idx)
                             (irregex-match-substring m (+ idx 1))))
            ;; No submatches at all, so return the entire line
            (irregex-match-substring m 0))
        ;; Named submatches, so return an alist of them
        ;; (this loses numbered submatches, but what can we do?)
        (map (lambda (name)
               (cons name
                     (irregex-match-substring m name))) names))))

(receive (options operands before-exprs after-exprs usage)
         (parse-mp-args (command-line-arguments) opts
                        "regexp"
                        "Read in lines of arbitrary text from standard input and
matches them against the supplied regular expression. Lines
not matching the regexp are ignored. Each matching line
produces an irregex match object, which is passed to
the output proc, and the result written to standard
output. The default output proc generates an alist of
submatches from the regular expression.")
         (unless (= (length operands) 1)
                 (usage))
         (let* ((regexp-src (car operands))
                (regexp (if (assq 'p options)
                            (string->irregex regexp-src)
                            (sre->irregex (parse-code regexp-src))))
                (out-expr (parse-code (alist-ref options 'output (lambda () "#f"))))
                (ec (make-eval-context before-exprs (list out-expr) after-exprs))
                (out-proc* (eval-context-handler-closure ec 0))
                (out-proc (if out-proc*
                              out-proc*
                              default-out-proc)))
           (let loop ()
             (let ((line (read-line)))
               (unless (eof-object? line)
                       (let ((m (irregex-match regexp line)))
                         (when m
                               (with-values-to-output
                                (lambda ()
                                  (without-input-port
                                   (lambda ()
                                     (out-proc m)))))))
                       (loop))))
           (without-input-port
            (eval-context-end-closure ec))))