Thanks to DeferTypeErrors, info/type can work even if the file contains errors.
This commit is contained in:
parent
66a5123f8c
commit
c8fbdcfa2f
@ -8,6 +8,7 @@ module Language.Haskell.GhcMod.GHCApi (
|
|||||||
, addTargetFiles
|
, addTargetFiles
|
||||||
, getDynamicFlags
|
, getDynamicFlags
|
||||||
, getSystemLibDir
|
, getSystemLibDir
|
||||||
|
, withDynFlags
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Language.Haskell.GhcMod.CabalApi
|
import Language.Haskell.GhcMod.CabalApi
|
||||||
@ -191,3 +192,12 @@ getDynamicFlags :: IO DynFlags
|
|||||||
getDynamicFlags = do
|
getDynamicFlags = do
|
||||||
mlibdir <- getSystemLibDir
|
mlibdir <- getSystemLibDir
|
||||||
G.runGhc mlibdir G.getSessionDynFlags
|
G.runGhc mlibdir G.getSessionDynFlags
|
||||||
|
|
||||||
|
withDynFlags :: (DynFlags -> DynFlags) -> Ghc a -> Ghc a
|
||||||
|
withDynFlags setFlag body = G.gbracket setup teardown (\_ -> body)
|
||||||
|
where
|
||||||
|
setup = do
|
||||||
|
dflag <- G.getSessionDynFlags
|
||||||
|
void $ G.setSessionDynFlags (setFlag dflag)
|
||||||
|
return dflag
|
||||||
|
teardown = void . G.setSessionDynFlags
|
||||||
|
@ -30,6 +30,7 @@ module Language.Haskell.GhcMod.Gap (
|
|||||||
, GapThing(..)
|
, GapThing(..)
|
||||||
, fromTyThing
|
, fromTyThing
|
||||||
, dumpSplicesFlag
|
, dumpSplicesFlag
|
||||||
|
, setDeferTypeErrors
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative hiding (empty)
|
import Control.Applicative hiding (empty)
|
||||||
@ -363,3 +364,12 @@ dumpSplicesFlag :: DumpFlag
|
|||||||
dumpSplicesFlag :: DynFlag
|
dumpSplicesFlag :: DynFlag
|
||||||
#endif
|
#endif
|
||||||
dumpSplicesFlag = Opt_D_dump_splices
|
dumpSplicesFlag = Opt_D_dump_splices
|
||||||
|
|
||||||
|
setDeferTypeErrors :: DynFlags -> DynFlags
|
||||||
|
#if __GLASGOW_HASKELL__ >= 707
|
||||||
|
setDeferTypeErrors dflag = gopt_set dflag Opt_DeferTypeErrors
|
||||||
|
#elif __GLASGOW_HASKELL__ >= 706
|
||||||
|
setDeferTypeErrors dflag = dopt_set dflag Opt_DeferTypeErrors
|
||||||
|
#else
|
||||||
|
setDeferTypeErrors = id
|
||||||
|
#endif
|
||||||
|
@ -23,12 +23,15 @@ import qualified GHC as G
|
|||||||
import GHC.SYB.Utils (Stage(TypeChecker), everythingStaged)
|
import GHC.SYB.Utils (Stage(TypeChecker), everythingStaged)
|
||||||
import Language.Haskell.GhcMod.Doc (showPage, showOneLine, getStyle)
|
import Language.Haskell.GhcMod.Doc (showPage, showOneLine, getStyle)
|
||||||
import Language.Haskell.GhcMod.GHCApi
|
import Language.Haskell.GhcMod.GHCApi
|
||||||
import Language.Haskell.GhcMod.Gap (HasType(..))
|
import Language.Haskell.GhcMod.Gap (HasType(..), setDeferTypeErrors)
|
||||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
import Outputable (PprStyle)
|
import Outputable (PprStyle)
|
||||||
import TcHsSyn (hsPatType)
|
import TcHsSyn (hsPatType)
|
||||||
|
|
||||||
|
noWaringOptions :: [String]
|
||||||
|
noWaringOptions = ["-w:"]
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- | Obtaining information of a target expression. (GHCi's info:)
|
-- | Obtaining information of a target expression. (GHCi's info:)
|
||||||
@ -37,8 +40,9 @@ infoExpr :: Options
|
|||||||
-> FilePath -- ^ A target file.
|
-> FilePath -- ^ A target file.
|
||||||
-> Expression -- ^ A Haskell expression.
|
-> Expression -- ^ A Haskell expression.
|
||||||
-> IO String
|
-> IO String
|
||||||
infoExpr opt cradle file expr = withGHC' $
|
infoExpr opt cradle file expr = withGHC' $ do
|
||||||
inModuleContext opt cradle file (info opt file expr)
|
void $ initializeFlagsWithCradle opt cradle noWaringOptions False
|
||||||
|
info opt file expr
|
||||||
|
|
||||||
-- | Obtaining information of a target expression. (GHCi's info:)
|
-- | Obtaining information of a target expression. (GHCi's info:)
|
||||||
info :: Options
|
info :: Options
|
||||||
@ -47,12 +51,12 @@ info :: Options
|
|||||||
-> Ghc String
|
-> Ghc String
|
||||||
info opt file expr = convert opt <$> ghandle handler body
|
info opt file expr = convert opt <$> ghandle handler body
|
||||||
where
|
where
|
||||||
body = do
|
body = inModuleContext file $ do
|
||||||
void $ Gap.setCtx file
|
void $ Gap.setCtx file
|
||||||
sdoc <- Gap.infoThing expr
|
sdoc <- Gap.infoThing expr
|
||||||
(dflag, style) <- getFlagStyle
|
(dflag, style) <- getFlagStyle
|
||||||
return $ showPage dflag style sdoc
|
return $ showPage dflag style sdoc
|
||||||
handler (SomeException e) = return $ "Cannot show info (" ++ show e ++ ")"
|
handler (SomeException _) = return "Cannot show info"
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
@ -74,8 +78,9 @@ typeExpr :: Options
|
|||||||
-> Int -- ^ Line number.
|
-> Int -- ^ Line number.
|
||||||
-> Int -- ^ Column number.
|
-> Int -- ^ Column number.
|
||||||
-> IO String
|
-> IO String
|
||||||
typeExpr opt cradle file lineNo colNo = withGHC' $
|
typeExpr opt cradle file lineNo colNo = withGHC' $ do
|
||||||
inModuleContext opt cradle file (types opt file lineNo colNo)
|
void $ initializeFlagsWithCradle opt cradle noWaringOptions False
|
||||||
|
types opt file lineNo colNo
|
||||||
|
|
||||||
-- | Obtaining type of a target expression. (GHCi's type:)
|
-- | Obtaining type of a target expression. (GHCi's type:)
|
||||||
types :: Options
|
types :: Options
|
||||||
@ -85,14 +90,13 @@ types :: Options
|
|||||||
-> Ghc String
|
-> Ghc String
|
||||||
types opt file lineNo colNo = convert opt <$> ghandle handler body
|
types opt file lineNo colNo = convert opt <$> ghandle handler body
|
||||||
where
|
where
|
||||||
body = do
|
body = inModuleContext file $ do
|
||||||
modSum <- Gap.setCtx file
|
modSum <- Gap.setCtx file
|
||||||
(dflag, style) <- getFlagStyle
|
(dflag, style) <- getFlagStyle
|
||||||
srcSpanTypes <- getSrcSpanType modSum lineNo colNo
|
srcSpanTypes <- getSrcSpanType modSum lineNo colNo
|
||||||
let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes
|
let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes
|
||||||
return $ tups
|
return tups
|
||||||
handler (SomeException _) = return errmsg
|
handler (SomeException _) = return []
|
||||||
errmsg = [] :: [((Int,Int,Int,Int),String)]
|
|
||||||
|
|
||||||
getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)]
|
getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)]
|
||||||
getSrcSpanType modSum lineNo colNo = do
|
getSrcSpanType modSum lineNo colNo = do
|
||||||
@ -131,12 +135,8 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
noWaringOptions :: [String]
|
inModuleContext :: FilePath -> Ghc a -> Ghc a
|
||||||
noWaringOptions = ["-w:"]
|
inModuleContext file action = withDynFlags setDeferTypeErrors $ do
|
||||||
|
|
||||||
inModuleContext :: Options -> Cradle -> FilePath -> Ghc String -> Ghc String
|
|
||||||
inModuleContext opt cradle file action = do
|
|
||||||
void $ initializeFlagsWithCradle opt cradle noWaringOptions False
|
|
||||||
setTargetFiles [file]
|
setTargetFiles [file]
|
||||||
action
|
action
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user