GHC 8 readiness

Language/Haskell/GhcMod/CaseSplit.hs

@@ -107,7 +107,11 @@ isPatternVar (L _ (G.VarPat _)) = True
 isPatternVar _                  = False
 
 getPatternVarName :: LPat Id -> G.Name
+#if __GLASGOW_HASKELL__ >= 800
+getPatternVarName (L _ (G.VarPat (L _ vName))) = G.getName vName
+#else
 getPatternVarName (L _ (G.VarPat vName)) = G.getName vName
+#endif
 getPatternVarName _                      = error "This should never happened"
 
 -- TODO: Information for a type family case split
@@ -167,7 +171,11 @@ getDataCon dflag style vName dcon | [] <- Ty.dataConFieldLabels dcon =
 -- 3. Records
 getDataCon dflag style vName dcon =
   let dName = showName dflag style $ Ty.dataConName dcon
+#if __GLASGOW_HASKELL__ >= 800
+      flds  = map Ty.flSelector $ Ty.dataConFieldLabels dcon
+#else
       flds  = Ty.dataConFieldLabels dcon
+#endif
   in dName ++ " { " ++ showFieldNames dflag style vName flds ++ " }"
 
 -- Create a new variable by adjoining a number

Language/Haskell/GhcMod/FillSig.hs

@@ -116,7 +116,9 @@ getSignature modSum lineNo colNo = do
     p@ParsedModule{pm_parsed_source = ps} <- G.parseModule modSum
     -- Inspect the parse tree to find the signature
     case listifyParsedSpans ps (lineNo, colNo) :: [G.LHsDecl G.RdrName] of
-#if __GLASGOW_HASKELL__ >= 710
+#if __GLASGOW_HASKELL__ >= 800
+      [L loc (G.SigD (Ty.TypeSig names (G.HsIB _ (G.HsWC _ _ (L _ ty)))))] ->
+#elif __GLASGOW_HASKELL__ >= 710
       [L loc (G.SigD (Ty.TypeSig names (L _ ty) _))] ->
 #else
       [L loc (G.SigD (Ty.TypeSig names (L _ ty)))] ->
@@ -131,7 +133,9 @@ getSignature modSum lineNo colNo = do
         case Gap.getClass lst of
             Just (clsName,loc) -> obtainClassInfo minfo clsName loc
             _                  -> return Nothing
-#if __GLASGOW_HASKELL__ >= 708
+#if __GLASGOW_HASKELL__ >= 800
+      [L loc (G.TyClD (G.FamDecl (G.FamilyDecl info (L _ name) (G.HsQTvs _ vars) _ _)))] -> do
+#elif __GLASGOW_HASKELL__ >= 708
       [L loc (G.TyClD (G.FamDecl (G.FamilyDecl info (L _ name) (G.HsQTvs _ vars) _)))] -> do
 #elif __GLASGOW_HASKELL__ >= 706
       [L loc (G.TyClD (G.TyFamily info (L _ name) (G.HsQTvs _ vars) _))] -> do
@@ -149,7 +153,11 @@ getSignature modSum lineNo colNo = do
                         G.DataFamily -> Data
 #endif
 
-#if __GLASGOW_HASKELL__ >= 710
+#if __GLASGOW_HASKELL__ >= 800
+            getTyFamVarName x = case x of
+                L _ (G.UserTyVar (G.L _ n))     -> n
+                L _ (G.KindedTyVar (G.L _ n) _) -> n
+#elif __GLASGOW_HASKELL__ >= 710
             getTyFamVarName x = case x of
                 L _ (G.UserTyVar n)     -> n
                 L _ (G.KindedTyVar (G.L _ n) _) -> n
@@ -269,7 +277,9 @@ class FnArgsInfo ty name | ty -> name, name -> ty where
 
 instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
   getFnName dflag style name = showOccName dflag style $ Gap.occName name
