GHC 7.6.1 compatibility

- switch from ClockTime to UTCTime in Info.pprInfo
- make ghc-mod loggers always take a first argument of type DynFlags
- consolidate GHC API shims in Gap.hs--this depends on tracingDynFlags,
which is unfortunate

Check.hs

@@ -7,7 +7,7 @@ import ErrMsg
 import Exception
 import GHC
 import GHCApi
-import Prelude hiding (catch)
+import Prelude
 import Types
 
 ----------------------------------------------------------------

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 = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
 setLogger True  df = do
     ref <- newIORef [] :: IO (IORef [String])
-    let newdf = df { log_action = appendLog ref }
+    let newdf = Gap.setLogAction df $ 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 -> SDoc -> PprStyle -> String
 ppMsg spn msg stl = fromMaybe def $ do
     (line,col,_,_) <- Gap.getSrcSpan spn
     file <- Gap.getSrcFile spn

Gap.hs

@@ -1,7 +1,13 @@
 {-# LANGUAGE CPP #-}
 
 module Gap (
-    supportedExtensions
+    Gap.ClsInst
+  , mkTarget
+  , showDocForUser
+  , showDoc
+  , styleDoc
+  , setLogAction
+  , supportedExtensions
   , getSrcSpan
   , getSrcFile
   , renderMsg
@@ -18,7 +24,9 @@ module Gap (
 
 import Control.Applicative hiding (empty)
 import Control.Monad
+import Data.Time.Clock
 import DynFlags
+import ErrUtils
 import FastString
 import GHC
 import GHCChoice
@@ -26,6 +34,11 @@ import Language.Haskell.Extension
 import Outputable
 import StringBuffer
 
+import qualified InstEnv
+import qualified Pretty
+import qualified StringBuffer as SB
+
+
 #if __GLASGOW_HASKELL__ >= 702
 import CoreMonad (liftIO)
 #else
@@ -33,6 +46,11 @@ import HscTypes (liftIO)
 import Pretty
 #endif
 
+#if __GLASGOW_HASKELL__ < 706
+import Control.Arrow
+import Data.Convertible
+#endif
+
 {-
 pretty :: Outputable a => a -> String
 pretty = showSDocForUser neverQualify . ppr
@@ -41,6 +59,56 @@ debug :: Outputable a => a -> b -> b
 debug x v = trace (pretty x) v
 -}
 
+----------------------------------------------------------------
+----------------------------------------------------------------
+--
+#if __GLASGOW_HASKELL__ >= 706
+type ClsInst = InstEnv.ClsInst
+#else
+type ClsInst = InstEnv.Instance
+#endif
+
+mkTarget :: TargetId -> Bool -> Maybe (SB.StringBuffer, UTCTime) -> Target
+#if __GLASGOW_HASKELL__ >= 706
+mkTarget = Target
+#else
+mkTarget tid allowObjCode = Target tid allowObjCode . (fmap . second) convert
+#endif
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+showDocForUser :: PrintUnqualified -> SDoc -> String
+#if __GLASGOW_HASKELL__ >= 706
+showDocForUser = showSDocForUser tracingDynFlags
+#else
+showDocForUser = showSDocForUser
+#endif
+
+showDoc :: SDoc -> String
+#if __GLASGOW_HASKELL__ >= 706
+showDoc = showSDoc tracingDynFlags
+#else
+showDoc = showSDoc
+#endif
+
+styleDoc :: PprStyle -> SDoc -> Pretty.Doc
+#if __GLASGOW_HASKELL__ >= 706
+styleDoc = withPprStyleDoc tracingDynFlags
+#else
+styleDoc = withPprStyleDoc
+#endif
+
+setLogAction :: DynFlags
+             -> (DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ())
+             -> DynFlags
+setLogAction df f =
+#if __GLASGOW_HASKELL__ >= 706
+    df { log_action = f }
+#else
+    df { log_action = f df }
+#endif
+
 ----------------------------------------------------------------
 ----------------------------------------------------------------
 
@@ -77,8 +145,10 @@ getSrcFile _ = Nothing
 ----------------------------------------------------------------
 
 renderMsg :: SDoc -> PprStyle -> String
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 706
-renderMsg d stl = renderWithStyle  tracingDynFlags d stl
+renderMsg d stl = renderWithStyle tracingDynFlags d stl
+#elif __GLASGOW_HASKELL__ >= 702
+renderMsg d stl = renderWithStyle d stl
 #else
 renderMsg d stl = Pretty.showDocWith PageMode $ d stl
 #endif
@@ -109,15 +179,20 @@ fOptions = [option | (option,_,_) <- fFlags]
 ----------------------------------------------------------------
 
 setCtx :: [ModSummary] -> Ghc Bool
-#if __GLASGOW_HASKELL__ >= 70
+#if __GLASGOW_HASKELL__ >= 704
 setCtx ms = do
-    top <- map (IIModule . moduleName . ms_mod) <$> filterM isTop ms
+#if __GLASGOW_HASKELL__ >= 706
+    let modName = IIModule . moduleName . ms_mod
+#else
+    let modName = IIModule . ms_mod
+#endif
+    top <- map modName <$> filterM isTop ms
     setContext top
     return (not . null $ top)
 #else
 setCtx ms = do
-    top <- map (IIModule . ms_mod) <$> filterM isTop ms
+    top <- map ms_mod <$> filterM isTop ms
-    setContext top
+    setContext top []
     return (not . null $ top)
 #endif
   where

Info.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances, RankNTypes #-}
+{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE Rank2Types #-}
 
 module Info (infoExpr, typeExpr) where
 
@@ -11,7 +12,6 @@ import Data.List
 import Data.Maybe
 import Data.Ord as O
 import Data.Time.Clock
-import DynFlags (tracingDynFlags)
 import Desugar
 import GHC
 import GHC.SYB.Utils
@@ -23,7 +23,6 @@ import NameSet
 import Outputable
 import PprTyThing
 import Pretty (showDocWith, Mode(OneLineMode))
-import System.Time
 import TcRnTypes
 import TcHsSyn (hsPatType)
 import Types
@@ -108,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 tracingDynFlags (mkUserStyle neverQualify AllTheWay) . pprTypeForUser False
+pretty = showDocWith OneLineMode . Gap.styleDoc (mkUserStyle neverQualify AllTheWay) . pprTypeForUser False
 
 ----------------------------------------------------------------
 -- from ghc/InteractiveUI.hs
@@ -119,7 +118,7 @@ infoThing str = do
     mb_stuffs <- mapM getInfo names
     let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
     unqual <- getPrintUnqual
-    return $ showSDocForUser tracingDynFlags unqual $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
+    return $ Gap.showDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
 
 filterOutChildren :: (a -> TyThing) -> [a] -> [a]
 filterOutChildren get_thing xs
@@ -127,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, [Gap.ClsInst]) -> SDoc
 pprInfo pefas (thing, fixity, insts)
     = pprTyThingInContextLoc pefas thing
    $$ show_fixity fixity
@@ -155,13 +154,15 @@ inModuleContext opt fileName modstr action errmsg =
         doif setContextFromTarget action
     setTargetBuffer = do
         modgraph <- depanal [mkModuleName modstr] True
-        let imports = concatMap (map ((showSDoc tracingDynFlags) . ppr . unLoc)) $
+        let imports = concatMap (map (Gap.showDoc . ppr . unLoc)) $
                       map ms_imps modgraph ++ map ms_srcimps modgraph
             moddef = "module " ++ sanitize modstr ++ " where"
             header = moddef : imports
         importsBuf <- Gap.toStringBuffer header
         clkTime <- Gap.liftIO getCurrentTime
-        setTargets [Target (TargetModule $ mkModuleName modstr) True (Just (importsBuf, clkTime))]
+        setTargets [Gap.mkTarget (TargetModule $ mkModuleName modstr)
+                                 True
+                                 (Just (importsBuf, clkTime))]
     doif m t = m >>= \ok -> if ok then t else goNext
     sanitize = fromMaybe "SomeModule" . listToMaybe . words
 

ghc-mod.cabal

@@ -45,6 +45,7 @@ Executable ghc-mod
   GHC-Options:          -Wall
   Build-Depends:        base >= 4.0 && < 5
                       , Cabal
+                      , convertible
                       , directory
                       , filepath
                       , ghc
@@ -53,10 +54,10 @@ Executable ghc-mod
                       , hlint >= 1.7.1
                       , io-choice
                       , old-time
-                      , time
                       , process
                       , regex-posix
                       , syb
+                      , time
                       , transformers
 
 Source-Repository head