defining "info" for "ESC i".
This commit is contained in:
parent
fc67daae89
commit
11f1341fe5
@ -28,6 +28,7 @@ usage = "ghc-mod version 0.5.0\n"
|
||||
++ "\t ghc-mod [-l] browse <module> [<module> ...]\n"
|
||||
++ "\t ghc-mod check <HaskellFile>\n"
|
||||
++ "\t ghc-mod type <HaskellFile> <expression>\n"
|
||||
++ "\t ghc-mod info <HaskellFile> <expression>\n"
|
||||
++ "\t ghc-mod [-h opt] lint <HaskellFile>\n"
|
||||
++ "\t ghc-mod boot\n"
|
||||
++ "\t ghc-mod help\n"
|
||||
@ -75,6 +76,7 @@ main = flip catches handlers $ do
|
||||
"list" -> listModules opt
|
||||
"check" -> withFile (checkSyntax opt) (safelist cmdArg 1)
|
||||
"type" -> withFile (typeExpr opt (safelist cmdArg 2)) (safelist cmdArg 1)
|
||||
"info" -> withFile (infoExpr opt (safelist cmdArg 2)) (safelist cmdArg 1)
|
||||
"lint" -> withFile (lintSyntax opt) (safelist cmdArg 1)
|
||||
"lang" -> listLanguages opt
|
||||
"boot" -> do
|
||||
|
58
Info.hs
58
Info.hs
@ -1,10 +1,16 @@
|
||||
module Info where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Applicative hiding (empty)
|
||||
import Data.Maybe
|
||||
import GHC
|
||||
import Outputable
|
||||
import PprTyThing
|
||||
import Types
|
||||
import NameSet
|
||||
import HscTypes
|
||||
import Data.List
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
typeExpr :: Options -> String -> String -> IO String
|
||||
typeExpr _ expr file = (++ "\n") <$> typeOf file expr
|
||||
@ -17,8 +23,50 @@ typeOf fileName expr = withGHC $ do
|
||||
setContextFromTarget
|
||||
pretty <$> exprType expr
|
||||
where
|
||||
setContextFromTarget = do
|
||||
ms <- depanal [] False
|
||||
mdl <- findModule (ms_mod_name (head ms)) Nothing
|
||||
setContext [mdl] []
|
||||
pretty = showSDocForUser neverQualify . pprTypeForUser False
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
infoExpr :: Options -> String -> String -> IO String
|
||||
infoExpr _ expr file = (++ "\n") <$> info file expr
|
||||
|
||||
info :: String -> String -> IO String
|
||||
info fileName expr = withGHC $ do
|
||||
initSession []
|
||||
setTargetFile fileName
|
||||
load LoadAllTargets
|
||||
setContextFromTarget
|
||||
infoThing expr
|
||||
where
|
||||
-- ghc/InteractiveUI.hs
|
||||
infoThing str = do
|
||||
names <- parseName str
|
||||
mb_stuffs <- mapM getInfo names
|
||||
let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
|
||||
unqual <- getPrintUnqual
|
||||
return $ showSDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
|
||||
|
||||
-- ghc/InteractiveUI.hs
|
||||
filterOutChildren :: (a -> TyThing) -> [a] -> [a]
|
||||
filterOutChildren get_thing xs
|
||||
= [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
|
||||
where
|
||||
implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
|
||||
|
||||
pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
|
||||
pprInfo pefas (thing, fixity, insts)
|
||||
= pprTyThingInContextLoc pefas thing
|
||||
$$ show_fixity fixity
|
||||
$$ vcat (map pprInstance insts)
|
||||
where
|
||||
show_fixity fix
|
||||
| fix == defaultFixity = empty
|
||||
| otherwise = ppr fix <+> ppr (getName thing)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
setContextFromTarget :: Ghc ()
|
||||
setContextFromTarget = do
|
||||
ms <- depanal [] False
|
||||
mdl <- findModule (ms_mod_name (head ms)) Nothing
|
||||
setContext [mdl] []
|
||||
|
@ -10,14 +10,35 @@
|
||||
|
||||
(require 'ghc-func)
|
||||
|
||||
(defun ghc-show-type ()
|
||||
(interactive)
|
||||
(defun ghc-show-type (&optional ask)
|
||||
(interactive "P")
|
||||
(if (not (ghc-which ghc-module-command))
|
||||
(message "%s not found" ghc-module-command)
|
||||
(let ((expr (thing-at-point 'symbol))
|
||||
(file (buffer-name)))
|
||||
(let* ((expr0 (thing-at-point 'symbol))
|
||||
(expr (if ask (ghc-read-expression expr0) expr0))
|
||||
(file (buffer-name)))
|
||||
(with-temp-buffer
|
||||
(call-process ghc-module-command nil t nil "type" file expr)
|
||||
(message (buffer-substring (point-min) (1- (point-max))))))))
|
||||
|
||||
(defun ghc-show-info (&optional ask)
|
||||
(interactive "P")
|
||||
(if (not (ghc-which ghc-module-command))
|
||||
(message "%s not found" ghc-module-command)
|
||||
(let* ((expr0 (thing-at-point 'symbol))
|
||||
(expr (if ask (ghc-read-expression expr0) expr0))
|
||||
(file (buffer-name))
|
||||
(buf (get-buffer-create ghc-error-buffer-name)))
|
||||
(with-current-buffer buf
|
||||
(erase-buffer)
|
||||
(insert
|
||||
(with-temp-buffer
|
||||
(call-process ghc-module-command nil t nil "info" file expr)
|
||||
(buffer-substring (point-min) (1- (point-max))))))
|
||||
(display-buffer buf))))
|
||||
|
||||
(defun ghc-read-expression (default)
|
||||
(let ((prompt (format "Expression (%s): " default)))
|
||||
(read-string prompt default nil)))
|
||||
|
||||
(provide 'ghc-info)
|
||||
|
@ -41,7 +41,8 @@
|
||||
(defvar ghc-help-key "\e?")
|
||||
(defvar ghc-insert-key "\et")
|
||||
(defvar ghc-sort-key "\es")
|
||||
(defvar ghc-type-key "\e\C-t")
|
||||
(defvar ghc-type-key "\ek")
|
||||
(defvar ghc-info-key "\ei")
|
||||
(defvar ghc-check-key "\C-x\C-s")
|
||||
(defvar ghc-toggle-key "\C-c\C-c")
|
||||
|
||||
@ -58,6 +59,7 @@
|
||||
(define-key haskell-mode-map ghc-completion-key 'ghc-complete)
|
||||
(define-key haskell-mode-map ghc-document-key 'ghc-browse-document)
|
||||
(define-key haskell-mode-map ghc-type-key 'ghc-show-type)
|
||||
(define-key haskell-mode-map ghc-info-key 'ghc-show-info)
|
||||
(define-key haskell-mode-map ghc-import-key 'ghc-import-module)
|
||||
(define-key haskell-mode-map ghc-previous-key 'flymake-goto-prev-error)
|
||||
(define-key haskell-mode-map ghc-next-key 'flymake-goto-next-error)
|
||||
|
Loading…
Reference in New Issue
Block a user