-#if __GLASGOW_HASKELL__ >= 710
+#if __GLASGOW_HASKELL__ >= 800
+  getFnArgs (G.HsForAllTy _ (L _ iTy))
+#elif __GLASGOW_HASKELL__ >= 710
   getFnArgs (G.HsForAllTy _ _ _ _ (L _ iTy))
 #else
   getFnArgs (G.HsForAllTy _ _ _ (L _ iTy))
@@ -280,7 +290,9 @@ instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
   getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) =
       (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
     where fnarg ty = case ty of
-#if __GLASGOW_HASKELL__ >= 710
+#if __GLASGOW_HASKELL__ >= 800
+              (G.HsForAllTy _ (L _ iTy)) ->
+#elif __GLASGOW_HASKELL__ >= 710
               (G.HsForAllTy _ _ _ _ (L _ iTy)) ->
 #else
               (G.HsForAllTy _ _ _ (L _ iTy)) ->
@@ -381,7 +393,11 @@ findVar
   -> m (Maybe (SrcSpan, String, Type, Bool))
 findVar dflag style tcm tcs lineNo colNo =
   case lst of
+#if __GLASGOW_HASKELL__ >= 800
+    e@(L _ (G.HsVar (L _ i))):others -> do
+#else
     e@(L _ (G.HsVar i)):others -> do
+#endif
       tyInfo <- Gap.getType tcm e
       case tyInfo of
         Just (s, typ)
@@ -409,7 +425,11 @@ doParen False s = s
 doParen True  s = if ' ' `elem` s then '(':s ++ ")" else s
 
 isSearchedVar :: Id -> G.HsExpr Id -> Bool
+#if __GLASGOW_HASKELL__ >= 800
+isSearchedVar i (G.HsVar (L _ i2)) = i == i2
+#else
 isSearchedVar i (G.HsVar i2) = i == i2
+#endif
 isSearchedVar _ _ = False
 
 
@@ -512,7 +532,11 @@ getPatsForVariable tcs (lineNo, colNo) =
         _ -> (error "This should never happen", [])
 
 getBindingsForPat :: Ty.Pat Id -> M.Map G.Name Type
+#if __GLASGOW_HASKELL__ >= 800
+getBindingsForPat (Ty.VarPat (L _ i)) = M.singleton (G.getName i) (Ty.varType i)
+#else
 getBindingsForPat (Ty.VarPat i) = M.singleton (G.getName i) (Ty.varType i)
+#endif
 getBindingsForPat (Ty.LazyPat (L _ l)) = getBindingsForPat l
 getBindingsForPat (Ty.BangPat (L _ b)) = getBindingsForPat b
 getBindingsForPat (Ty.AsPat (L _ a) (L _ i)) =
@@ -537,11 +561,23 @@ getBindingsForPat (Ty.ConPatOut { Ty.pat_args = d }) = getBindingsForRecPat d
 getBindingsForPat _ = M.empty
 
 getBindingsForRecPat :: Ty.HsConPatDetails Id -> M.Map G.Name Type
+#if __GLASGOW_HASKELL__ >= 800
+getBindingsForRecPat (G.PrefixCon args) =
+#else
 getBindingsForRecPat (Ty.PrefixCon args) =
+#endif
     M.unions $ map (\(L _ i) -> getBindingsForPat i) args
+#if __GLASGOW_HASKELL__ >= 800
+getBindingsForRecPat (G.InfixCon (L _ a1) (L _ a2)) =
+#else
 getBindingsForRecPat (Ty.InfixCon (L _ a1) (L _ a2)) =
+#endif
     M.union (getBindingsForPat a1) (getBindingsForPat a2)
+#if __GLASGOW_HASKELL__ >= 800
+getBindingsForRecPat (G.RecCon (Ty.HsRecFields { Ty.rec_flds = fields })) =
+#else
 getBindingsForRecPat (Ty.RecCon (Ty.HsRecFields { Ty.rec_flds = fields })) =
+#endif
     getBindingsForRecFields (map unLoc' fields)
  where
 #if __GLASGOW_HASKELL__ >= 710

Language/Haskell/GhcMod/Gap.hs

@@ -156,7 +156,10 @@ setLogAction df f =
 #endif
 
 showDocWith :: DynFlags -> Pretty.Mode -> Pretty.Doc -> String
-#if __GLASGOW_HASKELL__ >= 708
+#if __GLASGOW_HASKELL__ >= 800
+showDocWith dflags mode = Pretty.renderStyle mstyle where
+    mstyle = Pretty.style { Pretty.mode = mode, Pretty.lineLength = pprCols dflags }
+#elif __GLASGOW_HASKELL__ >= 708
 -- Pretty.showDocWith disappeard.
 -- https://github.com/ghc/ghc/commit/08a3536e4246e323fbcd8040e0b80001950fe9bc
 showDocWith dflags mode = Pretty.showDoc mode (pprCols dflags)
@@ -201,7 +204,11 @@ toStringBuffer = liftIO . stringToStringBuffer . unlines
 fOptions :: [String]
 #if __GLASGOW_HASKELL__ >= 710
 fOptions = [option | (FlagSpec option _ _ _) <- fFlags]
+#if __GLASGOW_HASKELL__ >= 800
+        ++ [option | (FlagSpec option _ _ _) <- wWarningFlags]
+#else
         ++ [option | (FlagSpec option _ _ _) <- fWarningFlags]
+#endif
         ++ [option | (FlagSpec option _ _ _) <- fLangFlags]
 #elif __GLASGOW_HASKELL__ >= 704
 fOptions = [option | (option,_,_) <- fFlags]
@@ -467,7 +474,12 @@ type GLMatchI = LMatch Id
 #endif
 
 getClass :: [LInstDecl Name] -> Maybe (Name, SrcSpan)
-#if __GLASGOW_HASKELL__ >= 710
+#if __GLASGOW_HASKELL__ >= 800
+-- Instance declarations of sort 'instance F (G a)'
+getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = HsIB _ (L _ (HsForAllTy _ (L _ (HsAppTy (L _ (HsTyVar (L _ className))) _))))}))] = Just (className, loc)
+-- Instance declarations of sort 'instance F G' (no variables)
+getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = HsIB _ (L _ (HsAppTy (L _ (HsTyVar (L _ className))) _))}))] = Just (className, loc)
+#elif __GLASGOW_HASKELL__ >= 710
 -- Instance declarations of sort 'instance F (G a)'
 getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = (L _ (HsForAllTy _ _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _))))}))] = Just (className, loc)
 -- Instance declarations of sort 'instance F G' (no variables)

