From 122167f4c1cbc260aa5f837418b6f87c95c2d8f5 Mon Sep 17 00:00:00 2001
From: eagletmt <eagletmt@gmail.com>
Date: Tue, 14 Feb 2012 03:20:33 +0900
Subject: [PATCH 1/2] avoid GHC's panic

---
 Info.hs       | 31 +++++++++++--------------------
 ghc-mod.cabal |  2 +-
 2 files changed, 12 insertions(+), 21 deletions(-)

diff --git a/Info.hs b/Info.hs
index 255ff26..4bcae20 100644
--- a/Info.hs
+++ b/Info.hs
@@ -8,7 +8,8 @@ import Control.Exception
 import Control.Monad
 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
@@ -52,7 +53,7 @@ typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr ex
       modSum <- getModSummary $ mkModuleName modstr
       p <- parseModule modSum
       tcm <- typecheckModule p
-      es <- 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
@@ -75,28 +76,18 @@ 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)
+      | otherwise = False
 
--- | 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 f97f309..05bd0d2 100644
--- a/ghc-mod.cabal
+++ b/ghc-mod.cabal
@@ -28,7 +28,7 @@ Executable ghc-mod
     GHC-Options:        -Wall -fno-warn-unused-do-bind
   else
     GHC-Options:        -Wall
-  Build-Depends:        base >= 4.0 && < 5, ghc, ghc-paths, transformers, syb,
+  Build-Depends:        base >= 4.0 && < 5, ghc, ghc-paths, transformers, syb, ghc-syb-utils,
                         process, directory, filepath, old-time,
                         hlint >= 1.7.1, regex-posix, Cabal
 Source-Repository head

From 84d7747c1b56d8d3680e11fa80a4d103ec1c835c Mon Sep 17 00:00:00 2001
From: eagletmt <eagletmt@gmail.com>
Date: Tue, 14 Feb 2012 11:54:48 +0900
Subject: [PATCH 2/2] simplify a bit

---
 Info.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/Info.hs b/Info.hs
index 4bcae20..677d49e 100644
--- a/Info.hs
+++ b/Info.hs
@@ -82,9 +82,7 @@ findExpr tcm line col =
   in listifyStaged TypeChecker f src
   where
     f :: LHsExpr Id -> Bool
-    f (L spn _)
-      | isGoodSrcSpan spn = spn `spans` (line, col)
-      | otherwise = False
+    f (L spn _) = isGoodSrcSpan spn && spn `spans` (line, col)
 
 listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r]
 listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> if p x then [x] else []))