lisp/search.lisp @ d3cf0122bca6

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '(:adopt :cl-ppcre) :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.")

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

(defun toplevel ()
  (handler-case
      (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
        (when (gethash 'help options)
          (adopt:print-usage-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))))
    (error (c) (adopt:print-error-and-exit c))))