lisp/search.lisp @ b0c1c5bcfc3b

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '(:adopt :cl-ppcre :with-user-abort) :silent t))

(defpackage :search
  (:use :cl)
  (:export :toplevel :*ui*))

(in-package :search)

;;;; Functionality ------------------------------------------------------------
(defun make-scanner (pattern &key literal)
  (let ((ppcre:*use-bmh-matchers* t)
        (ppcre:*optimize-char-classes* :charmap)
        (ppcre:*regex-char-code-limit* 128))
    (ppcre:create-scanner (if literal
                            `(:sequence ,pattern)
                            (ppcre:parse-string pattern)))))

(defun search-stream (scanner stream &key invert)
  (loop
    :for line = (read-line stream nil nil nil)
    :while line
    :when (eq invert (not (ppcre:scan scanner line)))
    :do (write-line line)))

(defun search-file (scanner path &key invert)
  (with-open-file (stream path :external-format '(:ascii :replacement #\?))
    (search-stream scanner stream :invert invert)))

(defun run (pattern paths &key literal invert)
  (loop
    :with scanner = (make-scanner pattern :literal literal)
    :for path :in paths
    :do (if (string= "-" path)
          (search-stream scanner *standard-input* :invert invert)
          (search-file scanner path :invert invert))))


;;;; CLI ----------------------------------------------------------------------
(adopt:define-string *documentation*
  "A simple reimplementation of grep in Common Lisp.  FILEs will be searched ~
  for lines that match PATTERN and matching lines will be printed.~@
  ~@
  Perl-compatible regular expressions are supported.~@
  ~@
  If no FILEs are given, standard input will be searched.  Standard input can ~
  also be searched by specifying - as a filename.")


(defparameter *ui*
  (adopt:make-interface
    :name "search"
    :usage "PATTERN [FILE...]"
    :summary "Print lines that match a regular expression."
    :help *documentation*
    :contents
    (list
      (adopt:make-option 'help
        :help "display help and exit"
        :long "help"
        :short #\h
        :reduce (constantly t))
      (adopt:make-option 'literal
        :help "treat PATTERN as a literal string instead of a regex"
        :long "literal"
        :short #\l
        :reduce (constantly t))
      (adopt:make-option 'no-literal
        :result-key 'literal
        :help "treat PATTERN as a regex (the default)"
        :long "no-literal"
        :short #\L
        :reduce (constantly nil))
      (adopt:make-option 'invert
        :help "print non-matching lines"
        :long "invert"
        :short #\v
        :initial-value nil
        :reduce (constantly t))
      (adopt:make-option 'no-invert
        :result-key 'invert
        :help "print matching lines (the default)"
        :long "no-invert"
        :short #\V
        :reduce (constantly nil)))))

(defun toplevel ()
  (handler-case
      (with-user-abort:with-user-abort
        (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
          (when (gethash 'help options)
            (adopt:print-help-and-exit *ui*))
          (when (null arguments)
            (error "PATTERN is required"))
          (destructuring-bind (pattern . paths) arguments
            (run pattern (or paths (list "-"))
                 :literal (gethash 'literal options)
                 :invert (gethash 'invert options)))))
    (with-user-abort:user-abort () (adopt:exit 130))
    (error (c) (adopt:print-error-and-exit c))))