haskell/ghcide
1
1
Fork 0
mirror of https://github.com/haskell/ghcide.git synced 2024-11-30 01:22:34 +03:00
Code Issues Projects Releases Wiki Activity

Remove 8.4 CPP (#834)

Browse Source 
* Remove 8.4 CPP

* hlint

* remove stack84.yaml
This commit is contained in:
wz1000 2020-09-27 22:38:40 +05:30 committed by GitHub
parent 62f4d0644a
commit 1bb4c49fda
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
13 changed files with 46 additions and 415 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Development/IDE/Core/Compile.hs
View File

@ -45,9 +45,7 @@ import Development.IDE.Types.Location
import Language.Haskell.LSP.Types (DiagnosticTag(..))
#if MIN_GHC_API_VERSION(8,6,0)
import LoadIface (loadModuleInterface)
#endif
import qualified Parser
import Lexer
@ -147,13 +145,9 @@ typecheckModule (IdeDefer defer) hsc pm = do
initPlugins :: GhcMonad m => ModSummary -> m ModSummary
initPlugins modSummary = do
#if MIN_GHC_API_VERSION(8,6,0)
session <- getSession
dflags <- liftIO $ initializePlugins session (ms_hspp_opts modSummary)
return modSummary{ms_hspp_opts = dflags}
#else
return modSummary
#endif
-- | Whether we should run the -O0 simplifier when generating core.
--
@ -278,9 +272,7 @@ unnecessaryDeprecationWarningFlags
#if MIN_GHC_API_VERSION(8,10,0)
, Opt_WarnUnusedRecordWildcards
#endif
#if MIN_GHC_API_VERSION(8,6,0)
, Opt_WarnInaccessibleCode
#endif
, Opt_WarnWarningsDeprecations
]
@ -662,9 +654,7 @@ removePackageImports pkgs (L l h@HsModule {hsmodImports} ) = L l (h { hsmodImpor
case PackageName . sl_fs <$> ideclPkgQual of
Just pn | pn `elem` pkgs -> L l (i { ideclPkgQual = Nothing })
_ -> L l i
#if MIN_GHC_API_VERSION(8,6,0)
do_one_import l = l
#endif
loadHieFile :: Compat.NameCacheUpdater -> FilePath -> IO GHC.HieFile
loadHieFile ncu f = do
@ -709,7 +699,6 @@ getDocsBatch :: GhcMonad m
-> [Name]
-> m [Either String (Maybe HsDocString, Map.Map Int HsDocString)]
getDocsBatch _mod _names =
#if MIN_GHC_API_VERSION(8,6,0)
withSession $ \hsc_env -> liftIO $ do
((_warns,errs), res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ forM _names $ \name ->
case nameModule_maybe name of
@ -733,9 +722,6 @@ getDocsBatch _mod _names =
case nameSrcLoc n of
RealSrcLoc {} -> False
UnhelpfulLoc {} -> True
#else
return []
#endif
fakeSpan :: RealSrcSpan
fakeSpan = realSrcLocSpan $ mkRealSrcLoc (fsLit "<ghcide>") 1 1

4
src/Development/IDE/Core/Rules.hs
View File

@ -554,7 +554,7 @@ getDocMapRule =
-- When possible, rely on the haddocks embedded in our interface files
-- This creates problems on ghc-lib, see comment on 'getDocumentationTryGhc'
#if MIN_GHC_API_VERSION(8,6,0) && !defined(GHC_LIB)
#if !defined(GHC_LIB)
let parsedDeps = []
#else
parsedDeps <- uses_ GetParsedModule tdeps
@ -822,7 +822,7 @@ getModSummaryRule = do
getModIfaceRule :: Rules ()
getModIfaceRule = defineEarlyCutoff $ \GetModIface f -> do
#if MIN_GHC_API_VERSION(8,6,0) && !defined(GHC_LIB)
#if !defined(GHC_LIB)
fileOfInterest <- use_ IsFileOfInterest f
case fileOfInterest of
IsFOI _ -> do

276
src/Development/IDE/GHC/Compat.hs
View File

@ -35,24 +35,9 @@ module Development.IDE.GHC.Compat(
getModuleHash,
getPackageName,
setUpTypedHoles,
pattern DerivD,
pattern ForD,
pattern InstD,
pattern TyClD,
pattern ValD,
pattern SigD,
pattern TypeSig,
pattern ClassOpSig,
pattern IEThingAll,
pattern IEThingWith,
pattern VarPat,
pattern PatSynBind,
pattern ValBinds,
pattern HsValBinds,
GHC.ModLocation,
Module.addBootSuffix,
pattern ModLocation,
getConArgs,
HasSrcSpan,
getLoc,
upNameCache,
@ -71,8 +56,6 @@ module Development.IDE.GHC.Compat(
module GHC,
initializePlugins,
applyPluginsParsedResultAction,
#if MIN_GHC_API_VERSION(8,6,0)
#if MIN_GHC_API_VERSION(8,8,0)
module HieTypes,
module HieUtils,
@ -81,17 +64,10 @@ module Development.IDE.GHC.Compat(
module Development.IDE.GHC.HieUtils,
#endif
#else
HieASTs,
getAsts,
generateReferencesMap,
#endif
) where
import StringBuffer
import DynFlags
import FieldLabel
import Fingerprint (Fingerprint)
import qualified Module
import Packages
@ -110,31 +86,18 @@ import HsExtension
import qualified GHC
import GHC hiding (
ClassOpSig,
DerivD,
ForD,
IEThingAll,
IEThingWith,
InstD,
TyClD,
ValD,
SigD,
TypeSig,
VarPat,
ModLocation,
HasSrcSpan,
PatSynBind,
ValBinds,
HsValBinds,
lookupName,
getLoc
#if MIN_GHC_API_VERSION(8,6,0)
, getConArgs
#endif
)
import qualified HeaderInfo as Hdr
import Avail
#if MIN_GHC_API_VERSION(8,8,0)
import Data.List (foldl')
#else
import Data.List (foldl', isSuffixOf)
#endif
import ErrUtils (ErrorMessages)
import FastString (FastString)
import ConLike (ConLike (PatSynCon))
@ -146,10 +109,9 @@ import InstEnv (tidyClsInstDFun)
import PatSyn (PatSyn, tidyPatSynIds)
#endif
#if MIN_GHC_API_VERSION(8,6,0)
import Development.IDE.GHC.HieAst (mkHieFile,enrichHie)
import Development.IDE.GHC.HieBin
import qualified DynamicLoading
import DynamicLoading
import Plugins (Plugin(parsedResultAction), withPlugins)
import Data.Map.Strict (Map)
@ -162,23 +124,12 @@ import Development.IDE.GHC.HieTypes
import System.FilePath ((-<.>))
#endif
#endif
#if MIN_GHC_API_VERSION(8,8,0)
import GhcPlugins (Unfolding(BootUnfolding), setIdUnfolding, tidyTopType, setIdType, globaliseId, ppr, pprPanic, isWiredInName, elemNameSet, idName, filterOut)
# else
import qualified EnumSet
#if MIN_GHC_API_VERSION(8,6,0)
import GhcPlugins (srcErrorMessages, Unfolding(BootUnfolding), setIdUnfolding, tidyTopType, setIdType, globaliseId, isWiredInName, elemNameSet, idName, filterOut)
import Data.List (isSuffixOf)
#else
import System.IO.Error
import IfaceEnv
import Binary
import Data.ByteString (ByteString)
import GhcPlugins (Hsc, srcErrorMessages, Unfolding(BootUnfolding), setIdUnfolding, tidyTopType, setIdType, globaliseId, isWiredInName, elemNameSet, idName, filterOut)
#endif
import Control.Exception (catch)
import System.IO
@ -198,7 +149,6 @@ noExtField = noExt
#endif
#if MIN_GHC_API_VERSION(8,6,0)
supportsHieFiles :: Bool
supportsHieFiles = True
@ -212,8 +162,6 @@ ml_hie_file ml
| otherwise = ml_hi_file ml -<.> ".hie"
#endif
#endif
upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
#if !MIN_GHC_API_VERSION(8,8,0)
upNameCache ref upd_fn
@ -221,14 +169,8 @@ upNameCache ref upd_fn
#else
upNameCache = updNameCache
#endif
#if !MIN_GHC_API_VERSION(8,6,0)
includePathsGlobal, includePathsQuote :: [String] -> [String]
includePathsGlobal = id
includePathsQuote = const []
#endif
#if MIN_GHC_API_VERSION(8,6,0)
type RefMap = Map Identifier [(Span, IdentifierDetails Type)]
mkHieFile' :: ModSummary
@ -248,108 +190,10 @@ mkHieFile' ms exports asts src = do
, hie_exports = mkIfaceExports exports
, hie_hs_src = src
}
#else
type RefMap = ()
type HieASTs a = ()
mkHieFile' :: ModSummary
-> [AvailInfo]
-> HieASTs Type
-> BS.ByteString
-> Hsc HieFile
mkHieFile' ms exports _ _ = return (HieFile (ms_mod ms) es)
where
es = nameListFromAvails (mkIfaceExports exports)
enrichHie :: TypecheckedSource -> RenamedSource -> Hsc (HieASTs Type)
enrichHie _ _ = pure ()
getAsts :: HieASTs Type -> ()
getAsts = id
generateReferencesMap :: () -> RefMap
generateReferencesMap = id
#endif
addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
#if MIN_GHC_API_VERSION(8,6,0)
addIncludePathsQuote path x = x{includePaths = f $ includePaths x}
where f i = i{includePathsQuote = path : includePathsQuote i}
#else
addIncludePathsQuote path x = x{includePaths = path : includePaths x}
#endif
pattern DerivD :: DerivDecl p -> HsDecl p
pattern DerivD x <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.DerivD _ x
#else
GHC.DerivD x
#endif
pattern ForD :: ForeignDecl p -> HsDecl p
pattern ForD x <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.ForD _ x
#else
GHC.ForD x
#endif
pattern ValD :: HsBind p -> HsDecl p
pattern ValD x <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.ValD _ x
#else
GHC.ValD x
#endif
pattern InstD :: InstDecl p -> HsDecl p
pattern InstD x <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.InstD _ x
#else
GHC.InstD x
#endif
pattern TyClD :: TyClDecl p -> HsDecl p
pattern TyClD x <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.TyClD _ x
#else
GHC.TyClD x
#endif
pattern SigD :: Sig p -> HsDecl p
pattern SigD x <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.SigD _ x
#else
GHC.SigD x
#endif
pattern TypeSig :: [Located (IdP p)] -> LHsSigWcType p -> Sig p
pattern TypeSig x y <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.TypeSig _ x y
#else
GHC.TypeSig x y
#endif
pattern ClassOpSig :: Bool -> [Located (IdP pass)] -> LHsSigType pass -> Sig pass
pattern ClassOpSig a b c <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.ClassOpSig _ a b c
#else
GHC.ClassOpSig a b c
#endif
pattern IEThingWith :: LIEWrappedName (IdP pass) -> IEWildcard -> [LIEWrappedName (IdP pass)] -> [Located (FieldLbl (IdP pass))] -> IE pass
pattern IEThingWith a b c d <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.IEThingWith _ a b c d
#else
GHC.IEThingWith a b c d
#endif
pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> GHC.ModLocation
pattern ModLocation a b c <-
@ -359,46 +203,6 @@ pattern ModLocation a b c <-
GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c
#endif
pattern IEThingAll :: LIEWrappedName (IdP pass) -> IE pass
pattern IEThingAll a <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.IEThingAll _ a
#else
GHC.IEThingAll a
#endif
pattern VarPat :: Located (IdP p) -> Pat p
pattern VarPat x <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.VarPat _ x
#else
GHC.VarPat x
#endif
pattern PatSynBind :: GHC.PatSynBind p p -> HsBind p
pattern PatSynBind x <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.PatSynBind _ x
#else
GHC.PatSynBind x
#endif
pattern ValBinds :: LHsBinds p -> [LSig p] -> HsValBindsLR p p
pattern ValBinds b s <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.ValBinds _ b s
#else
GHC.ValBindsIn b s
#endif
pattern HsValBinds :: HsValBindsLR p p -> HsLocalBindsLR p p
pattern HsValBinds b <-
#if MIN_GHC_API_VERSION(8,6,0)
GHC.HsValBinds _ b
#else
GHC.HsValBinds b
#endif
setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir _f d =
#if MIN_GHC_API_VERSION(8,8,0)
@ -416,7 +220,6 @@ dontWriteHieFiles d =
#endif
setUpTypedHoles ::DynFlags -> DynFlags
#if MIN_GHC_API_VERSION(8,6,0)
setUpTypedHoles df
= flip gopt_unset Opt_AbstractRefHoleFits -- too spammy
#if MIN_GHC_API_VERSION(8,8,0)
@ -435,59 +238,12 @@ setUpTypedHoles df
, maxRefHoleFits = Just 10 -- quantity does not impact speed
, maxValidHoleFits = Nothing -- quantity does not impact speed
}
#else
setUpTypedHoles = id
#endif
nameListFromAvails :: [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails as =
map (\n -> (nameSrcSpan n, n)) (concatMap availNames as)
#if !MIN_GHC_API_VERSION(8,6,0)
-- Reimplementations of functions for HIE files for GHC 8.6
mkHieFile :: ModSummary -> TcGblEnv -> RenamedSource -> ByteString -> Hsc HieFile
mkHieFile ms ts _ _ = return (HieFile (ms_mod ms) es)
where
es = nameListFromAvails (mkIfaceExports (tcg_exports ts))
ml_hie_file :: GHC.ModLocation -> FilePath
ml_hie_file ml = ml_hi_file ml ++ ".hie"
data HieFile = HieFile {hie_module :: Module, hie_exports :: [(SrcSpan, Name)]}
hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames = hie_exports
instance Binary HieFile where
put_ bh (HieFile m es) = do
put_ bh m
put_ bh es
get bh = do
mod <- get bh
es <- get bh
return (HieFile mod es)
data HieFileResult = HieFileResult { hie_file_result :: HieFile }
writeHieFile :: FilePath -> HieFile -> IO ()
readHieFile :: NameCacheUpdater -> FilePath -> IO HieFileResult
supportsHieFiles :: Bool
#if MIN_GHC_API_VERSION(8,4,0)
supportsHieFiles = False
writeHieFile _ _ = return ()
readHieFile _ fp = ioError $ mkIOError doesNotExistErrorType "" Nothing (Just fp)
#endif
#endif
getHeaderImports
:: DynFlags
-> StringBuffer
@ -537,13 +293,6 @@ getModuleHash = mi_mod_hash . mi_final_exts
getModuleHash = mi_mod_hash
#endif
getConArgs :: ConDecl pass -> HsConDeclDetails pass
#if MIN_GHC_API_VERSION(8,6,0)
getConArgs = GHC.getConArgs
#else
getConArgs = GHC.getConDetails
#endif
getPackageName :: DynFlags -> Module.InstalledUnitId -> Maybe PackageName
getPackageName dfs i = packageName <$> lookupPackage dfs (Module.DefiniteUnitId (Module.DefUnitId i))
@ -557,11 +306,6 @@ wopt_unset_fatal dfs f
= dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
#endif
#if MIN_GHC_API_VERSION(8,6,0)
initializePlugins :: HscEnv -> DynFlags -> IO DynFlags
initializePlugins env dflags = do
DynamicLoading.initializePlugins env dflags
applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> ApiAnns -> ParsedSource -> IO ParsedSource
applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do
-- Apply parsedResultAction of plugins
@ -570,16 +314,6 @@ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do
runHsc env $ withPlugins dflags applyPluginAction
(HsParsedModule parsed [] hpm_annotations)
#else
initializePlugins :: HscEnv -> DynFlags -> IO DynFlags
initializePlugins _env dflags = do
return dflags
applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> ApiAnns -> ParsedSource -> IO ParsedSource
applyPluginsParsedResultAction _env _dflags _ms _hpm_annotations parsed =
return parsed
#endif
-- | This function recalculates the fields md_types and md_insts in the ModDetails.
-- It duplicates logic from GHC mkBootModDetailsTc to keep more ids,
-- because ghc drops ids in tcg_keep, which matters because TH identifiers

2
src/Development/IDE/GHC/Orphans.hs
View File

@ -83,7 +83,6 @@ instance Hashable ModuleName where
hashWithSalt salt = hashWithSalt salt . show
#if MIN_GHC_API_VERSION(8,6,0)
instance NFData a => NFData (IdentifierDetails a) where
rnf (IdentifierDetails a b) = rnf a `seq` rnf (length b)
@ -92,7 +91,6 @@ instance NFData RealSrcSpan where
instance NFData Type where
rnf = rwhnf
#endif
instance Show a => Show (Bag a) where
show = show . bagToList

4
src/Development/IDE/Import/FindImports.hs
View File

@ -155,14 +155,12 @@ notFoundErr dfs modName reason =
{ fr_pkgs_hidden = map (moduleUnitId . fst) pkg_hiddens
, fr_mods_hidden = map (moduleUnitId . fst) mod_hiddens
}
#if MIN_GHC_API_VERSION(8,6,0)
LookupUnusable unusable ->
let unusables' = map get_unusable unusable
get_unusable (m, ModUnusable r) = (moduleUnitId m, r)
get_unusable (_, r) =
pprPanic "findLookupResult: unexpected origin" (ppr r)
in notFound {fr_unusables = unusables'}
#endif
LookupNotFound suggest ->
notFound {fr_suggestions = suggest}
@ -172,8 +170,6 @@ notFound = NotFound
, fr_pkg = Nothing
, fr_pkgs_hidden = []
, fr_mods_hidden = []
#if MIN_GHC_API_VERSION(8,6,0)
, fr_unusables = []
#endif
, fr_suggestions = []
}

28
src/Development/IDE/LSP/Outline.hs
View File

@ -70,7 +70,7 @@ moduleOutline _lsp ideState DocumentSymbolParams { _textDocument = TextDocumentI
Nothing -> pure $ Right $ DSDocumentSymbols (List [])
documentSymbolForDecl :: Located (HsDecl GhcPs) -> Maybe DocumentSymbol
documentSymbolForDecl (L (RealSrcSpan l) (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
documentSymbolForDecl (L (RealSrcSpan l) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName n
<> (case pprText fdTyVars of
@ -80,7 +80,7 @@ documentSymbolForDecl (L (RealSrcSpan l) (TyClD FamDecl { tcdFam = FamilyDecl {
, _detail = Just $ pprText fdInfo
, _kind = SkClass
}
documentSymbolForDecl (L (RealSrcSpan l) (TyClD ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
documentSymbolForDecl (L (RealSrcSpan l) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName name
<> (case pprText tcdTyVars of
@ -96,11 +96,11 @@ documentSymbolForDecl (L (RealSrcSpan l) (TyClD ClassDecl { tcdLName = L _ name,
, _kind = SkMethod
, _selectionRange = realSrcSpanToRange l'
}
| L (RealSrcSpan l) (ClassOpSig False names _) <- tcdSigs
| L (RealSrcSpan l) (ClassOpSig _ False names _) <- tcdSigs
, L (RealSrcSpan l') n <- names
]
}
documentSymbolForDecl (L (RealSrcSpan l) (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
documentSymbolForDecl (L (RealSrcSpan l) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName name
, _kind = SkStruct
@ -127,59 +127,55 @@ documentSymbolForDecl (L (RealSrcSpan l) (TyClD DataDecl { tcdLName = L _ name,
, L (RealSrcSpan l) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf
]
conArgRecordFields _ = Nothing
documentSymbolForDecl (L (RealSrcSpan l) (TyClD SynDecl { tcdLName = L (RealSrcSpan l') n })) = Just
documentSymbolForDecl (L (RealSrcSpan l) (TyClD _ SynDecl { tcdLName = L (RealSrcSpan l') n })) = Just
(defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n
, _kind = SkTypeParameter
, _selectionRange = realSrcSpanToRange l'
}
documentSymbolForDecl (L (RealSrcSpan l) (InstD ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
documentSymbolForDecl (L (RealSrcSpan l) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
= Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty
, _kind = SkInterface
}
documentSymbolForDecl (L (RealSrcSpan l) (InstD DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
documentSymbolForDecl (L (RealSrcSpan l) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
(map pprText feqn_pats)
, _kind = SkInterface
}
documentSymbolForDecl (L (RealSrcSpan l) (InstD TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
documentSymbolForDecl (L (RealSrcSpan l) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
(map pprText feqn_pats)
, _kind = SkInterface
}
documentSymbolForDecl (L (RealSrcSpan l) (DerivD DerivDecl { deriv_type })) =
documentSymbolForDecl (L (RealSrcSpan l) (DerivD _ DerivDecl { deriv_type })) =
gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) ->
(defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs)
name
, _kind = SkInterface
}
documentSymbolForDecl (L (RealSrcSpan l) (ValD FunBind{fun_id = L _ name})) = Just
documentSymbolForDecl (L (RealSrcSpan l) (ValD _ FunBind{fun_id = L _ name})) = Just
(defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName name
, _kind = SkFunction
}
documentSymbolForDecl (L (RealSrcSpan l) (ValD PatBind{pat_lhs})) = Just
documentSymbolForDecl (L (RealSrcSpan l) (ValD _ PatBind{pat_lhs})) = Just
(defDocumentSymbol l :: DocumentSymbol)
{ _name = pprText pat_lhs
, _kind = SkFunction
}
documentSymbolForDecl (L (RealSrcSpan l) (ForD x)) = Just
documentSymbolForDecl (L (RealSrcSpan l) (ForD _ x)) = Just
(defDocumentSymbol l :: DocumentSymbol)
{ _name = case x of
ForeignImport{} -> name
ForeignExport{} -> name
#if MIN_GHC_API_VERSION(8,6,0)
XForeignDecl{} -> "?"
#endif
, _kind = SkObject
, _detail = case x of
ForeignImport{} -> Just "import"
ForeignExport{} -> Just "export"
#if MIN_GHC_API_VERSION(8,6,0)
XForeignDecl{} -> Nothing
#endif
}
where name = showRdrName $ unLoc $ fd_name x

26
src/Development/IDE/Plugin/CodeAction.hs
View File

@ -222,10 +222,10 @@ suggestDeleteUnusedBinding
findRelatedSpans
indexedContent
name
(L (RealSrcSpan l) (ValD (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) =
(L (RealSrcSpan l) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) =
case lname of
(L nLoc _name) | isTheBinding nLoc ->
let findSig (L (RealSrcSpan l) (SigD sig)) = findRelatedSigSpan indexedContent name l sig
let findSig (L (RealSrcSpan l) (SigD _ sig)) = findRelatedSigSpan indexedContent name l sig
findSig _ = []
in
[extendForSpaces indexedContent $ toRange l]
@ -253,7 +253,7 @@ suggestDeleteUnusedBinding
-- Second of the tuple means there is only one match
findRelatedSigSpan1 :: String -> Sig GhcPs -> Maybe (SrcSpan, Bool)
findRelatedSigSpan1 name (TypeSig lnames _) =
findRelatedSigSpan1 name (TypeSig _ lnames _) =
let maybeIdx = findIndex (\(L _ id) -> isSameName id name) lnames
in case maybeIdx of
Nothing -> Nothing
@ -282,14 +282,12 @@ suggestDeleteUnusedBinding
name
(L _ Match{m_grhss=GRHSs{grhssLocalBinds}}) = do
case grhssLocalBinds of
(L _ (HsValBinds (ValBinds bag lsigs))) ->
(L _ (HsValBinds _ (ValBinds _ bag lsigs))) ->
if isEmptyBag bag
then []
else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag
_ -> []
#if MIN_GHC_API_VERSION(8,6,0)
findRelatedSpanForMatch _ _ _ = []
#endif
findRelatedSpanForHsBind
:: PositionIndexedString
@ -368,12 +366,12 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
isTopLevel l = (_character . _start) l == 0
exportsAs :: HsDecl p -> Maybe (ExportsAs, Located (IdP p))
exportsAs (ValD FunBind {fun_id}) = Just (ExportName, fun_id)
exportsAs (ValD (PatSynBind PSB {psb_id})) = Just (ExportPattern, psb_id)
exportsAs (TyClD SynDecl{tcdLName}) = Just (ExportName, tcdLName)
exportsAs (TyClD DataDecl{tcdLName}) = Just (ExportAll, tcdLName)
exportsAs (TyClD ClassDecl{tcdLName}) = Just (ExportAll, tcdLName)
exportsAs (TyClD FamDecl{tcdFam}) = Just (ExportAll, fdLName tcdFam)
exportsAs (ValD _ FunBind {fun_id}) = Just (ExportName, fun_id)
exportsAs (ValD _ (PatSynBind _ PSB {psb_id})) = Just (ExportPattern, psb_id)
exportsAs (TyClD _ SynDecl{tcdLName}) = Just (ExportName, tcdLName)
exportsAs (TyClD _ DataDecl{tcdLName}) = Just (ExportAll, tcdLName)
exportsAs (TyClD _ ClassDecl{tcdLName}) = Just (ExportAll, tcdLName)
exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportAll, fdLName tcdFam)
exportsAs _ = Nothing
suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
@ -1039,8 +1037,8 @@ rangesForBinding _ _ = []
rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]
rangesForBinding' b (L l x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l]
rangesForBinding' b (L l x@IEThingAbs{}) | showSDocUnsafe (ppr x) == b = [l]
rangesForBinding' b (L l (IEThingAll x)) | showSDocUnsafe (ppr x) == b = [l]
rangesForBinding' b (L l (IEThingWith thing _ inners labels))
rangesForBinding' b (L l (IEThingAll _ x)) | showSDocUnsafe (ppr x) == b = [l]
rangesForBinding' b (L l (IEThingWith _ thing _ inners labels))
| showSDocUnsafe (ppr thing) == b = [l]
| otherwise =
[ l' | L l' x <- inners, showSDocUnsafe (ppr x) == b] ++

4
src/Development/IDE/Plugin/Completions.hs
View File

@ -35,7 +35,7 @@ import HscTypes (HscEnv(hsc_dflags))
import Data.Maybe
import Data.Functor ((<&>))
#if !MIN_GHC_API_VERSION(8,6,0) || defined(GHC_LIB)
#if defined(GHC_LIB)
import Development.IDE.Import.DependencyInformation
#endif
@ -65,7 +65,7 @@ produceCompletions = do
-- When possible, rely on the haddocks embedded in our interface files
-- This creates problems on ghc-lib, see comment on 'getDocumentationTryGhc'
#if MIN_GHC_API_VERSION(8,6,0) && !defined(GHC_LIB)
#if !defined(GHC_LIB)
let parsedDeps = []
#else
deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file

20
src/Development/IDE/Plugin/Completions/Logic.hs
View File

@ -321,34 +321,34 @@ localCompletionsForParsedModule pm@ParsedModule{pm_parsed_source = L _ HsModule{
where
typeSigIds = Set.fromList
[ id
| L _ (SigD (TypeSig ids _)) <- hsmodDecls
| L _ (SigD _ (TypeSig _ ids _)) <- hsmodDecls
, L _ id <- ids
]
hasTypeSig = (`Set.member` typeSigIds) . unLoc
compls = concat
[ case decl of
SigD (TypeSig ids typ) ->
SigD _ (TypeSig _ ids typ) ->
[mkComp id CiFunction (Just $ ppr typ) | id <- ids]
ValD FunBind{fun_id} ->
ValD _ FunBind{fun_id} ->
[ mkComp fun_id CiFunction Nothing
| not (hasTypeSig fun_id)
]
ValD PatBind{pat_lhs} ->
ValD _ PatBind{pat_lhs} ->
[mkComp id CiVariable Nothing
| VarPat id <- listify (\(_ :: Pat GhcPs) -> True) pat_lhs]
TyClD ClassDecl{tcdLName, tcdSigs} ->
| VarPat _ id <- listify (\(_ :: Pat GhcPs) -> True) pat_lhs]
TyClD _ ClassDecl{tcdLName, tcdSigs} ->
mkComp tcdLName CiClass Nothing :
[ mkComp id CiFunction (Just $ ppr typ)
| L _ (TypeSig ids typ) <- tcdSigs
| L _ (TypeSig _ ids typ) <- tcdSigs
, id <- ids]
TyClD x ->
TyClD _ x ->
[mkComp id cl Nothing
| id <- listify (\(_ :: Located(IdP GhcPs)) -> True) x
, let cl = occNameToComKind Nothing (rdrNameOcc $ unLoc id)]
ForD ForeignImport{fd_name,fd_sig_ty} ->
ForD _ ForeignImport{fd_name,fd_sig_ty} ->
[mkComp fd_name CiVariable (Just $ ppr fd_sig_ty)]
ForD ForeignExport{fd_name,fd_sig_ty} ->
ForD _ ForeignExport{fd_name,fd_sig_ty} ->
[mkComp fd_name CiVariable (Just $ ppr fd_sig_ty)]
_ -> []
| L _ decl <- hsmodDecls

5
src/Development/IDE/Spans/Common.hs
View File

@ -77,16 +77,11 @@ emptySpanDoc :: SpanDoc
emptySpanDoc = SpanDocText [] (SpanDocUris Nothing Nothing)
spanDocToMarkdown :: SpanDoc -> [T.Text]
#if MIN_GHC_API_VERSION(8,6,0)
spanDocToMarkdown (SpanDocString docs uris)
= [T.pack $ haddockToMarkdown $ H.toRegular $ H._doc $ H.parseParas Nothing $ unpackHDS docs]
<> ["\n"] <> spanDocUrisToMarkdown uris
-- Append the extra newlines since this is markdown --- to get a visible newline,
-- you need to have two newlines
#else
spanDocToMarkdown (SpanDocString _ uris)
= spanDocUrisToMarkdown uris
#endif
spanDocToMarkdown (SpanDocText txt uris) = txt <> ["\n"] <> spanDocUrisToMarkdown uris
spanDocUrisToMarkdown :: SpanDocUris -> [T.Text]

11
src/Development/IDE/Spans/Documentation.hs
View File

@ -21,9 +21,7 @@ import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe
import qualified Data.Text as T
#if MIN_GHC_API_VERSION(8,6,0)
import Development.IDE.Core.Compile
#endif
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error
import Development.IDE.Spans.Common
@ -75,20 +73,15 @@ getDocumentationTryGhc mod deps n = head <$> getDocumentationsTryGhc mod deps [n
getDocumentationsTryGhc :: GhcMonad m => Module -> [ParsedModule] -> [Name] -> m [SpanDoc]
-- Interfaces are only generated for GHC >= 8.6.
-- In older versions, interface files do not embed Haddocks anyway
#if MIN_GHC_API_VERSION(8,6,0)
getDocumentationsTryGhc mod sources names = do
res <- catchSrcErrors "docs" $ getDocsBatch mod names
case res of
Left _ -> mapM mkSpanDocText names
Right res -> zipWithM unwrap res names
where
unwrap (Right (Just docs, _)) n = SpanDocString <$> pure docs <*> getUris n
unwrap (Right (Just docs, _)) n = SpanDocString docs <$> getUris n
unwrap _ n = mkSpanDocText n
#else
getDocumentationsTryGhc _ sources names = mapM mkSpanDocText names
where
#endif
mkSpanDocText name =
pure (SpanDocText (getDocumentation sources name)) <*> getUris name
@ -132,7 +125,7 @@ getDocumentation sources targetName = fromMaybe [] $ do
-- Top level names bound by the module
let bs = [ n | let L _ HsModule{hsmodDecls} = pm_parsed_source tc
, L _ (ValD hsbind) <- hsmodDecls
, L _ (ValD _ hsbind) <- hsmodDecls
, Just n <- [name_of_bind hsbind]
]
-- Sort the names' source spans.

45
stack84.yaml
View File

@ -1,45 +0,0 @@
resolver: lts-12.26
packages:
- .
extra-deps:
- aeson-1.4.6.0
- base-orphans-0.8.2
- haskell-lsp-0.22.0.0
- haskell-lsp-types-0.22.0.0
- lsp-test-0.11.0.5
- rope-utf16-splay-0.3.1.0
- filepattern-0.1.1
- js-dgtable-0.5.2
- hie-bios-0.7.1
- implicit-hie-0.1.1.0
- implicit-hie-cradle-0.2.0.1
- fuzzy-0.1.0.0
- shake-0.18.5
- time-compat-1.9.2.2
- regex-base-0.94.0.0
- regex-tdfa-1.3.1.0
- parser-combinators-1.2.1
- haddock-library-1.8.0
- unordered-containers-0.2.10.0
- file-embed-0.0.11.2
- heaps-0.3.6.1
- ghc-check-0.5.0.1
- extra-1.7.2
# For tasty-retun
- ansi-terminal-0.10.3
- ansi-wl-pprint-0.6.9
- tasty-1.2.3
- tasty-rerun-1.1.17
# For benchHist
- Chart-1.9.3
- Chart-diagrams-1.9.3
# For hie-bios-0.7.1
- yaml-0.11.2.0
- libyaml-0.1.2
nix:
packages: [zlib]
ghc-options:
ghcide: -DSTACK

22
test/exe/Main.hs
View File

@ -1590,11 +1590,9 @@ fillTypedHoleTests = let
"_" "n" "n"
"globalConvert" "n" "n"
#if MIN_GHC_API_VERSION(8,6,0)
, check "replace _convertme with localConvert"
"_convertme" "n" "n"
"localConvert" "n" "n"
#endif
, check "replace _b with globalInt"
"_a" "_b" "_c"
@ -1604,14 +1602,12 @@ fillTypedHoleTests = let
"_a" "_b" "_c"
"_a" "_b" "globalInt"
#if MIN_GHC_API_VERSION(8,6,0)
, check "replace _c with parameterInt"
"_a" "_b" "_c"
"_a" "_b" "parameterInt"
, check "replace _ with foo _"
"_" "n" "n"
"(foo _)" "n" "n"
#endif
]
addInstanceConstraintTests :: TestTree
@ -2217,13 +2213,8 @@ findDefinitionAndHoverTests = let
outL45 = Position 49 3 ; outSig = [ExpectHoverText ["outer", "Bool"], mkR 46 0 46 5]
innL48 = Position 52 5 ; innSig = [ExpectHoverText ["inner", "Char"], mkR 49 2 49 7]
cccL17 = Position 17 11 ; docLink = [ExpectHoverText ["[Documentation](file:///"]]
#if MIN_GHC_API_VERSION(8,6,0)
imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3]
reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 0 3 14]
#else
imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo"], mkL foo 5 0 5 3]
reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar"], mkL bar 3 0 3 14]
#endif
in
mkFindTests
-- def hover look expect
@ -2306,7 +2297,7 @@ pluginSimpleTests =
pluginParsedResultTests :: TestTree
pluginParsedResultTests =
(`xfail84` "record-dot-preprocessor unsupported on 8.4") $ testSessionWait "parsedResultAction plugin" $ do
testSessionWait "parsedResultAction plugin" $ do
let content =
T.unlines
[ "{-# LANGUAGE DuplicateRecordFields, TypeApplications, FlexibleContexts, DataKinds, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}"
@ -2475,7 +2466,6 @@ thTests =
_ <- createDoc "A.hs" "haskell" sourceA
_ <- createDoc "B.hs" "haskell" sourceB
expectDiagnostics [ ( "B.hs", [(DsWarning, (4, 0), "Top-level binding with no type signature: main :: IO ()")] ) ]
#if MIN_GHC_API_VERSION(8,6,0)
, flip xfail "expect broken (#614)" $ testCase "findsTHnewNameConstructor" $ withoutStackEnv $ runWithExtraFiles "THNewName" $ \dir -> do
-- This test defines a TH value with the meaning "data A = A" in A.hs
@ -2487,7 +2477,6 @@ thTests =
let cPath = dir </> "C.hs"
_ <- openDoc cPath "haskell"
expectDiagnostics [ ( cPath, [(DsWarning, (3, 0), "Top-level binding with no type signature: a :: A")] ) ]
#endif
]
-- | test that TH is reevaluated on typecheck
@ -2954,13 +2943,6 @@ pattern R x y x' y' = Range (Position x y) (Position x' y')
xfail :: TestTree -> String -> TestTree
xfail = flip expectFailBecause
xfail84 :: TestTree -> String -> TestTree
#if MIN_GHC_API_VERSION(8,6,0)
xfail84 t _ = t
#else
xfail84 = flip expectFailBecause
#endif
expectFailCabal :: String -> TestTree -> TestTree
#ifdef STACK
expectFailCabal _ = id
@ -3253,10 +3235,8 @@ ifaceErrorTest = testCase "iface-error-test-1" $ withoutStackEnv $ runWithExtraF
ResponseMessage{_result=Right hidir} -> do
hi_exists <- doesFileExist $ hidir </> "B.hi"
assertBool ("Couldn't find B.hi in " ++ hidir) hi_exists
#if MIN_GHC_API_VERSION(8,6,0)
hie_exists <- doesFileExist $ hidir </> "B.hie"
assertBool ("Couldn't find B.hie in " ++ hidir) hie_exists
#endif
_ -> assertFailure $ "Got malformed response for CustomMessage hidir: " ++ show res
pdoc <- createDoc pPath "haskell" pSource