From f7a7c67bcbf1c8a994fb63276e5765ac6f994f63 Mon Sep 17 00:00:00 2001
From: Carter Tazio Schonwald <carter.schonwald@gmail.com>
Date: Thu, 20 Sep 2012 14:50:03 -0400
Subject: [PATCH] partial change set for ghc 7.6 api change, needs some more
 work though.

---
 ErrMsg.hs |  6 +++---
 Gap.hs    | 10 +++++-----
 Info.hs   |  7 ++++---
 3 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/ErrMsg.hs b/ErrMsg.hs
index b2d2df2..30d9270 100644
--- a/ErrMsg.hs
+++ b/ErrMsg.hs
@@ -24,13 +24,13 @@ type LogReader = IO [String]
 setLogger :: Bool -> DynFlags -> IO (DynFlags, LogReader)
 setLogger False df = return (newdf, undefined)
   where
-    newdf = df { log_action = \_ _ _ _ -> return () }
+    newdf = df { log_action = \_ _ _ _ _ -> return () }
 setLogger True  df = do
     ref <- newIORef [] :: IO (IORef [String])
     let newdf = df { log_action = appendLog ref }
     return (newdf, reverse <$> readIORef ref)
   where
-    appendLog ref _ src stl msg = modifyIORef ref (\ls -> ppMsg src msg stl : ls)
+    appendLog ref _  _ src stl msg = modifyIORef ref (\ls -> ppMsg  src msg stl : ls)
 
 ----------------------------------------------------------------
 
@@ -49,7 +49,7 @@ ppErrMsg err = ppMsg spn msg defaultUserStyle ++ ext
      msg = errMsgShortDoc err
      ext = showMsg (errMsgExtraInfo err) defaultUserStyle
 
-ppMsg :: SrcSpan -> Message -> PprStyle -> String
+--ppMsg :: SrcSpan -> Message -> PprStyle -> String
 ppMsg spn msg stl = fromMaybe def $ do
     (line,col,_,_) <- Gap.getSrcSpan spn
     file <- Gap.getSrcFile spn
diff --git a/Gap.hs b/Gap.hs
index 16a1abe..e98828e 100644
--- a/Gap.hs
+++ b/Gap.hs
@@ -78,7 +78,7 @@ getSrcFile _ = Nothing
 
 renderMsg :: SDoc -> PprStyle -> String
 #if __GLASGOW_HASKELL__ >= 702
-renderMsg d stl = renderWithStyle d stl
+renderMsg d stl = renderWithStyle  tracingDynFlags d stl
 #else
 renderMsg d stl = Pretty.showDocWith PageMode $ d stl
 #endif
@@ -109,15 +109,15 @@ fOptions = [option | (option,_,_) <- fFlags]
 ----------------------------------------------------------------
 
 setCtx :: [ModSummary] -> Ghc Bool
-#if __GLASGOW_HASKELL__ >= 704
+#if __GLASGOW_HASKELL__ >= 70
 setCtx ms = do
-    top <- map (IIModule . ms_mod) <$> filterM isTop ms
+    top <- map (IIModule . moduleName . ms_mod) <$> filterM isTop ms
     setContext top
     return (not . null $ top)
 #else
 setCtx ms = do
-    top <- map ms_mod <$> filterM isTop ms
-    setContext top []
+    top <- map (IIModule . ms_mod) <$> filterM isTop ms
+    setContext top
     return (not . null $ top)
 #endif
   where
diff --git a/Info.hs b/Info.hs
index 4143699..618bb3c 100644
--- a/Info.hs
+++ b/Info.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances, RankNTypes #-}
 
 module Info (infoExpr, typeExpr) where
 
@@ -10,6 +10,7 @@ import Data.Generics
 import Data.List
 import Data.Maybe
 import Data.Ord as O
+import DynFlags (tracingDynFlags)
 import Desugar
 import GHC
 import GHC.SYB.Utils
@@ -106,7 +107,7 @@ listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r]
 listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x]))
 
 pretty :: Type -> String
-pretty = showDocWith OneLineMode . withPprStyleDoc (mkUserStyle neverQualify AllTheWay) . pprTypeForUser False
+pretty = showDocWith OneLineMode . withPprStyleDoc tracingDynFlags (mkUserStyle neverQualify AllTheWay) . pprTypeForUser False
 
 ----------------------------------------------------------------
 -- from ghc/InteractiveUI.hs
@@ -125,7 +126,7 @@ filterOutChildren get_thing xs
   where
       implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
 
-pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [Instance]) -> SDoc
+--pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [Instance]) -> SDoc
 pprInfo pefas (thing, fixity, insts)
     = pprTyThingInContextLoc pefas thing
    $$ show_fixity fixity