Add compatibility with GHC 7.8 and GHC 7.10

The changes to `src/Info.hs` are taken from the snapshot of the file at
this commit:

    schell@9bd3dce

Credit for these fixes goes to:

    https://github.com/schell
    https://github.com/rampion
    https://github.com/adituv

Author: bitc

src/Info.hs

@@ -16,14 +16,18 @@ import qualified Desugar
 #if __GLASGOW_HASKELL__ >= 706
 import qualified DynFlags
 #endif
+#if __GLASGOW_HASKELL__ >= 708
+import qualified HsExpr
+#else
+import qualified TcRnTypes
+#endif
 import qualified GHC
 import qualified HscTypes
 import qualified NameSet
 import qualified Outputable
 import qualified PprTyThing
 import qualified Pretty
 import qualified TcHsSyn
-import qualified TcRnTypes
 
 getIdentifierInfo :: FilePath -> String -> GHC.Ghc (Either String String)
 getIdentifierInfo file identifier =
@@ -127,21 +131,32 @@ getSrcSpan (GHC.RealSrcSpan spn) =
 getSrcSpan _ = Nothing
 
 getTypeLHsBind :: GHC.TypecheckedModule -> GHC.LHsBind GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type))
+#if __GLASGOW_HASKELL__ >= 708
+getTypeLHsBind _ (GHC.L spn GHC.FunBind{GHC.fun_matches = grp}) = return $ Just (spn, HsExpr.mg_res_ty grp)
+#else
 getTypeLHsBind _ (GHC.L spn GHC.FunBind{GHC.fun_matches = GHC.MatchGroup _ typ}) = return $ Just (spn, typ)
+#endif
 getTypeLHsBind _ _ = return Nothing
 
 getTypeLHsExpr :: GHC.TypecheckedModule -> GHC.LHsExpr GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type))
+#if __GLASGOW_HASKELL__ >= 708
+getTypeLHsExpr _ e = do
+#else
 getTypeLHsExpr tcm e = do
+#endif
     hs_env <- GHC.getSession
+#if __GLASGOW_HASKELL__ >= 708
+    (_, mbe) <- liftIO $ Desugar.deSugarExpr hs_env e
+#else
+    let modu   = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module tcm
+        rn_env = TcRnTypes.tcg_rdr_env $ fst $ GHC.tm_internals_ tcm
+        ty_env = TcRnTypes.tcg_type_env $ fst $ GHC.tm_internals_ tcm
     (_, mbe) <- liftIO $ Desugar.deSugarExpr hs_env modu rn_env ty_env e
+#endif
     return ()
     case mbe of
         Nothing -> return Nothing
         Just expr -> return $ Just (GHC.getLoc e, CoreUtils.exprType expr)
-    where
-    modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module tcm
-    rn_env = TcRnTypes.tcg_rdr_env $ fst $ GHC.tm_internals_ tcm
-    ty_env = TcRnTypes.tcg_type_env $ fst $ GHC.tm_internals_ tcm
 
 getTypeLPat :: GHC.TypecheckedModule -> GHC.LPat GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type))
 getTypeLPat _ (GHC.L spn pat) = return $ Just (spn, TcHsSyn.hsPatType pat)
@@ -161,14 +176,22 @@ pretty dflags =
 pretty :: GHC.Type -> String
 pretty =
 #endif
+#if __GLASGOW_HASKELL__ >= 708
+    Pretty.showDoc Pretty.OneLineMode 0
+#else
     Pretty.showDocWith Pretty.OneLineMode
+#endif
 #if __GLASGOW_HASKELL__ >= 706
     . Outputable.withPprStyleDoc dflags
 #else
     . Outputable.withPprStyleDoc
 #endif
         (Outputable.mkUserStyle Outputable.neverQualify Outputable.AllTheWay)
+#if __GLASGOW_HASKELL__ >= 708
+    . PprTyThing.pprTypeForUser
+#else
     . PprTyThing.pprTypeForUser False
+#endif
 
 ------------------------------------------------------------------------------
 -- The following was taken from 'ghc-syb-utils'
@@ -188,7 +211,11 @@ everythingStaged stage k z f x
   | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) x = z
   | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x)
   where nameSet    = const (stage `elem` [Parser,TypeChecker]) :: NameSet.NameSet -> Bool
+#if __GLASGOW_HASKELL__ >= 710
+        postTcType = const (stage<TypeChecker)                 :: GHC.PostTc GHC.Id GHC.Type -> Bool
+#else
         postTcType = const (stage<TypeChecker)                 :: GHC.PostTcType -> Bool
+#endif
         fixity     = const (stage<Renamer)                     :: GHC.Fixity -> Bool
 
 ------------------------------------------------------------------------------
@@ -198,16 +225,25 @@ everythingStaged stage k z f x
 infoThing :: String -> GHC.Ghc String
 infoThing str = do
     names <- GHC.parseName str
+#if __GLASGOW_HASKELL__ >= 708
+    mb_stuffs <- mapM (GHC.getInfo False) names
+    let filtered = filterOutChildren (\(t,_f,_i,_) -> t) (catMaybes mb_stuffs)
+#else
     mb_stuffs <- mapM GHC.getInfo names
     let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
+#endif
     unqual <- GHC.getPrintUnqual
 #if __GLASGOW_HASKELL__ >= 706
     dflags <- DynFlags.getDynFlags
     return $ Outputable.showSDocForUser dflags unqual $
 #else
     return $ Outputable.showSDocForUser unqual $
 #endif
+#if __GLASGOW_HASKELL__ >= 708
+        Outputable.vcat (intersperse (Outputable.text "") $ map pprInfo filtered)
+#else
         Outputable.vcat (intersperse (Outputable.text "") $ map (pprInfo False) filtered)
+#endif
 
   -- Filter out names whose parent is also there Good
   -- example is '[]', which is both a type and data
@@ -225,13 +261,19 @@ filterOutChildren get_thing xs
                      Just p  -> GHC.getName p `NameSet.elemNameSet` all_names
                      Nothing -> False
 
-#if __GLASGOW_HASKELL__ >= 706
+#if __GLASGOW_HASKELL__ >= 708
+pprInfo :: (HscTypes.TyThing, GHC.Fixity, [GHC.ClsInst], [GHC.FamInst]) -> Outputable.SDoc
+pprInfo (thing, fixity, insts, _) =
+    PprTyThing.pprTyThingInContextLoc thing
+#elif __GLASGOW_HASKELL__ >= 706
 pprInfo :: PprTyThing.PrintExplicitForalls -> (HscTypes.TyThing, GHC.Fixity, [GHC.ClsInst]) -> Outputable.SDoc
+pprInfo pefas (thing, fixity, insts) =
+    PprTyThing.pprTyThingInContextLoc pefas thing
 #else
 pprInfo :: PprTyThing.PrintExplicitForalls -> (HscTypes.TyThing, GHC.Fixity, [GHC.Instance]) -> Outputable.SDoc
-#endif
 pprInfo pefas (thing, fixity, insts) =
     PprTyThing.pprTyThingInContextLoc pefas thing
+#endif
         Outputable.$$ show_fixity fixity
         Outputable.$$ Outputable.vcat (map GHC.pprInstance insts)
     where