2016-09-13 - Best Flex Matcher

flexer.el

; -*- lexical-binding: t; -*-
(require 'dash)
(require 's)

(require 'smex)

(require 'promise)
(require 'stream)
(require 'transducer )

(defconst fb/frame-rate (/ 30.0))

(defun fb/text-forward-permutations (text)
  (letrec ((recurser
       (lambda (sub-text)
         (cond
          ((string-empty-p sub-text)
           (stream-from-list (list "")))
          ((= (length sub-text) 1)
           (stream-from-list (list sub-text "")))
          ((= (length sub-text) 2)
           (stream-from-list
            (list
             ""
             (substring-no-properties sub-text 0 1)
             (substring-no-properties sub-text 1 2)
             sub-text)))
          (t
           (lexical-let* ((first-text
                (substring-no-properties sub-text 0 1))
               (rest-text
                (substring-no-properties sub-text 1)))
             (lexical-let* ((rest-permutations (funcall recurser rest-text))
                 (repeat-permutations (stream-copy 'empty rest-permutations))
                 (base-stream (car repeat-permutations))
                 (next-stream (cdr repeat-permutations)))
               (stream-append
                (transducer-transduce-stream
                 (transducer-map (-partial #'concat first-text))
                 base-stream)
                next-stream))))))))
    (funcall recurser text)))

(defun fb/stream-time-buffered (buffer-time stream)
  (stream
   (lambda (&rest args)
     (lexical-let ((initial-value (apply stream args))
                   (done nil)
                   (now (current-time)))
       (when (stream-start-value-p initial-value)
         (setq initial-value (apply stream args)))
       (if (stream-stop-value-p initial-value)
           stream-stop
         (promise
          (lambda (res rej)
            (lexical-let ((buffered-values (list initial-value))
                          (elapsed-time (float-time (time-subtract (current-time) now)))
                          (current-value initial-value))
              (while (and (not done)
                          (< elapsed-time buffer-time))
                (if (stream-stop-value-p current-value)
                    (setq done t)
                  (push current-value buffered-values)
                  (setq current-value (apply stream args))
                  (setq elapsed-time (float-time (time-subtract (current-time) now)))))
              (funcall res (reverse buffered-values))))))))))

(defun fb/flex-match-text (text)
  (concat
   (regexp-quote (string (aref text 0)))
   (mapconcat
    (lambda (c)
      (concat "[^" (string c) "]*"
              (regexp-quote (string c))))
    (substring text 1) "")))

(defun fb/function-symbol-stream ()
  (transducer-transduce-stream
   (transducer-map #'car)
   (stream-from-list smex-cache)))

(defun fb/flex-match-symbol-stream (search symbol-stream)
  (let ((re (fb/flex-match-text search)))
    (transducer-transduce-stream
     (transducer-composes
      (transducer-map #'symbol-name)
      (transducer-filter (-partial #'s-match re)))
     symbol-stream)))

(defun fb/rate-flex-match (search target)
  (transducer-transduce-stream
   (transducer-composes
    (transducer-map-indexed #'cons)
    (transducer-first
     (lambda (pair)
       (string-equal (cdr pair) target))))
   (fb/flex-match-symbol-stream
    search
    (fb/function-symbol-stream))))

(defun fb/function-symbol-p (name)
  (not
   (null
    (stream-to-list
     (transducer-transduce-stream
        (transducer-first (-partial #'string-equal name))
        (fb/function-symbol-stream))))))

(defun fb/rate-flex-matcher (search-size target)
  (if (not (fb/function-symbol-p target))
      (stream-stopped)
    (lexical-let*
        ((rater (-rpartial #'fb/rate-flex-match target))
         (rate-stream
          (transducer-transduce-stream
           (transducer-composes
            (transducer-filter
             (lambda (search)
               (and
                (not (string-empty-p search))
                (<= (length search) search-size))))
            (transducer-filter
             (lambda (search)
               (string-equal
                (substring-no-properties search 0 1)
                (substring-no-properties target 0 1))))
            (transducer-filter
             (lambda (search)
               (not
                (s-contains-p
                 "-"
                 search))))
            (transducer-map
             (lambda (search)
               (cons
                search
                (stream-to-list (funcall rater search)))))
            (transducer-filter
             (lambda (pair)
               (and
                (not (null (cdr pair)))
                (= 0 (car (car (cdr pair)))))))
            (transducer-map
             (lambda (pair)
               (car pair))))
           (fb/text-forward-permutations target))))
      rate-stream)))

(defun fb/async-write-stream (file stream)
  (with-temp-file file
    (erase-buffer))
  (letrec ((async-stream
            (fb/stream-time-buffered
             fb/frame-rate
             stream))
           (recurser
            (lambda ()
              (let ((value (funcall async-stream)))
                (when (stream-start-value-p value)
                  (setq value (funcall async-stream)))
                (if (stream-stop-value-p value)
                    (message "Done")
                  (promise-then
                   value
                   (lambda (values)
                     (when values
                       (append-to-file
                        (concat
                         (string-join
                          values
                          "\n")
                         "\n")
                        nil
                        file))
                     (run-with-idle-timer
                      fb/frame-rate
                      nil
                      recurser))))))))
    (funcall recurser)))