diff --git a/Language/Haskell/GhcMod/CaseSplit.hs b/Language/Haskell/GhcMod/CaseSplit.hs index 7c98f6e..10f9d12 100644 --- a/Language/Haskell/GhcMod/CaseSplit.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index 6ab76c1..bd84504 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs index 48337e0..83355d6 100644 --- a/Language/Haskell/GhcMod/Gap.hs +++ b/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) diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index 36d1995..dd100d6 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Language.Haskell.GhcMod.Logger ( withLogger , withLogger' @@ -135,12 +137,20 @@ ppErrMsg err = do dflags <- asks gpeDynFlags let unqual = errMsgContext err st = Gap.mkErrStyle' dflags unqual +#if __GLASGOW_HASKELL__ >= 800 + return $ showPage dflags st msg +#else let ext = showPage dflags st (errMsgExtraInfo err) m <- ppMsg st spn SevError msg return $ m ++ (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 diff --git a/Language/Haskell/GhcMod/Monad/Newtypes.hs b/Language/Haskell/GhcMod/Monad/Newtypes.hs index dd7e5a6..ab3d82e 100644 --- a/Language/Haskell/GhcMod/Monad/Newtypes.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index 2e2d1ae..11cfe3d 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/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 @@ -489,11 +492,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))) diff --git a/NotCPP/LookupValueName.hs b/NotCPP/LookupValueName.hs index 9132e99..b12d08f 100644 --- a/NotCPP/LookupValueName.hs +++ b/NotCPP/LookupValueName.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP, TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} -- | This module uses scope lookup techniques to either export -- 'lookupValueName' from @Language.Haskell.TH@, or define -- its own 'lookupValueName', which attempts to do the @@ -39,9 +40,5 @@ bestValueGuess s = do err = fail . showString "NotCPP.bestValueGuess: " . unwords $(recover [d| lookupValueName = bestValueGuess |] $ do -#if __GLASGOW_HASKELL__ >= 800 - VarI _ _ _ <- reify (mkName "lookupValueName") -#else - VarI _ _ _ _ <- reify (mkName "lookupValueName") -#endif + VarI{} <- reify (mkName "lookupValueName") return []) diff --git a/NotCPP/Utils.hs b/NotCPP/Utils.hs index 8557c4a..d25b637 100644 --- a/NotCPP/Utils.hs +++ b/NotCPP/Utils.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP, TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} module NotCPP.Utils where import Control.Applicative ((<$>)) @@ -24,19 +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 _ _) = +infoToExp (VarI n _ _) = Just (VarE n) +infoToExp (DataConI n _ _) = Just (ConE n) #else -infoToExp (VarI n _ _ _) = +infoToExp (VarI n _ _ _) = Just (VarE n) +infoToExp (DataConI n _ _ _) = Just (ConE n) #endif - Just (VarE n) - -#if __GLASGOW_HASKELL__ >= 800 -infoToExp (DataConI n _ _) = -#else -infoToExp (DataConI n _ _ _) = -#endif - Just (ConE n) - infoToExp _ = Nothing diff --git a/ghc-mod.cabal b/ghc-mod.cabal index 85f0738..01b9ea1 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -192,6 +192,8 @@ Library , syb if impl(ghc < 7.8) Build-Depends: convertible + if impl(ghc >= 8.0) + Build-Depends: ghc-boot Executable ghc-mod Default-Language: Haskell2010