[Type-constraints] everythingStagedWithContext

This is required for GHC<7.10 due to a panic

Language/Haskell/GhcMod/Gap.hs

@@ -44,6 +44,7 @@ module Language.Haskell.GhcMod.Gap (
   , Language.Haskell.GhcMod.Gap.isSynTyCon
   , parseModuleHeader
   , mkErrStyle'
+  , everythingStagedWithContext
   ) where
 
 import Control.Applicative hiding (empty)
@@ -111,6 +112,8 @@ import Lexer as L
 import Parser
 import SrcLoc
 import Packages
+import Data.Generics (GenericQ, extQ, gmapQ)
+import GHC.SYB.Utils (Stage(..))
 
 import Language.Haskell.GhcMod.Types (Expression(..))
 import Prelude
@@ -575,3 +578,20 @@ instance NFData ByteString where
   rnf Empty       = ()
   rnf (Chunk _ b) = rnf b
 #endif
+
+-- | Like 'everything', but avoid known potholes, based on the 'Stage' that
+--   generated the Ast.
+everythingStagedWithContext :: Stage -> s -> (r -> r -> r) -> r -> GenericQ (s -> (r, s)) -> GenericQ r
+everythingStagedWithContext stage s0 f z q x
+  | (const False
+#if __GLASGOW_HASKELL__ <= 708
+      `extQ` postTcType
+#endif
+      `extQ` fixity `extQ` nameSet) x = z
+  | otherwise = foldl f r (gmapQ (everythingStagedWithContext stage s' f z q) x)
+  where nameSet    = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool
+#if __GLASGOW_HASKELL__ <= 708
+        postTcType = const (stage<TypeChecker)                 :: PostTcType -> Bool
+#endif
+        fixity     = const (stage<Renamer)                     :: GHC.Fixity -> Bool
+        (r, s') = q x s0

Language/Haskell/GhcMod/SrcUtils.hs

@@ -45,7 +45,8 @@ type CstGenQT = forall m. GhcMonad m => CstGenQS -> (m [(SrcSpan, Type)], CstGen
 
 collectSpansTypes :: (GhcMonad m) => G.TypecheckedModule -> (Int, Int) -> m [(SrcSpan, Type)]
 collectSpansTypes tcs lc =
-  everythingWithContext M.empty (liftM2 (++))
+  everythingStagedWithContext TypeChecker M.empty (liftM2 (++))
+    (return [])
     ((return [],) `mkQ` hsBind `extQ` hsExpr `extQ` hsPat)
     (G.tm_typechecked_source tcs)
   where