Language/Haskell/GhcMod/Logger.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Language.Haskell.GhcMod.Logger (
     withLogger
   , withLogger'
@@ -135,12 +137,21 @@ ppErrMsg err = do
     dflags <- asks gpeDynFlags
     let unqual = errMsgContext err
         st = Gap.mkErrStyle' dflags unqual
+#if __GLASGOW_HASKELL__ < 800
     let ext = showPage dflags st (errMsgExtraInfo err)
+#endif
     m <- ppMsg st spn SevError msg
-    return $ m ++ (if null ext then "" else "\n" ++ ext)
+    return $ m
+#if __GLASGOW_HASKELL__ < 800
+        ++ (if null ext then "" else "\n" ++ ext)
+#endif
    where
      spn = Gap.errorMsgSpan err
+#if __GLASGOW_HASKELL__ >= 800
+     msg = pprLocErrMsg err
+#else
      msg = errMsgShortDoc err
+#endif
 
 ppMsg :: PprStyle -> SrcSpan -> Severity -> SDoc -> GmPprEnvM String
 ppMsg st spn sev msg = do

Language/Haskell/GhcMod/Monad/Newtypes.hs

@@ -124,7 +124,7 @@ instance MonadTrans GmlT where
 
 -- GmT ------------------------------------------
 
-instance forall r m. MonadReader r m => MonadReader r (GmT m) where
+instance MonadReader r m => MonadReader r (GmT m) where
     local f ma = gmLiftWithInner (\run -> local f (run ma))
     ask = gmLiftInner ask
 

Language/Haskell/GhcMod/Target.hs

@@ -21,6 +21,9 @@ import Control.Arrow
 import Control.Applicative
 import Control.Category ((.))
 import GHC
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.LanguageExtensions
+#endif
 import GHC.Paths (libdir)
 import SysTools
 import DynFlags
@@ -477,11 +480,17 @@ loadTargets opts targetStrs = do
 needsHscInterpreted :: ModuleGraph -> Bool
 needsHscInterpreted = any $ \ms ->
                 let df = ms_hspp_opts ms in
+#if __GLASGOW_HASKELL__ >= 800
+                   TemplateHaskell `xopt` df
+                || QuasiQuotes     `xopt` df
+                || PatternSynonyms `xopt` df
+#else
                    Opt_TemplateHaskell `xopt` df
                 || Opt_QuasiQuotes     `xopt` df
 #if __GLASGOW_HASKELL__ >= 708
                 || (Opt_PatternSynonyms `xopt` df)
 #endif
+#endif
 
 cabalResolvedComponents :: (IOish m) =>
    GhcModT m (Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath)))

