"info" and "type" can display it even if the source file is broken.
This commit is contained in:
parent
ae22ff40d4
commit
39409f2239
@ -27,8 +27,8 @@ usage = "ghc-mod version 0.5.0\n"
|
|||||||
++ "\t ghc-mod [-l] lang\n"
|
++ "\t ghc-mod [-l] lang\n"
|
||||||
++ "\t ghc-mod [-l] browse <module> [<module> ...]\n"
|
++ "\t ghc-mod [-l] browse <module> [<module> ...]\n"
|
||||||
++ "\t ghc-mod check <HaskellFile>\n"
|
++ "\t ghc-mod check <HaskellFile>\n"
|
||||||
++ "\t ghc-mod type <HaskellFile> <expression>\n"
|
++ "\t ghc-mod type <HaskellFile> <module> <expression>\n"
|
||||||
++ "\t ghc-mod info <HaskellFile> <expression>\n"
|
++ "\t ghc-mod info <HaskellFile> <module> <expression>\n"
|
||||||
++ "\t ghc-mod [-h opt] lint <HaskellFile>\n"
|
++ "\t ghc-mod [-h opt] lint <HaskellFile>\n"
|
||||||
++ "\t ghc-mod boot\n"
|
++ "\t ghc-mod boot\n"
|
||||||
++ "\t ghc-mod help\n"
|
++ "\t ghc-mod help\n"
|
||||||
@ -75,8 +75,8 @@ main = flip catches handlers $ do
|
|||||||
"browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
|
"browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
|
||||||
"list" -> listModules opt
|
"list" -> listModules opt
|
||||||
"check" -> withFile (checkSyntax opt) (safelist cmdArg 1)
|
"check" -> withFile (checkSyntax opt) (safelist cmdArg 1)
|
||||||
"type" -> withFile (typeExpr opt (safelist cmdArg 2)) (safelist cmdArg 1)
|
"type" -> withFile (typeExpr opt (safelist cmdArg 2) (safelist cmdArg 3)) (safelist cmdArg 1)
|
||||||
"info" -> withFile (infoExpr opt (safelist cmdArg 2)) (safelist cmdArg 1)
|
"info" -> withFile (infoExpr opt (safelist cmdArg 2) (safelist cmdArg 3)) (safelist cmdArg 1)
|
||||||
"lint" -> withFile (lintSyntax opt) (safelist cmdArg 1)
|
"lint" -> withFile (lintSyntax opt) (safelist cmdArg 1)
|
||||||
"lang" -> listLanguages opt
|
"lang" -> listLanguages opt
|
||||||
"boot" -> do
|
"boot" -> do
|
||||||
|
62
Info.hs
62
Info.hs
@ -9,35 +9,47 @@ import Types
|
|||||||
import NameSet
|
import NameSet
|
||||||
import HscTypes
|
import HscTypes
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Control.Exception
|
||||||
|
|
||||||
|
type Expression = String
|
||||||
|
type ModuleString = String
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
typeExpr :: Options -> String -> String -> IO String
|
typeExpr :: Options -> ModuleString -> Expression -> FilePath -> IO String
|
||||||
typeExpr _ expr file = (++ "\n") <$> typeOf file expr
|
typeExpr _ modstr expr file = (++ "\n") <$> typeOf file modstr expr
|
||||||
|
|
||||||
typeOf :: String -> String -> IO String
|
typeOf :: FilePath -> ModuleString-> Expression -> IO String
|
||||||
typeOf fileName expr = withGHC $ do
|
typeOf fileName modstr expr = withGHC $ valid `gcatch` invalid
|
||||||
initSession []
|
|
||||||
setTargetFile fileName
|
|
||||||
load LoadAllTargets
|
|
||||||
setContextFromTarget
|
|
||||||
pretty <$> exprType expr
|
|
||||||
where
|
where
|
||||||
|
valid = makeTypeOf LoadAllTargets
|
||||||
|
invalid = constE invalid0
|
||||||
|
invalid0 = makeTypeOf $ LoadDependenciesOf (mkModuleName modstr)
|
||||||
|
makeTypeOf x = do
|
||||||
|
initSession ["-w"]
|
||||||
|
setTargetFile fileName
|
||||||
|
loadWithLogger (\_ -> return ()) x
|
||||||
|
setContextFromTarget
|
||||||
|
pretty <$> exprType expr
|
||||||
pretty = showSDocForUser neverQualify . pprTypeForUser False
|
pretty = showSDocForUser neverQualify . pprTypeForUser False
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
infoExpr :: Options -> String -> String -> IO String
|
infoExpr :: Options -> ModuleString -> Expression -> FilePath -> IO String
|
||||||
infoExpr _ expr file = (++ "\n") <$> info file expr
|
infoExpr _ modstr expr file = (++ "\n") <$> info file modstr expr
|
||||||
|
|
||||||
info :: String -> String -> IO String
|
info :: FilePath -> ModuleString -> FilePath -> IO String
|
||||||
info fileName expr = withGHC $ do
|
info fileName modstr expr = withGHC $ valid `gcatch` invalid
|
||||||
initSession []
|
|
||||||
setTargetFile fileName
|
|
||||||
load LoadAllTargets
|
|
||||||
setContextFromTarget
|
|
||||||
infoThing expr
|
|
||||||
where
|
where
|
||||||
|
valid = makeInfo LoadAllTargets
|
||||||
|
invalid = constE invalid0
|
||||||
|
invalid0 = makeInfo $ LoadDependenciesOf (mkModuleName modstr)
|
||||||
|
makeInfo x = do
|
||||||
|
initSession ["-w"]
|
||||||
|
setTargetFile fileName
|
||||||
|
loadWithLogger (\_ -> return ()) x
|
||||||
|
setContextFromTarget
|
||||||
|
infoThing expr
|
||||||
-- ghc/InteractiveUI.hs
|
-- ghc/InteractiveUI.hs
|
||||||
infoThing str = do
|
infoThing str = do
|
||||||
names <- parseName str
|
names <- parseName str
|
||||||
@ -68,5 +80,15 @@ pprInfo pefas (thing, fixity, insts)
|
|||||||
setContextFromTarget :: Ghc ()
|
setContextFromTarget :: Ghc ()
|
||||||
setContextFromTarget = do
|
setContextFromTarget = do
|
||||||
ms <- depanal [] False
|
ms <- depanal [] False
|
||||||
mdl <- findModule (ms_mod_name (head ms)) Nothing
|
mdls <- mapM toModule ms
|
||||||
setContext [mdl] []
|
setContext (catMaybes mdls) []
|
||||||
|
where
|
||||||
|
toModule ms = lookupMod `gcatch` nothing
|
||||||
|
where
|
||||||
|
lookupMod = lookupModule (ms_mod_name ms) Nothing >>= return . Just
|
||||||
|
nothing = constE $ return Nothing
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
constE :: a -> (SomeException -> a)
|
||||||
|
constE func = \_ -> func
|
||||||
|
@ -14,35 +14,53 @@
|
|||||||
(interactive "P")
|
(interactive "P")
|
||||||
(if (not (ghc-which ghc-module-command))
|
(if (not (ghc-which ghc-module-command))
|
||||||
(message "%s not found" ghc-module-command)
|
(message "%s not found" ghc-module-command)
|
||||||
(let* ((expr0 (thing-at-point 'symbol))
|
(let ((modname (ghc-find-module-name)))
|
||||||
(expr (if ask (ghc-read-expression expr0) expr0))
|
(if (not modname)
|
||||||
(cdir default-directory)
|
(message "module should be specified")
|
||||||
(file (buffer-name)))
|
(ghc-show-type0 ask modname)))))
|
||||||
(with-temp-buffer
|
|
||||||
(cd cdir)
|
(defun ghc-show-type0 (ask modname)
|
||||||
(call-process ghc-module-command nil t nil "type" file expr)
|
(let* ((expr0 (thing-at-point 'symbol))
|
||||||
(message (buffer-substring (point-min) (1- (point-max))))))))
|
(expr (if ask (ghc-read-expression expr0) expr0))
|
||||||
|
(cdir default-directory)
|
||||||
|
(file (buffer-name)))
|
||||||
|
(with-temp-buffer
|
||||||
|
(cd cdir)
|
||||||
|
(call-process ghc-module-command nil t nil "type" file modname expr)
|
||||||
|
(message (buffer-substring (point-min) (1- (point-max)))))))
|
||||||
|
|
||||||
(defun ghc-show-info (&optional ask)
|
(defun ghc-show-info (&optional ask)
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(if (not (ghc-which ghc-module-command))
|
(if (not (ghc-which ghc-module-command))
|
||||||
(message "%s not found" ghc-module-command)
|
(message "%s not found" ghc-module-command)
|
||||||
(let* ((expr0 (thing-at-point 'symbol))
|
(let ((modname (ghc-find-module-name)))
|
||||||
(expr (if ask (ghc-read-expression expr0) expr0))
|
(if (not modname)
|
||||||
(cdir default-directory)
|
(message "module should be specified")
|
||||||
(file (buffer-name))
|
(ghc-show-info0 ask modname)))))
|
||||||
(buf (get-buffer-create ghc-error-buffer-name)))
|
|
||||||
(with-current-buffer buf
|
(defun ghc-show-info0 (ask modname)
|
||||||
(erase-buffer)
|
(let* ((expr0 (thing-at-point 'symbol))
|
||||||
(insert
|
(expr (if ask (ghc-read-expression expr0) expr0))
|
||||||
(with-temp-buffer
|
(cdir default-directory)
|
||||||
(cd cdir)
|
(file (buffer-name))
|
||||||
(call-process ghc-module-command nil t nil "info" file expr)
|
(buf (get-buffer-create ghc-error-buffer-name)))
|
||||||
(buffer-substring (point-min) (1- (point-max))))))
|
(with-current-buffer buf
|
||||||
(display-buffer buf))))
|
(erase-buffer)
|
||||||
|
(insert
|
||||||
|
(with-temp-buffer
|
||||||
|
(cd cdir)
|
||||||
|
(call-process ghc-module-command nil t nil "info" file modname expr)
|
||||||
|
(buffer-substring (point-min) (1- (point-max))))))
|
||||||
|
(display-buffer buf)))
|
||||||
|
|
||||||
(defun ghc-read-expression (default)
|
(defun ghc-read-expression (default)
|
||||||
(let ((prompt (format "Expression (%s): " default)))
|
(let ((prompt (format "Expression (%s): " default)))
|
||||||
(read-string prompt default nil)))
|
(read-string prompt default nil)))
|
||||||
|
|
||||||
|
(defun ghc-find-module-name ()
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(if (re-search-forward "^module[ ]+\\([^ ]+\\)" nil t)
|
||||||
|
(match-string-no-properties 1))))
|
||||||
|
|
||||||
(provide 'ghc-info)
|
(provide 'ghc-info)
|
||||||
|
Loading…
Reference in New Issue
Block a user