diff --git a/consult-hoogle.el b/consult-hoogle.el index 6922e5d..855c17c 100644 --- a/consult-hoogle.el +++ b/consult-hoogle.el @@ -1,19 +1,20 @@ ;;; consult-hoogle.el --- Hoogle frontend using consult -*- lexical-binding: t; -*- -;; + ;; Created: April 10, 2022 -;; Modified: April 10, 2022 +;; Modified: April 10, 2022 <-- remove this if you don't keep it updated ;; License: GPL-3.0-or-later ;; Version: 0.0.1 ;; Keywords: docs languages ;; Homepage: https://github.com/aikrahguzar/consult-hoogle ;; Package-Requires: ((emacs "27.1") (haskell-mode "16.1")) -;; + ;; This file is not part of GNU Emacs. -;; + ;;; Commentary: + ;; Search the local hoogle database from Emacs using the nicities provided by ;; consult. -;; + ;;; Code: ;;;; Packages @@ -26,17 +27,17 @@ (defcustom consult-hoogle-args '("hoogle" . ("search" "--jsonl" "-q" "--count=250")) "The hoogle invocation used to get results. -It is should be a cons (COMMAND . ARGS). COMMAND should be valid executable. +It is should be a cons (COMMAND . ARGS). COMMAND should be valid executable. It is called arguments ARGS with the search query appended. It should produce search results in JSON lines format." :type '(cons (string :tag "Hoogle command") (repeat :tag "Args for hoogle" string)) - :group 'consult) + :group 'consult) ;wouldn't it be better to define your own group? (defcustom consult-hoogle-project-args '("cabal-hoogle" . ("run" "--" "search" "--jsonl" "-q" "--count=250")) "The cabal-hoogle invocation used to get results for current project. -It should be cons (COMMAND . ARGS). See `consult-hoogle-args' for details. By +It should be cons (COMMAND . ARGS). See `consult-hoogle-args' for details. By default it uses `cabal-hoogle' https://github.com/kokobd/cabal-hoogle ." :type '(cons (string :tag "Project specific hoogle command") (repeat :tag "Args for hoogle" string)) @@ -52,6 +53,9 @@ default it uses `cabal-hoogle' https://github.com/kokobd/cabal-hoogle ." (defvar consult-hoogle-map (let ((map (make-sparse-keymap))) + ;; if this is building on consult, can you rebind some keys + ;; instead of hard-coding key chords that the user might have + ;; modified? (define-key map (kbd "M-i") #'consult-hoogle-browse-item) (define-key map (kbd "M-j") #'consult-hoogle-browse-package) (define-key map (kbd "M-m") #'consult-hoogle-browse-module) @@ -80,7 +84,7 @@ default it uses `cabal-hoogle' https://github.com/kokobd/cabal-hoogle ." "Fontify TEXT, returning the fontified text. This is adapted from `haskell-fontify-as-mode' but for better performance we use the same buffer throughout." - (with-current-buffer " *Hoogle Fontification*" + (with-current-buffer " *Hoogle Fontification*" ;why not use a temporary buffer? (erase-buffer) (insert text) (font-lock-ensure) @@ -217,7 +221,7 @@ STATE is the optional state function passed to the `consult--read'." (let ((consult-async-min-input 0) (fun (or action (lambda (alist) (consult-hoogle--browse-url 'item alist))))) (with-current-buffer (get-buffer-create " *Hoogle Fontification*" t) - (let (haskell-mode-hook) + (let (haskell-mode-hook) ;do you always want this? (haskell-mode))) (unwind-protect (funcall fun (consult--read @@ -242,11 +246,11 @@ STATE is the optional state function passed to the `consult--read'." (defun consult-hoogle (arg) "Search the local hoogle database. By default this shows the documentation for the current candidate in a side -window. This can be disabled by a prefix ARG." +window. This can be disabled by a prefix ARG." (interactive (list current-prefix-arg)) (if arg (consult-hoogle--search) (let* ((buf (get-buffer-create " *Hoogle Documentation*" t)) - (height (if (bound-and-true-p vertico-count) + (height (if (bound-and-true-p vertico-count) ;can this support icomplete as well? vertico-count 10)) (window (display-buffer buf @@ -267,7 +271,7 @@ By default uses cabal-hoogle and the database should have been generated by running `cabal-hoogle generate'. `consult-hoogle-project-args' can be customized to configure an alternate command. By default this shows the documentation for the current candidate in a side -window. This can be disabled by a prefix ARG." +window. This can be disabled by a prefix ARG." (interactive (list current-prefix-arg)) (let ((consult-hoogle-args consult-hoogle-project-args) (default-directory (haskell-cabal-find-dir))) @@ -300,13 +304,15 @@ window. This can be disabled by a prefix ARG." (scroll-up arg))) (defun consult-hoogle-restrict-to-package (package &optional arg) - "Restrict the search to PACKAGE. With prefix ARG exluce package from search." + "Restrict the search to PACKAGE. +With prefix ARG exluce package from search." (interactive (list (consult-hoogle--get 'package) current-prefix-arg)) (when package (consult-hoogle--add-to-input (if arg "-" "+") (downcase package)))) (defun consult-hoogle-restrict-to-module (module &optional arg) - "Restrict the search to MODULE. With prefix ARG exluce module from search." + "Restrict the search to MODULE. +With prefix ARG exluce module from search." (interactive (list (consult-hoogle--get 'module) current-prefix-arg)) (when module (consult-hoogle--add-to-input (if arg "-" "+") module))) @@ -319,8 +325,7 @@ If called with numeric prefix LEVEL only use first ARG levels of module." (consult-hoogle--add-to-input (if (> level 0) "+" "-") (progn - (string-match (rx-to-string - `(: bos (= ,(abs level) (: (1+ (not ".")) (?? "."))))) + (string-match (rx bos (= ,(literal (abs level)) (: (1+ (not ".")) (?? ".")))) module) (match-string 0 module))))) @@ -333,22 +338,21 @@ If called with numeric prefix LEVEL only use last ARG levels of module." (consult-hoogle--add-to-input (if (> level 0) "+" "-") (progn - (string-match (rx-to-string - `(: (= ,(abs level) (: (1+ (not ".")) (?? "."))) eos)) + (string-match (rx (= (literal (abs level)) (: (1+ (not ".")) (?? "."))) eos) module) (match-string 0 module))))) (defun consult-hoogle-clear-restrictions (arg) "Clear all restrictions and exclusions on the search. -With positive prefix ARG only clear restrictions. With negative prefix +With positive prefix ARG only clear restrictions. With negative prefix only clear exclusions." (interactive (list (when current-prefix-arg (prefix-numeric-value current-prefix-arg)))) - (let* ((restriction-rx (rx-to-string `(: ,(if (not arg) - '(or "+" "-") - (if (> arg 0) "+" "-")) - (0+ (not space)) - (or (1+ space) eos))))) + (let* ((restriction-rx (rx + (literal (if (not arg) + '(or "+" "-") + (if (> arg 0) "+" "-"))) + (0+ (not space))))) (consult-hoogle--modify-async-input (lambda (match) (replace-regexp-in-string restriction-rx "" match)))))