NotCPP/Declarations.hs

@@ -104,18 +104,36 @@ boundNames decl =
 
       TySynD n _ _ -> [(TcClsName, n)]
       ClassD _ n _ _ _ -> [(TcClsName, n)]
+#if __GLASGOW_HASKELL__ < 800
       FamilyD _ n _ _ -> [(TcClsName, n)]
+#endif
 
+#if __GLASGOW_HASKELL__ >= 800
+      DataD _ n _ _ ctors _ ->
+#else
       DataD _ n _ ctors _ ->
+#endif
           [(TcClsName, n)] ++ map ((,) TcClsName) (conNames `concatMap` ctors)
 
+#if __GLASGOW_HASKELL__ >= 800
+      NewtypeD _ n _ _ ctor _ ->
+#else
       NewtypeD _ n _ ctor _ ->
+#endif
           [(TcClsName, n)] ++ map ((,) TcClsName) (conNames ctor)
 
+#if __GLASGOW_HASKELL__ >= 800
+      DataInstD _ _n _ _ ctors _ ->
+#else
       DataInstD _ _n _ ctors _ ->
+#endif
           map ((,) TcClsName) (conNames `concatMap` ctors)
 
+#if __GLASGOW_HASKELL__ >= 800
+      NewtypeInstD _ _n _ _ ctor _ ->
+#else
       NewtypeInstD _ _n _ ctor _ ->
+#endif
           map ((,) TcClsName) (conNames ctor)
 
       InstanceD _ _ty _ ->
@@ -131,10 +149,19 @@ boundNames decl =
 #endif
 
 #if __GLASGOW_HASKELL__ >= 708
-      ClosedTypeFamilyD n _ _ _ -> [(TcClsName, n)]
       RoleAnnotD _n _ -> error "notcpp: RoleAnnotD not supported yet"
 #endif
 
+#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 800
+      FamilyD _ n _ _ -> [(TcClsName, n)]
+#elif __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800
+      ClosedTypeFamilyD n _ _ _ -> [(TcClsName, n)]
+#else
+      OpenTypeFamilyD (TypeFamilyHead n _ _ _) -> [(TcClsName, n)]
+      ClosedTypeFamilyD (TypeFamilyHead n _ _ _) _ -> [(TcClsName, n)]
+
+#endif
+
 conNames :: Con -> [Name]
 conNames con =
     case con of

