mirror of
https://github.com/digital-asset/daml.git
synced 2024-11-04 00:36:58 +03:00
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:
parent
2d2159cd0a
commit
68b0430284
@ -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:
|
||||||
|
@ -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,
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user