From 54d6f5f690142f3505a0752ae8b91d95a0bb803b Mon Sep 17 00:00:00 2001
From: Daniil Frumin <difrumin@gmail.com>
Date: Fri, 28 Jun 2013 00:25:22 +0400
Subject: [PATCH] Porting ghc-mod to GHC 7.7

---
 Language/Haskell/GhcMod/GHCApi.hs |  9 +++++++++
 Language/Haskell/GhcMod/Info.hs   | 33 +++++++++++++++++++++++++++++--
 2 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs
index 2d465d2..6026777 100644
--- a/Language/Haskell/GhcMod/GHCApi.hs
+++ b/Language/Haskell/GhcMod/GHCApi.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
 
 module Language.Haskell.GhcMod.GHCApi (
     withGHC
@@ -112,7 +113,11 @@ modifyFlags d0 idirs mDepPkgs splice build
        | otherwise         = d3
 
 setCabalPkg :: DynFlags -> DynFlags
+#if __GLASGOW_HASKELL__ >= 707
+setCabalPkg dflag = gopt_set dflag Opt_BuildingCabalPackage
+#else
 setCabalPkg dflag = dopt_set dflag Opt_BuildingCabalPackage
+#endif
 
 setSplice :: DynFlags -> DynFlags
 setSplice dflag = dopt_set dflag Opt_D_dump_splices
@@ -120,7 +125,11 @@ setSplice dflag = dopt_set dflag Opt_D_dump_splices
 addDevPkgs :: DynFlags -> [Package] -> DynFlags
 addDevPkgs df pkgs = df''
   where
+#if __GLASGOW_HASKELL__ >= 707
+    df' = gopt_set df Opt_HideAllPackages
+#else    
     df' = dopt_set df Opt_HideAllPackages
+#endif          
     df'' = df' {
         packageFlags = map ExposePackage pkgs ++ packageFlags df
       }
diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs
index 484196e..a1587ef 100644
--- a/Language/Haskell/GhcMod/Info.hs
+++ b/Language/Haskell/GhcMod/Info.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE Rank2Types, CPP #-}
 
 module Language.Haskell.GhcMod.Info (
     infoExpr
@@ -18,9 +18,15 @@ import Data.Maybe
 import Data.Ord as O
 import Data.Time.Clock
 import Desugar
+#if __GLASGOW_HASKELL__ >= 707
+import FamInstEnv
+#endif  
 import GHC
 import GHC.SYB.Utils
 import HscTypes
+#if __GLASGOW_HASKELL__ >= 707  
+import InstEnv
+#endif  
 import Language.Haskell.GhcMod.Doc
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.GHCChoice
@@ -31,6 +37,7 @@ import Outputable
 import PprTyThing
 import TcHsSyn (hsPatType)
 import TcRnTypes
+import TcType
 
 ----------------------------------------------------------------
 
@@ -75,7 +82,12 @@ instance HasType (LHsExpr Id) where
         ty_env = tcg_type_env $ fst $ tm_internals_ tcm
 
 instance HasType (LHsBind Id) where
+#if __GLASGOW_HASKELL__ >= 707
+    getType _ (L spn FunBind{fun_matches = MG _ in_tys out_typ}) = return $ Just (spn, typ)
+      where typ = mkFunTys in_tys out_typ
+#else    
     getType _ (L spn FunBind{fun_matches = MatchGroup _ typ}) = return $ Just (spn, typ)
+#endif                                                                
     getType _ _ = return Nothing
 
 instance HasType (LPat Id) where
@@ -148,8 +160,13 @@ pretty dflag = showUnqualifiedOneLine dflag . pprTypeForUser False
 infoThing :: String -> Ghc String
 infoThing str = do
     names <- parseName str
+#if __GLASGOW_HASKELL__ >= 707
+    mb_stuffs <- mapM (getInfo False) names
+    let filtered = filterOutChildren (\(t,_f,_i,_fam) -> t) (catMaybes mb_stuffs)
+#else    
     mb_stuffs <- mapM getInfo names
     let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
+#endif
     dflag <- getSessionDynFlags
     return $ showUnqualifiedPage dflag $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
 
@@ -159,6 +176,18 @@ filterOutChildren get_thing xs
   where
     implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
 
+#if __GLASGOW_HASKELL__ >= 707
+pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc
+pprInfo pefas (thing, fixity, insts, famInsts)
+    = pprTyThingInContextLoc pefas thing
+   $$ show_fixity fixity
+   $$ pprInstances insts
+   $$ pprFamInsts famInsts
+  where
+    show_fixity fx
+      | fx == defaultFixity = Outputable.empty
+      | otherwise           = ppr fx <+> ppr (getName thing)
+#else    
 pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [Gap.ClsInst]) -> SDoc
 pprInfo pefas (thing, fixity, insts)
     = pprTyThingInContextLoc pefas thing
@@ -168,7 +197,7 @@ pprInfo pefas (thing, fixity, insts)
     show_fixity fx
       | fx == defaultFixity = Outputable.empty
       | otherwise           = ppr fx <+> ppr (getName thing)
-
+#endif
 ----------------------------------------------------------------
 
 inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> Ghc String