diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs index a386e7e..0b53f3b 100644 --- a/Language/Haskell/GhcMod/Convert.hs +++ b/Language/Haskell/GhcMod/Convert.hs @@ -81,6 +81,11 @@ instance ToString ((Int,Int,Int,Int),String) where toLisp opt x = ('(' :) . tupToString opt x . (')' :) toPlain opt x = tupToString opt x +instance ToString ((Int,Int,Int,Int),[String]) where + toLisp opt (x,s) = ('(' :) . fourIntsToString opt x . + (' ' :) . toLisp opt s . (')' :) + toPlain opt (x,s) = fourIntsToString opt x . ('\n' :) . toPlain opt s + instance ToString (String, (Int,Int,Int,Int),[String]) where toLisp opt (s,x,y) = toSexp2 [toLisp opt s, ('(' :) . fourIntsToString opt x . (')' :), toLisp opt y] toPlain opt (s,x,y) = inter '\n' [toPlain opt s, fourIntsToString opt x, toPlain opt y] diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index e5d197a..eb10b1f 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -8,7 +8,7 @@ module Language.Haskell.GhcMod.FillSig ( import Data.Char (isSymbol) import Data.Function (on) -import Data.List (find, sortBy) +import Data.List (find, nub, sortBy) import Data.Maybe (isJust) import Exception (ghandle, SomeException(..)) import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) @@ -332,7 +332,7 @@ auto file lineNo colNo = ghandle handler body p <- G.parseModule modSum tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p whenFound' opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, _name, rty, paren) -> do - text:_ <- djinn False rty - return (fourInts loc, doParen paren text) + djinns <- djinn True rty + return (fourInts loc, map (doParen paren) (nub djinns)) handler (SomeException _) = emptyResult =<< options diff --git a/elisp/ghc-func.el b/elisp/ghc-func.el index 5d73c60..e17fb33 100644 --- a/elisp/ghc-func.el +++ b/elisp/ghc-func.el @@ -146,7 +146,25 @@ (defconst ghc-error-buffer-name "*GHC Info*") (defun ghc-display (fontify ins-func) - (let ((buf ghc-error-buffer-name)) + (ghc-display-with-name fontify ins-func ghc-error-buffer-name)) + +;; (defun ghc-display (fontify ins-func) +;; (let ((buf ghc-error-buffer-name)) +;; (with-output-to-temp-buffer buf +;; (with-current-buffer buf +;; (erase-buffer) +;; (funcall ins-func) +;; (goto-char (point-min)) +;; (if (not fontify) +;; (turn-off-haskell-font-lock) +;; (haskell-font-lock-defaults-create) +;; (turn-on-haskell-font-lock))) +;; (display-buffer buf +;; '((display-buffer-reuse-window +;; display-buffer-pop-up-window)))))) + +(defun ghc-display-with-name (fontify ins-func name) + (let ((buf name)) (with-output-to-temp-buffer buf (with-current-buffer buf (erase-buffer) diff --git a/elisp/ghc-rewrite.el b/elisp/ghc-rewrite.el index 764129e..a392567 100644 --- a/elisp/ghc-rewrite.el +++ b/elisp/ghc-rewrite.el @@ -70,6 +70,50 @@ (cmd (format "refine %s %s %s %s\n" file ln cn expr))) (ghc-sync-process cmd))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Auto +;;; + +(defun ghc-perform-rewriting-auto (info) + "Replace code with new string obtained from ghc-mod from auto mode" + (let* ((current-line (line-number-at-pos)) + (begin-line (ghc-sinfo-get-beg-line info)) + (begin-line-diff (+ 1 (- begin-line current-line))) + (begin-line-pos (line-beginning-position begin-line-diff)) + (begin-pos (- (+ begin-line-pos (ghc-sinfo-get-beg-column info)) 1)) + (end-line (ghc-sinfo-get-end-line info)) + (end-line-diff (+ 1 (- end-line current-line))) + (end-line-pos (line-beginning-position end-line-diff)) + (end-pos (- (+ end-line-pos (ghc-sinfo-get-end-column info)) 1)) ) + (delete-region begin-pos end-pos) + (insert (first (ghc-sinfo-get-info info))) ) + ) + +(defun ghc-show-auto-messages (msgs) + (ghc-display-with-name nil + (lambda () + (insert "Possible completions:\n") + (mapc (lambda (x) (insert "- " x "\n")) msgs)) + "*Djinn completions*")) + +(defun ghc-auto () + "Try to automatically fill the contents of a hole" + (interactive) + (let ((info (ghc-obtain-auto))) + (if (null info) + (message "No automatic completions found") + (if (= (length (ghc-sinfo-get-info info)) 1) + (ghc-perform-rewriting-auto info) + (ghc-show-auto-messages (ghc-sinfo-get-info info)))))) + +(defun ghc-obtain-auto () + (let* ((ln (int-to-string (line-number-at-pos))) + (cn (int-to-string (1+ (current-column)))) + (file (buffer-file-name)) + (cmd (format "auto %s %s %s\n" file ln cn))) + (ghc-sync-process cmd))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Initial code from signature diff --git a/elisp/ghc.el b/elisp/ghc.el index 3440b70..9260181 100644 --- a/elisp/ghc.el +++ b/elisp/ghc.el @@ -76,6 +76,7 @@ (defvar ghc-case-split-key "\C-c\C-s") (defvar ghc-initial-sig-key "\C-c\C-g") (defvar ghc-refine-key "\C-c\C-r") +(defvar ghc-auto-key "\C-c\C-a") (defvar ghc-prev-hole-key "\C-c\ep") (defvar ghc-next-hole-key "\C-c\en") @@ -113,6 +114,7 @@ (define-key haskell-mode-map ghc-case-split-key 'ghc-case-split) (define-key haskell-mode-map ghc-initial-sig-key 'ghc-initial-code-from-signature) (define-key haskell-mode-map ghc-refine-key 'ghc-refine) + (define-key haskell-mode-map ghc-auto-key 'ghc-auto) (define-key haskell-mode-map ghc-prev-hole-key 'ghc-goto-prev-hole) (define-key haskell-mode-map ghc-next-hole-key 'ghc-goto-next-hole) (ghc-comp-init)