GHC 8.6 compat for the IDE (#955)

* I have no idea now LPat and Pat previously managed to unify...

* Avoid using unRealSrcSpan as its only introduced for GHC 8.8

* Add some CPP to permit compiling with GHC 8.6

* Permit CPP in one more place
This commit is contained in:
Neil Mitchell 2019-05-06 21:29:22 +01:00 committed by GitHub
parent 2d2159cd0a
commit 68b0430284
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 13 additions and 3 deletions

View File

@ -75,7 +75,7 @@
- {name: ViewPatterns, within: []} - {name: ViewPatterns, within: []}
# Shady extensions # Shady extensions
- {name: CPP, within: [DA.Sdk.Cli.System, DA.Sdk.Cli.Version, DAML.Assistant.Install.Path]} - {name: CPP, within: [DA.Sdk.Cli.System, DA.Sdk.Cli.Version, DAML.Assistant.Install.Path, Development.IDE.Functions.Compile]}
- {name: ImplicitParams, within: []} - {name: ImplicitParams, within: []}
- flags: - flags:

View File

@ -3,6 +3,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
-- | Based on https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/API. -- | Based on https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/API.
-- Given a list of paths to find libraries, and a file to compile, produce a list of 'CoreModule' values. -- Given a list of paths to find libraries, and a file to compile, produce a list of 'CoreModule' values.
@ -414,7 +415,9 @@ getModSummaryFromBuffer fp (contents, fileDate) dflags parsed = do
{ ml_hs_file = Just fp { ml_hs_file = Just fp
, ml_hi_file = replaceExtension fp "hi" , ml_hi_file = replaceExtension fp "hi"
, ml_obj_file = replaceExtension fp "o" , ml_obj_file = replaceExtension fp "o"
#ifndef USE_GHC
, ml_hie_file = replaceExtension fp "hie" , ml_hie_file = replaceExtension fp "hie"
#endif
-- This does not consider the dflags configuration -- This does not consider the dflags configuration
-- (-osuf and -hisuf, object and hi dir.s). -- (-osuf and -hisuf, object and hi dir.s).
-- However, we anyway don't want to generate them. -- However, we anyway don't want to generate them.
@ -433,7 +436,9 @@ getModSummaryFromBuffer fp (contents, fileDate) dflags parsed = do
, ms_hsc_src = HsSrcFile , ms_hsc_src = HsSrcFile
, ms_obj_date = Nothing , ms_obj_date = Nothing
, ms_iface_date = Nothing , ms_iface_date = Nothing
#ifndef USE_GHC
, ms_hie_date = Nothing , ms_hie_date = Nothing
#endif
, ms_srcimps = [] -- source imports are not allowed , ms_srcimps = [] -- source imports are not allowed
, ms_parsed_mod = Nothing , ms_parsed_mod = Nothing
} }
@ -450,8 +455,13 @@ parseFileContents preprocessor filename (time, contents) = do
let loc = mkRealSrcLoc (mkFastString filename) 1 1 let loc = mkRealSrcLoc (mkFastString filename) 1 1
dflags <- parsePragmasIntoDynFlags filename contents dflags <- parsePragmasIntoDynFlags filename contents
case unP Parser.parseModule (mkPState dflags contents loc) of case unP Parser.parseModule (mkPState dflags contents loc) of
#ifdef USE_GHC
PFailed getMessages _ _ ->
Ex.throwE $ toDiagnostics dflags $ snd $ getMessages dflags
#else
PFailed s -> PFailed s ->
Ex.throwE $ toDiagnostics dflags $ snd $ getMessages s dflags Ex.throwE $ toDiagnostics dflags $ snd $ getMessages s dflags
#endif
POk pst rdr_module -> POk pst rdr_module ->
let hpm_annotations = let hpm_annotations =
(Map.fromListWith (++) $ annotations pst, (Map.fromListWith (++) $ annotations pst,

View File

@ -80,7 +80,7 @@ getDocumentation targetName tcs = fromMaybe [] $ do
-- | Shows this part of the documentation -- | Shows this part of the documentation
docHeaders :: [RealLocated AnnotationComment] docHeaders :: [RealLocated AnnotationComment]
-> [T.Text] -> [T.Text]
docHeaders = mapMaybe (wrk . unRealSrcSpan) docHeaders = mapMaybe (\(L _ x) -> wrk x)
where where
wrk = \case wrk = \case
AnnDocCommentNext s -> Just $ T.pack s AnnDocCommentNext s -> Just $ T.pack s

View File

@ -36,7 +36,7 @@ getSpanInfo mods tcm =
do let tcs = tm_typechecked_source tcm do let tcs = tm_typechecked_source tcm
bs = listifyAllSpans tcs :: [LHsBind GhcTc] bs = listifyAllSpans tcs :: [LHsBind GhcTc]
es = listifyAllSpans tcs :: [LHsExpr GhcTc] es = listifyAllSpans tcs :: [LHsExpr GhcTc]
ps = listifyAllSpans' tcs :: [LPat GhcTc] ps = listifyAllSpans' tcs :: [Pat GhcTc]
bts <- mapM (getTypeLHsBind tcm) bs -- binds bts <- mapM (getTypeLHsBind tcm) bs -- binds
ets <- mapM (getTypeLHsExpr tcm) es -- expressions ets <- mapM (getTypeLHsExpr tcm) es -- expressions
pts <- mapM (getTypeLPat tcm) ps -- patterns pts <- mapM (getTypeLPat tcm) ps -- patterns