info/type does not require module name.
Fallback was removed. See #199.
This commit is contained in:
Kazu Yamamoto
parent
54bea65736
commit
e9859980ab
@ -15,21 +15,18 @@ import CoreUtils (exprType)
|
||||
import Data.Function (on)
|
||||
import Data.Generics hiding (typeOf)
|
||||
import Data.List (sortBy)
|
||||
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import Data.Ord as O
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import Exception (gcatch, SomeException(..))
|
||||
import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), DynFlags, SrcSpan, Type, Located, TypecheckedSource, GenLocated(L), LoadHowMuch(..), TargetId(..))
|
||||
import Exception (ghandle, SomeException(..))
|
||||
import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), DynFlags, SrcSpan, Type, Located, TypecheckedSource, GenLocated(L), LoadHowMuch(..))
|
||||
import qualified GHC as G
|
||||
import GHC.SYB.Utils (Stage(TypeChecker), everythingStaged)
|
||||
import HscTypes (ms_imps)
|
||||
import Language.Haskell.GhcMod.Doc (showPage, showOneLine, getStyle)
|
||||
import Language.Haskell.GhcMod.GHCApi
|
||||
import Language.Haskell.GhcMod.GHCChoice ((||>), goNext)
|
||||
import Language.Haskell.GhcMod.Gap (HasType(..))
|
||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Outputable (PprStyle, ppr)
|
||||
import Outputable (PprStyle)
|
||||
import TcHsSyn (hsPatType)
|
||||
|
||||
----------------------------------------------------------------
|
||||
@ -42,20 +39,18 @@ data Cmd = Info | Type deriving Eq
|
||||
infoExpr :: Options
|
||||
-> Cradle
|
||||
-> FilePath -- ^ A target file.
|
||||
-> ModuleString -- ^ A module name.
|
||||
-> Expression -- ^ A Haskell expression.
|
||||
-> IO String
|
||||
infoExpr opt cradle file modstr expr = (++ "\n") <$> withGHCDummyFile (info opt cradle file modstr expr)
|
||||
infoExpr opt cradle file expr = (++ "\n") <$> withGHCDummyFile (info opt cradle file expr)
|
||||
|
||||
-- | Obtaining information of a target expression. (GHCi's info:)
|
||||
info :: Options
|
||||
-> Cradle
|
||||
-> FilePath -- ^ A target file.
|
||||
-> ModuleString -- ^ A module name.
|
||||
-> Expression -- ^ A Haskell expression.
|
||||
-> Ghc String
|
||||
info opt cradle file modstr expr =
|
||||
inModuleContext Info opt cradle file modstr exprToInfo "Cannot show info"
|
||||
info opt cradle file expr =
|
||||
inModuleContext Info opt cradle file exprToInfo "Cannot show info"
|
||||
where
|
||||
exprToInfo = do
|
||||
dflag <- G.getSessionDynFlags
|
||||
@ -80,25 +75,25 @@ instance HasType (LPat Id) where
|
||||
typeExpr :: Options
|
||||
-> Cradle
|
||||
-> FilePath -- ^ A target file.
|
||||
-> ModuleString -- ^ A module name.
|
||||
-> Int -- ^ Line number.
|
||||
-> Int -- ^ Column number.
|
||||
-> IO String
|
||||
typeExpr opt cradle file modstr lineNo colNo = withGHCDummyFile $ typeOf opt cradle file modstr lineNo colNo
|
||||
typeExpr opt cradle file lineNo colNo = withGHCDummyFile $ typeOf opt cradle file lineNo colNo
|
||||
|
||||
-- | Obtaining type of a target expression. (GHCi's type:)
|
||||
typeOf :: Options
|
||||
-> Cradle
|
||||
-> FilePath -- ^ A target file.
|
||||
-> ModuleString -- ^ A module name.
|
||||
-> Int -- ^ Line number.
|
||||
-> Int -- ^ Column number.
|
||||
-> Ghc String
|
||||
typeOf opt cradle file modstr lineNo colNo =
|
||||
inModuleContext Type opt cradle file modstr exprToType errmsg
|
||||
typeOf opt cradle file lineNo colNo =
|
||||
inModuleContext Type opt cradle file exprToType errmsg
|
||||
where
|
||||
exprToType = do
|
||||
modSum <- G.getModSummary $ G.mkModuleName modstr
|
||||
modGraph <- G.getModuleGraph
|
||||
let ms = filter (\m -> G.ml_hs_file (G.ms_location m) == Just file) modGraph
|
||||
modSum = head ms
|
||||
p <- G.parseModule modSum
|
||||
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
|
||||
let bs = listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
|
||||
@ -141,36 +136,12 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser
|
||||
noWaringOptions :: [String]
|
||||
noWaringOptions = ["-w:"]
|
||||
|
||||
inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> Ghc String
|
||||
inModuleContext _ opt cradle file modstr action errmsg =
|
||||
valid ||> invalid ||> return errmsg
|
||||
where
|
||||
valid = do
|
||||
inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> Ghc String -> String -> Ghc String
|
||||
inModuleContext _ opt cradle file action errmsg = ghandle handler $ do
|
||||
void $ initializeFlagsWithCradle opt cradle noWaringOptions False
|
||||
setTargetFiles [file]
|
||||
void $ G.load LoadAllTargets
|
||||
doif setContextFromTarget action
|
||||
invalid = do
|
||||
void $ initializeFlagsWithCradle opt cradle noWaringOptions False
|
||||
setTargetBuffer
|
||||
void $ G.load LoadAllTargets
|
||||
doif setContextFromTarget action
|
||||
setTargetBuffer = do
|
||||
modgraph <- G.depanal [G.mkModuleName modstr] True
|
||||
dflag <- G.getSessionDynFlags
|
||||
style <- getStyle
|
||||
-- FIXME: "import (implicit) Prelude"
|
||||
let imports = concatMap (map (showPage dflag style . ppr . G.unLoc)) $
|
||||
map ms_imps modgraph ++ map G.ms_srcimps modgraph
|
||||
moddef = "module " ++ sanitize modstr ++ " where"
|
||||
header = moddef : imports
|
||||
importsBuf <- Gap.toStringBuffer header
|
||||
clkTime <- liftIO getCurrentTime
|
||||
G.setTargets [Gap.mkTarget (TargetModule $ G.mkModuleName modstr)
|
||||
True
|
||||
(Just (importsBuf, clkTime))]
|
||||
doif m t = m >>= \ok -> if ok then t else goNext
|
||||
sanitize = fromMaybe "SomeModule" . listToMaybe . words
|
||||
|
||||
setContextFromTarget :: Ghc Bool
|
||||
setContextFromTarget = (G.depanal [] False >>= Gap.setCtx) `gcatch` \(SomeException _) -> return False
|
||||
void $ G.depanal [] False >>= Gap.setCtx
|
||||
action
|
||||
where
|
||||
handler (SomeException _) = return errmsg
|
||||
|
||||
@ -38,6 +38,9 @@ usage = "ghc-mod version " ++ showVersion version ++ "\n"
|
||||
++ "\t ghc-mod doc <module>\n"
|
||||
++ "\t ghc-mod boot\n"
|
||||
++ "\t ghc-mod help\n"
|
||||
++ "\n"
|
||||
++ "<module> is not used, anything is OK.\n"
|
||||
++ "It is necessary to maintain backward compatibility.\n"
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
@ -96,7 +99,6 @@ main = flip E.catches handlers $ do
|
||||
cradle <- findCradle
|
||||
let cmdArg0 = cmdArg !. 0
|
||||
cmdArg1 = cmdArg !. 1
|
||||
cmdArg2 = cmdArg !. 2
|
||||
cmdArg3 = cmdArg !. 3
|
||||
cmdArg4 = cmdArg !. 4
|
||||
remainingArgs = tail cmdArg
|
||||
@ -111,8 +113,8 @@ main = flip E.catches handlers $ do
|
||||
"check" -> checkSyntax opt cradle remainingArgs
|
||||
"expand" -> checkSyntax opt { expandSplice = True } cradle remainingArgs
|
||||
"debug" -> nArgs 1 $ debugInfo opt cradle cmdArg1
|
||||
"info" -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg2 cmdArg3
|
||||
"type" -> nArgs 4 $ typeExpr opt cradle cmdArg1 cmdArg2 (read cmdArg3) (read cmdArg4)
|
||||
"info" -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg3
|
||||
"type" -> nArgs 4 $ typeExpr opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
|
||||
"lint" -> nArgs 1 withFile (lintSyntax opt) cmdArg1
|
||||
"root" -> nArgs 1 $ rootInfo opt cradle cmdArg1
|
||||
"doc" -> nArgs 1 $ packageDoc opt cradle cmdArg1
|
||||
|
||||
@ -23,38 +23,38 @@ spec = do
|
||||
it "shows types of the expression and its outers" $ do
|
||||
withDirectory_ "test/data/ghc-mod-check" $ do
|
||||
cradle <- findCradleWithoutSandbox
|
||||
res <- typeExpr defaultOptions cradle "Data/Foo.hs" "Data.Foo" 9 5
|
||||
res <- typeExpr defaultOptions cradle "Data/Foo.hs" 9 5
|
||||
res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
|
||||
|
||||
it "works with a module using TemplateHaskell" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
cradle <- findCradleWithoutSandbox
|
||||
res <- typeExpr defaultOptions cradle "Bar.hs" "Bar" 5 1
|
||||
res <- typeExpr defaultOptions cradle "Bar.hs" 5 1
|
||||
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
|
||||
|
||||
it "works with a module that imports another module using TemplateHaskell" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
cradle <- findCradleWithoutSandbox
|
||||
res <- typeExpr defaultOptions cradle "Main.hs" "Main" 3 8
|
||||
res <- typeExpr defaultOptions cradle "Main.hs" 3 8
|
||||
res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
|
||||
|
||||
describe "infoExpr" $ do
|
||||
it "works for non-export functions" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
cradle <- findCradleWithoutSandbox
|
||||
res <- infoExpr defaultOptions cradle "Info.hs" "Info" "fib"
|
||||
res <- infoExpr defaultOptions cradle "Info.hs" "fib"
|
||||
res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)
|
||||
|
||||
it "works with a module using TemplateHaskell" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
cradle <- findCradleWithoutSandbox
|
||||
res <- infoExpr defaultOptions cradle "Bar.hs" "Bar" "foo"
|
||||
res <- infoExpr defaultOptions cradle "Bar.hs" "foo"
|
||||
res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`)
|
||||
|
||||
it "works with a module that imports another module using TemplateHaskell" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
cradle <- findCradleWithoutSandbox
|
||||
res <- infoExpr defaultOptions cradle "Main.hs" "Main" "bar"
|
||||
res <- infoExpr defaultOptions cradle "Main.hs" "bar"
|
||||
res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`)
|
||||
|
||||
it "doesn't fail on unicode output" $ do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user