[nongnu] elpa/haskell-tng-mode 56ee2aa 231/385: completions alpha

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 56ee2aaf7b0808ed6778b68a50d7bcbeb6c53b3e
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    completions alpha
---
 README.md                      |  5 ++++
 haskell-tng-contrib-company.el | 59 ++++++++++++++++++++++++++++++++++++++++--
 haskell-tng-hsinspect.el       | 26 ++++++++++++-------
 haskell-tng-lexer.el           |  2 +-
 haskell-tng-mode.el            |  2 +-
 haskell-tng-rx.el              | 13 +++++-----
 6 files changed, 88 insertions(+), 19 deletions(-)

diff --git a/README.md b/README.md
index d0ee04b..2723450 100644
--- a/README.md
+++ b/README.md
@@ -60,6 +60,11 @@ Built-in navigation commands such as `forward-symbol`, 
`forward-sexp` and `imenu
 
 ## `hsinspect`
 
+```lisp
+  :config
+  (require 'haskell-tng-hsinspect)
+```
+
 The optional command line tool `hsinspect` provides semantic information by 
using the `ghc` api.
 
 `hsinspect` must be installed separately for each version of `ghc` that you 
are using.
diff --git a/haskell-tng-contrib-company.el b/haskell-tng-contrib-company.el
index b98c099..da66a76 100644
--- a/haskell-tng-contrib-company.el
+++ b/haskell-tng-contrib-company.el
@@ -13,13 +13,68 @@
 ;;; Code:
 
 (require 'company)
+(require 'company-dabbrev-code)
+(require 'company-files)
+(require 'company-keywords)
+(require 'smie)
 
 (require 'haskell-tng-hsinspect)
+(require 'haskell-tng-rx)
 
-;; TODO keywords
 ;; TODO completions for imports (needs to know project wide module list)
 ;; TODO completions for symbols (can this be made more contextual)
-;; TODO add-hook and a TNG specific list of default backends
+
+(defcustom haskell-tng-company-backends
+  '(company-files
+    haskell-tng--company-hsinspect
+    (company-dabbrev-code company-keywords))
+  "The company mode backends to use for haskell files"
+  :type 'listp
+  :group 'haskell-tng)
+
+(defun haskell-tng--company-hsinspect (command &optional arg &rest ignored)
+  "`company-mode' backend for `hsinspect'."
+  (interactive (list 'interactive))
+  ;;(message "TNG asked %S" command)
+  (pcase command
+    ;; NOTE: init can run before local variables are set, so we don't want that
+    ('prefix (and (not (company-in-string-or-comment))
+                  (or (looking-at (rx symbol-end))
+                      (eq (char-before) ?.))
+                  (buffer-substring-no-properties
+                   (save-excursion
+                     (funcall smie-backward-token-function)
+                     (let ((lbp (line-beginning-position)))
+                       ;; include FQNs, workaround ungreedy backwards regexp
+                       (while (looking-back haskell-tng--rx-c-qual lbp 't)
+                         ;; TODO try regexp without while
+                         (goto-char (match-beginning 0))))
+                     (point))
+                   (point))))
+    ('candidates
+     ;;(message "TNG asked with %S" arg)
+     (seq-mapcat
+      (lambda (names) (all-completions arg names))
+      (haskell-tng--hsinspect-imports)))
+    ('sorted t)
+    ('duplicates t)
+    ;; TODO 'meta return the FQN
+    ;; TODO 'location (file, line)
+
+    ;; TODO 'annotation when there are multiple choices, with support to either
+    ;; qualify the symbol or to add the relevant hiding clauses to the import
+    ;; section.
+    ))
+
+(add-to-list
+ 'company-keywords-alist
+ `(haskell-tng-mode ,@haskell-tng--keywords))
+
+(add-hook
+ 'haskell-tng-mode-hook
+ (lambda ()
+   (setq-local company-backends haskell-tng-company-backends)
+   (company-mode 1)))
 
 (provide 'haskell-tng-contrib-company)
 ;;; haskell-tng-contrib-company.el ends here
diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index 31ba8ee..5fcd3a8 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -18,21 +18,24 @@
 (defcustom haskell-tng-hsinspect
   ;; TODO https://github.com/haskell/cabal/issues/6182
   ;;
-  ;; the optimisation level (and compiler) must match what the user typed or
-  ;; local packages aren't visible.
-  '("cabal" "v2-exec" "-v0" "-O0" "--")
+  ;; all flags (optimisations, compiler, tests, etc) must match what the user
+  ;; typed or else local packages aren't visible.
+  ;;'("cabal" "v2-exec" "-v0" "-O0" "--enable-tests" "--")
+  '() ;; best to use environment files, less fragile
   "Launch command for the `hsinspect' external tool."
   :type 'listp
   :group 'haskell-tng)
 
 (defvar-local haskell-tng-hsinspect-langexts nil)
 ;; TODO improve the validity checker
+;;;###autoload
 (put 'haskell-tng-hsinspect-langexts 'safe-local-variable #'listp)
 
+;;;###autoload
 (defun haskell-tng-fqn-at-point ()
   "Consult the imports in scope and display the fully qualified
 name of the symbol at point in the minibuffer."
-  (interactive)
+  (interactive) ;; TODO prefix should copy to kill ring
   (if-let* ((sym (symbol-name (symbol-at-point)))
             (found (seq-find
                     (lambda (names) (member sym names))
@@ -49,8 +52,8 @@ name of the symbol at point in the minibuffer."
 t means the process failed.")
 (defun haskell-tng--hsinspect-imports ()
   (if haskell-tng--hsinspect-imports
-      (or (eq t haskell-tng--hsinspect-imports)
-          haskell-tng--hsinspect-imports)
+      (unless (eq t haskell-tng--hsinspect-imports)
+        haskell-tng--hsinspect-imports)
     (setq haskell-tng--hsinspect-imports t) ;; avoid races
     (ignore-errors (kill-buffer "*hsinspect*"))
     (let ((default-directory
@@ -63,9 +66,14 @@ t means the process failed.")
                  ;; TODO launching the correct hsinspect-ghc-X version
                  ;; TODO is there a way to pipe into a string not a buffer?
                  ;; TODO async
-                 (car haskell-tng-hsinspect) nil "*hsinspect*" nil
-                 (append (cdr haskell-tng-hsinspect)
-                         `("hsinspect" "imports" ,buffer-file-name)
+                 (if haskell-tng-hsinspect
+                  (car haskell-tng-hsinspect)
+                  "hsinspect")
+                 nil "*hsinspect*" nil
+                 (append (when haskell-tng-hsinspect
+                           (append (cdr haskell-tng-hsinspect)
+                                   '("hsinspect")))
+                         `("imports" ,buffer-file-name)
                          haskell-tng-hsinspect-langexts)))
           (user-error "`hsinspect' failed. See the *hsinspect* buffer for more 
information.")
         (setq haskell-tng--hsinspect-imports
diff --git a/haskell-tng-lexer.el b/haskell-tng-lexer.el
index 5f6eda0..f040a86 100644
--- a/haskell-tng-lexer.el
+++ b/haskell-tng-lexer.el
@@ -162,7 +162,7 @@ the lexer."
               (haskell-tng--lexer-replay-virtual 'reverse)
 
             (forward-comment (- (point)))
-            (let ((lbp (min (point) (line-beginning-position))))
+            (let ((lbp (line-beginning-position)))
              (cond
               ((bobp) nil)
               ((looking-back haskell-tng--rx-c-reserved-hack
diff --git a/haskell-tng-mode.el b/haskell-tng-mode.el
index 9bc358d..420f2f4 100644
--- a/haskell-tng-mode.el
+++ b/haskell-tng-mode.el
@@ -20,7 +20,6 @@
 
 (require 'haskell-tng-compile)
 (require 'haskell-tng-font-lock)
-(require 'haskell-tng-hsinspect)
 (require 'haskell-tng-imenu)
 (require 'haskell-tng-smie)
 (require 'haskell-tng-syntax)
@@ -85,6 +84,7 @@ Load `prettify-symbols-mode' in `haskell-tng-mode-hook'."
   ;; indentation, so it's best to just make sure it is disabled.
   (electric-indent-local-mode 0)
 
+  (setq-local blink-matching-paren nil) ;; too many "Mismatched parentheses" 
messages
   (setq-local smie-blink-matching-inners nil) ;; c.f. `smie-closer-alist'
 
   (haskell-tng--smie-setup)
diff --git a/haskell-tng-rx.el b/haskell-tng-rx.el
index 650c9ea..4d54d73 100644
--- a/haskell-tng-rx.el
+++ b/haskell-tng-rx.el
@@ -21,6 +21,12 @@
 (defconst haskell-tng--rx-kindsym `(: "'" ,haskell-tng--rx-consym)) ;; 
DataKinds
 (defconst haskell-tng--rx-kindid `(: "'" ,haskell-tng--rx-conid)) ;; DataKinds
 
+(defconst haskell-tng--keywords
+  '("case" "class" "data" "default" "deriving" "do" "else"
+    "foreign" "if" "import" "in" "infix" "infixl"
+    "infixr" "instance" "let" "module" "newtype" "of"
+    "then" "type" "where"))
+
 (defun haskell-tng--rx-reserved (hack)
   "reservedid / reservedop.
 
@@ -33,12 +39,7 @@ TL;DR: regexps don't see some non-capture boundaries outside 
the
 limit, so use POINT as a hint during lexing. If used in
 fontification, a carefully positioned point in e.g. <--> would
 give false positives." `(|
-    (: word-start
-       (| "case" "class" "data" "default" "deriving" "do" "else"
-          "foreign" "if" "import" "in" "infix" "infixl"
-          "infixr" "instance" "let" "module" "newtype" "of"
-          "then" "type" "where" "_")
-       word-end)
+    (: word-start (| ,@haskell-tng--keywords "_") word-end)
     (: symbol-start "\\case" word-end) ;; LambdaCase
     (: "{..}") ;; RecordWildCards
     (: word-start "':" symbol-end) ;; DataKinds (consider foo':bar)