using ghc-modi for C-cC-t.
This commit is contained in:
parent
38cbff3d5c
commit
30843b02ea
@ -77,13 +77,8 @@
|
|||||||
|
|
||||||
(defun ghc-show-type ()
|
(defun ghc-show-type ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(ghc-executable-find ghc-module-command
|
(let ((buf (current-buffer))
|
||||||
(let ((modname (or (ghc-find-module-name) "Main")))
|
(tinfos (ghc-type-get-tinfos)))
|
||||||
(ghc-show-type0 modname))))
|
|
||||||
|
|
||||||
(defun ghc-show-type0 (modname)
|
|
||||||
(let* ((buf (current-buffer))
|
|
||||||
(tinfos (ghc-type-get-tinfos modname)))
|
|
||||||
(if (null tinfos)
|
(if (null tinfos)
|
||||||
(progn
|
(progn
|
||||||
(ghc-type-clear-overlay)
|
(ghc-type-clear-overlay)
|
||||||
@ -99,11 +94,11 @@
|
|||||||
(move-overlay ghc-type-overlay (- left 1) (- right 1) buf)
|
(move-overlay ghc-type-overlay (- left 1) (- right 1) buf)
|
||||||
(message type)))))
|
(message type)))))
|
||||||
|
|
||||||
(defun ghc-type-get-tinfos (modname)
|
(defun ghc-type-get-tinfos ()
|
||||||
(if (= (ghc-type-get-point) (point))
|
(if (= (ghc-type-get-point) (point))
|
||||||
(ghc-type-set-ix
|
(ghc-type-set-ix
|
||||||
(mod (1+ (ghc-type-get-ix)) (length (ghc-type-get-types))))
|
(mod (1+ (ghc-type-get-ix)) (length (ghc-type-get-types))))
|
||||||
(let ((types (ghc-type-obtain-tinfos modname)))
|
(let ((types (ghc-type-obtain-tinfos)))
|
||||||
(if (not (listp types)) ;; main does not exist in Main
|
(if (not (listp types)) ;; main does not exist in Main
|
||||||
(ghc-type-set-types nil)
|
(ghc-type-set-types nil)
|
||||||
(ghc-type-set-types types)
|
(ghc-type-set-types types)
|
||||||
@ -111,19 +106,12 @@
|
|||||||
(ghc-type-set-ix 0))))
|
(ghc-type-set-ix 0))))
|
||||||
(ghc-type-get-types))
|
(ghc-type-get-types))
|
||||||
|
|
||||||
(defun ghc-type-obtain-tinfos (modname)
|
(defun ghc-type-obtain-tinfos ()
|
||||||
(let* ((ln (int-to-string (line-number-at-pos)))
|
(let* ((ln (int-to-string (line-number-at-pos)))
|
||||||
(cn (int-to-string (1+ (current-column))))
|
(cn (int-to-string (1+ (current-column))))
|
||||||
(cdir default-directory)
|
(file (buffer-file-name))
|
||||||
(file (buffer-file-name)))
|
(cmd (format "type %s %s %s\n" file ln cn)))
|
||||||
(ghc-read-lisp
|
(ghc-sync-process (lambda () cmd))))
|
||||||
(lambda ()
|
|
||||||
(cd cdir)
|
|
||||||
(apply 'ghc-call-process ghc-module-command nil t nil
|
|
||||||
`(,@(ghc-make-ghc-options) "-l" "type" ,file ,modname ,ln ,cn))
|
|
||||||
(goto-char (point-min))
|
|
||||||
(while (search-forward "[Char]" nil t)
|
|
||||||
(replace-match "String"))))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;;
|
;;;
|
||||||
|
Loading…
Reference in New Issue
Block a user