diff --git a/Info.hs b/Info.hs index 7bcae93..f7904b9 100644 --- a/Info.hs +++ b/Info.hs @@ -4,10 +4,10 @@ module Info (infoExpr, typeExpr) where import Cabal import Control.Applicative -import Control.Exception import CoreUtils import Data.Function -import Data.Generics as G +import Data.Generics +import GHC.SYB.Utils import Data.List import Data.Maybe import Data.Ord as O @@ -50,7 +50,7 @@ typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr ex modSum <- getModSummary $ mkModuleName modstr p <- parseModule modSum tcm <- typecheckModule p - es <- Gap.liftIO $ findExpr tcm lineNo colNo + let es = findExpr tcm lineNo colNo ts <- catMaybes <$> mapM (getType tcm) es let sss = map toTup $ sortBy (cmp `on` fst) ts return $ convert opt sss @@ -66,28 +66,16 @@ typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr ex | b `isSubspanOf` a = O.GT | otherwise = O.EQ -findExpr :: TypecheckedModule -> Int -> Int -> IO [LHsExpr Id] -findExpr tcm line col = do +findExpr :: TypecheckedModule -> Int -> Int -> [LHsExpr Id] +findExpr tcm line col = let src = tm_typechecked_source tcm - ssrc <- everywhereM' sanitize src - return $ listify f ssrc + in listifyStaged TypeChecker f src where - -- It is for GHC's panic! - sanitize :: Data a => a -> IO a - sanitize x = do - mret <- try (evaluate x) - return $ case mret of - Left (SomeException _) -> G.empty - Right ret -> ret - f :: LHsExpr Id -> Bool - f (L spn _) = spn `spans` (line, col) + f (L spn _) = isGoodSrcSpan spn && spn `spans` (line, col) --- | Monadic variation on everywhere' -everywhereM' :: Monad m => GenericM m -> GenericM m -everywhereM' f x = do - x' <- f x - gmapM (everywhereM' f) x' +listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r] +listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> if p x then [x] else [])) getType :: GhcMonad m => TypecheckedModule -> LHsExpr Id -> m (Maybe (SrcSpan, Type)) getType tcm e = do diff --git a/ghc-mod.cabal b/ghc-mod.cabal index 66e6307..de73929 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -47,6 +47,7 @@ Executable ghc-mod , filepath , ghc , ghc-paths + , ghc-syb-utils , hlint >= 1.7.1 , old-time , process