Show more than one Djinn completion

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]

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
+          djinns <- djinn True rty
-          return (fourInts loc, doParen paren text)
+          return (fourInts loc, map (doParen paren) (nub djinns))
             
     handler (SomeException _) = emptyResult =<< options

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)

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

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)