Show more than one Djinn completion

This commit is contained in:
Alejandro Serrano 2014-08-02 09:52:36 +02:00
parent 31a7ce3d19
commit 3aa83e14dd
5 changed files with 73 additions and 4 deletions

View File

@ -81,6 +81,11 @@ instance ToString ((Int,Int,Int,Int),String) where
toLisp opt x = ('(' :) . tupToString opt x . (')' :) toLisp opt x = ('(' :) . tupToString opt x . (')' :)
toPlain 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 instance ToString (String, (Int,Int,Int,Int),[String]) where
toLisp opt (s,x,y) = toSexp2 [toLisp opt s, ('(' :) . fourIntsToString opt x . (')' :), toLisp opt y] 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] toPlain opt (s,x,y) = inter '\n' [toPlain opt s, fourIntsToString opt x, toPlain opt y]

View File

@ -8,7 +8,7 @@ module Language.Haskell.GhcMod.FillSig (
import Data.Char (isSymbol) import Data.Char (isSymbol)
import Data.Function (on) import Data.Function (on)
import Data.List (find, sortBy) import Data.List (find, nub, sortBy)
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Exception (ghandle, SomeException(..)) import Exception (ghandle, SomeException(..))
import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) 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 p <- G.parseModule modSum
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
whenFound' opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, _name, rty, paren) -> do whenFound' opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, _name, rty, paren) -> do
text:_ <- djinn False rty djinns <- djinn True rty
return (fourInts loc, doParen paren text) return (fourInts loc, map (doParen paren) (nub djinns))
handler (SomeException _) = emptyResult =<< options handler (SomeException _) = emptyResult =<< options

View File

@ -146,7 +146,25 @@
(defconst ghc-error-buffer-name "*GHC Info*") (defconst ghc-error-buffer-name "*GHC Info*")
(defun ghc-display (fontify ins-func) (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-output-to-temp-buffer buf
(with-current-buffer buf (with-current-buffer buf
(erase-buffer) (erase-buffer)

View File

@ -70,6 +70,50 @@
(cmd (format "refine %s %s %s %s\n" file ln cn expr))) (cmd (format "refine %s %s %s %s\n" file ln cn expr)))
(ghc-sync-process cmd))) (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 ;;; Initial code from signature

View File

@ -76,6 +76,7 @@
(defvar ghc-case-split-key "\C-c\C-s") (defvar ghc-case-split-key "\C-c\C-s")
(defvar ghc-initial-sig-key "\C-c\C-g") (defvar ghc-initial-sig-key "\C-c\C-g")
(defvar ghc-refine-key "\C-c\C-r") (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-prev-hole-key "\C-c\ep")
(defvar ghc-next-hole-key "\C-c\en") (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-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-initial-sig-key 'ghc-initial-code-from-signature)
(define-key haskell-mode-map ghc-refine-key 'ghc-refine) (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-prev-hole-key 'ghc-goto-prev-hole)
(define-key haskell-mode-map ghc-next-hole-key 'ghc-goto-next-hole) (define-key haskell-mode-map ghc-next-hole-key 'ghc-goto-next-hole)
(ghc-comp-init) (ghc-comp-init)