NotCPP/LookupValueName.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP             #-}
 {-# LANGUAGE TemplateHaskell #-}
 -- | This module uses scope lookup techniques to either export
 -- 'lookupValueName' from @Language.Haskell.TH@, or define
@@ -25,8 +26,13 @@ bestValueGuess s = do
   case mi of
     Nothing -> no
     Just i -> case i of
+#if __GLASGOW_HASKELL__ >= 800
+      VarI n _ _ -> yes n
+      DataConI n _ _ -> yes n
+#else
       VarI n _ _ _ -> yes n
       DataConI n _ _ _ -> yes n
+#endif
       _ -> err ["unexpected info:", show i]
  where
   no = return Nothing
@@ -34,5 +40,5 @@ bestValueGuess s = do
   err = fail . showString "NotCPP.bestValueGuess: " . unwords
 
 $(recover [d| lookupValueName = bestValueGuess |] $ do
-  VarI _ _ _ _ <- reify (mkName "lookupValueName")
+  VarI{} <- reify (mkName "lookupValueName")
   return [])

NotCPP/Utils.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP             #-}
 {-# LANGUAGE TemplateHaskell #-}
 module NotCPP.Utils where
 
@@ -24,6 +25,11 @@ recoverMaybe q = recover (return Nothing) (Just <$> q)
 -- | Returns @'Just' ('VarE' n)@ if the info relates to a value called
 -- @n@, or 'Nothing' if it relates to a different sort of thing.
 infoToExp :: Info -> Maybe Exp
+#if __GLASGOW_HASKELL__ >= 800
+infoToExp (VarI n _ _) = Just (VarE n)
+infoToExp (DataConI n _ _) = Just (ConE n)
+#else
 infoToExp (VarI n _ _ _) = Just (VarE n)
 infoToExp (DataConI n _ _ _) = Just (ConE n)
+#endif
 infoToExp _ = Nothing

ghc-mod.cabal

@@ -158,24 +158,24 @@ Library
                         System.Directory.ModTime
   Build-Depends:        base              < 5 && >= 4.0
                       , bytestring        < 0.11
-                      , binary            < 0.8 && >= 0.5.1.0
+                      , binary            < 0.9 && >= 0.5.1.0
                       , containers        < 0.6
                       , cabal-helper      < 0.7 && >= 0.6.3.0
                       , deepseq           < 1.5
                       , directory         < 1.3
                       , filepath          < 1.5
-                      , ghc               < 7.11
+                      , ghc               < 8.2
                       , ghc-paths         < 0.2
                       , ghc-syb-utils     < 0.3
                       , hlint             < 1.10 && >= 1.9.26
                       , monad-journal     < 0.8 && >= 0.4
                       , old-time          < 1.2
                       , pretty            < 1.2
-                      , process           < 1.3
+                      , process           < 1.5
                       , syb               < 0.7
                       , temporary         < 1.3
-                      , time              < 1.6
+                      , time              < 1.7
-                      , transformers      < 0.5
+                      , transformers      < 0.6
                       , transformers-base < 0.5
                       , mtl               < 2.3 && >= 2.0
                       , monad-control     < 1.1 && >= 1
@@ -193,6 +193,8 @@ Library
     -- Only used to constrain random to a version that still works with GHC 7.4
     Build-Depends:      random <= 1.0.1.1,
                         ghc-prim
+  if impl(ghc >= 8.0)
+    Build-Depends:      ghc-boot
 
 Executable ghc-mod
   Default-Language:     Haskell2010
@@ -211,10 +213,10 @@ Executable ghc-mod
                       , directory < 1.3
                       , filepath  < 1.5
                       , pretty    < 1.2
-                      , process   < 1.3
+                      , process   < 1.5
                       , split     < 0.3
                       , mtl       < 2.3 && >= 2.0
-                      , ghc       < 7.11
+                      , ghc       < 8.1
                       , monad-control ==1.0.*
                       , fclabels  ==2.0.*
                       , optparse-applicative >=0.11.0 && <0.13.0
@@ -231,13 +233,13 @@ Executable ghc-modi
   Default-Extensions:   ConstraintKinds, FlexibleContexts
   HS-Source-Dirs:       src, .
   Build-Depends:        base      < 5 && >= 4.0
-                      , binary    < 0.8 && >= 0.5.1.0
+                      , binary    < 0.9 && >= 0.5.1.0
                       , deepseq   < 1.5
                       , directory < 1.3
                       , filepath  < 1.5
-                      , process   < 1.3
+                      , process   < 1.5
                       , old-time  < 1.2
-                      , time      < 1.6
+                      , time      < 1.7
                       , ghc-mod
 
 Test-Suite doctest