display types simply unless "-l" option is given
This commit is contained in:
parent
7e45a03532
commit
b11475821e
14
GHCMod.hs
14
GHCMod.hs
@ -45,7 +45,7 @@ usage = "ghc-mod version " ++ showVersion version ++ "\n"
|
|||||||
|
|
||||||
defaultOptions :: Options
|
defaultOptions :: Options
|
||||||
defaultOptions = Options {
|
defaultOptions = Options {
|
||||||
convert = toPlain
|
outputStyle = PlainStyle
|
||||||
, hlintOpts = []
|
, hlintOpts = []
|
||||||
, ghcOpts = []
|
, ghcOpts = []
|
||||||
, operators = False
|
, operators = False
|
||||||
@ -53,7 +53,7 @@ defaultOptions = Options {
|
|||||||
|
|
||||||
argspec :: [OptDescr (Options -> Options)]
|
argspec :: [OptDescr (Options -> Options)]
|
||||||
argspec = [ Option "l" ["tolisp"]
|
argspec = [ Option "l" ["tolisp"]
|
||||||
(NoArg (\opts -> opts { convert = toLisp }))
|
(NoArg (\opts -> opts { outputStyle = LispStyle }))
|
||||||
"print as a list of Lisp"
|
"print as a list of Lisp"
|
||||||
, Option "h" ["hlintOpt"]
|
, Option "h" ["hlintOpt"]
|
||||||
(ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt")
|
(ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt")
|
||||||
@ -129,16 +129,6 @@ main = flip catches handlers $ do
|
|||||||
| length xs <= idx = throw SafeList
|
| length xs <= idx = throw SafeList
|
||||||
| otherwise = xs !! idx
|
| otherwise = xs !! idx
|
||||||
|
|
||||||
----------------------------------------------------------------
|
|
||||||
toLisp :: [String] -> String
|
|
||||||
toLisp ms = "(" ++ unwords quoted ++ ")\n"
|
|
||||||
where
|
|
||||||
quote x = "\"" ++ x ++ "\""
|
|
||||||
quoted = map quote ms
|
|
||||||
|
|
||||||
toPlain :: [String] -> String
|
|
||||||
toPlain = unlines
|
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
preBrowsedModules :: [String]
|
preBrowsedModules :: [String]
|
||||||
|
12
Info.hs
12
Info.hs
@ -42,7 +42,10 @@ info opt fileName modstr expr = inModuleContext opt fileName modstr exprToInfo
|
|||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
typeExpr :: Options -> ModuleString -> Int -> Int -> FilePath -> IO String
|
typeExpr :: Options -> ModuleString -> Int -> Int -> FilePath -> IO String
|
||||||
typeExpr opt modstr lineNo colNo file = (++ "\n") <$> Info.typeOf opt file modstr lineNo colNo
|
typeExpr opt modstr lineNo colNo file = addNewline (outputStyle opt) <$> Info.typeOf opt file modstr lineNo colNo
|
||||||
|
where
|
||||||
|
addNewline LispStyle = (++ "\n")
|
||||||
|
addNewline PlainStyle = id
|
||||||
|
|
||||||
typeOf :: Options -> FilePath -> ModuleString -> Int -> Int -> IO String
|
typeOf :: Options -> FilePath -> ModuleString -> Int -> Int -> IO String
|
||||||
typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr exprToType
|
typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr exprToType
|
||||||
@ -53,8 +56,11 @@ typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr ex
|
|||||||
tcm <- typecheckModule p
|
tcm <- typecheckModule p
|
||||||
es <- liftIO $ findExpr tcm lineNo colNo
|
es <- liftIO $ findExpr tcm lineNo colNo
|
||||||
ts <- catMaybes <$> mapM (getType tcm) es
|
ts <- catMaybes <$> mapM (getType tcm) es
|
||||||
let ts' = sortBy (\a b -> fst a `cmp` fst b) ts
|
return $ format (outputStyle opt) $ sortBy (\a b -> fst a `cmp` fst b) ts
|
||||||
return $ tolisp $ map (\(loc, e) -> ("(" ++ l loc ++ " " ++ show (pretty e) ++ ")")) ts'
|
|
||||||
|
format :: OutputStyle -> [(SrcSpan, Type)] -> String
|
||||||
|
format LispStyle = tolisp . map (\(loc, e) -> "(" ++ l loc ++ " " ++ show (pretty e) ++ ")")
|
||||||
|
format PlainStyle = unlines . map (\(loc, e) -> l loc ++ " " ++ pretty e)
|
||||||
|
|
||||||
l :: SrcSpan -> String
|
l :: SrcSpan -> String
|
||||||
#if __GLASGOW_HASKELL__ >= 702
|
#if __GLASGOW_HASKELL__ >= 702
|
||||||
|
10
Types.hs
10
Types.hs
@ -10,13 +10,21 @@ import GHC.Paths (libdir)
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
data OutputStyle = LispStyle | PlainStyle
|
||||||
data Options = Options {
|
data Options = Options {
|
||||||
convert :: [String] -> String
|
outputStyle :: OutputStyle
|
||||||
, hlintOpts :: [String]
|
, hlintOpts :: [String]
|
||||||
, ghcOpts :: [String]
|
, ghcOpts :: [String]
|
||||||
, operators :: Bool
|
, operators :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
|
convert :: Options -> [String] -> String
|
||||||
|
convert Options{outputStyle = LispStyle} ms = "(" ++ unwords quoted ++ ")\n"
|
||||||
|
where
|
||||||
|
quote x = "\"" ++ x ++ "\""
|
||||||
|
quoted = map quote ms
|
||||||
|
convert Options{outputStyle = PlainStyle} ms = unlines ms
|
||||||
|
|
||||||
withGHC :: (MonadPlus m) => Ghc (m a) -> IO (m a)
|
withGHC :: (MonadPlus m) => Ghc (m a) -> IO (m a)
|
||||||
withGHC body = ghandle ignore $ runGhc (Just libdir) body
|
withGHC body = ghandle ignore $ runGhc (Just libdir) body
|
||||||
where
|
where
|
||||||
|
Loading…
Reference in New Issue
Block a user