git.iko.soy/ghcide
on master help sign in
#2326, GHC 8.4 compatibility (#2796)

* #2326, GHC 8.4 compatibility * Fix up CI * Add a Shake lower bound * Upgrade to a hie-bios which is GHC 8.4 compatible * Add a GHC 8.4 stack * Fix HLint again

commit9bd78857d82183c62b4a2c41248237242b7c8fe2 authorNeil Mitchell <ndmitchell@gmail.com> dateSat 7 Sep 2019, 16:23 (7 years ago) parent710f48b
11 files changed+115−50
compare with master
unifiedsplit
exe/Main.hs+5−2 hie-core.cabal+2−2 src/Development/IDE/Core/Compile.hs+1−2 src/Development/IDE/GHC/CPP.hs+1 src/Development/IDE/GHC/Compat.hs+31−1 src/Development/IDE/GHC/Util.hs+8−3 src/Development/IDE/Import/FindImports.hs+21−24 src/Development/IDE/LSP/CodeAction.hs+2−2 src/Development/IDE/Spans/Calculate.hs+22−13 stack.yaml+1−1 stack84.yaml+21
exe/Main.hs+5−2
@@ -1,5 +1,6 @@
11-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22-- SPDX-License-Identifier: Apache-2.0
3+{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
34
45module Main(main) where
56
@@ -26,6 +27,8 @@ import qualified Data.Text as T
2627import qualified Data.Text.IO as T
2728import Language.Haskell.LSP.Messages
2829import Linker
30+import System.Info
31+import Data.Version
2932import Development.IDE.LSP.LanguageServer
3033import System.Directory.Extra as IO
3134import System.Environment
@@ -36,7 +39,7 @@ import qualified Data.Set as Set
3639-- import CmdLineParser
3740-- import DynFlags
3841-- import Panic
39−import GHC
42+import GHC hiding (def)
4043import qualified GHC.Paths
4144
4245import HIE.Bios
@@ -49,7 +52,7 @@ main :: IO ()
4952main = do
5053 -- WARNING: If you write to stdout before runLanguageServer
5154 -- then the language server will not work
52− hPutStrLn stderr "Starting hie-core"
55+ hPutStrLn stderr $ "Starting hie-core (GHC v" ++ showVersion compilerVersion ++ ")"
5356 Arguments{..} <- getArguments
5457
5558 -- lock to avoid overlapping output on stdout
hie-core.cabal+2−2
@@ -34,7 +34,7 @@ library
3434 filepath,
3535 ghc-boot-th,
3636 ghc-boot,
37− ghc >= 8.6,
37+ ghc >= 8.4,
3838 hashable,
3939 haskell-lsp-types,
4040 haskell-lsp,
@@ -45,7 +45,7 @@ library
4545 prettyprinter,
4646 rope-utf16-splay,
4747 safe-exceptions,
48− shake,
48+ shake >= 0.17.5,
4949 sorted-list,
5050 stm,
5151 syb,
src/Development/IDE/Core/Compile.hs+1−2
@@ -278,8 +278,7 @@ runCpp dflags filename contents = withTempDir $ \dir -> do
278278 -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)
279279
280280 -- Relative includes aren't going to work, so we fix that by adding to the include path.
281− let addSelf (IncludeSpecs quote global) = IncludeSpecs (takeDirectory filename : quote) global
282− dflags <- return dflags{includePaths = addSelf $ includePaths dflags}
281+ dflags <- return $ addIncludePathsQuote (takeDirectory filename) dflags
283282
284283 -- Location information is wrong, so we fix that by patching it afterwards.
285284 let inp = dir </> "___HIE_CORE_MAGIC___"
src/Development/IDE/GHC/CPP.hs+1
@@ -20,6 +20,7 @@
2020
2121module Development.IDE.GHC.CPP(doCpp) where
2222
23+import Development.IDE.GHC.Compat
2324import Packages
2425import SysTools
2526import Module
src/Development/IDE/GHC/Compat.hs+31−1
@@ -10,10 +10,16 @@ module Development.IDE.GHC.Compat(
1010 mkHieFile,
1111 writeHieFile,
1212 readHieFile,
13− hPutStringBuffer
13+ hPutStringBuffer,
14+ includePathsGlobal,
15+ includePathsQuote,
16+ addIncludePathsQuote,
17+ ghcEnumerateExtensions
1418 ) where
1519
1620import StringBuffer
21+import DynFlags
22+import GHC.LanguageExtensions.Type
1723
1824#ifndef GHC_STABLE
1925import HieAst
@@ -46,3 +52,27 @@ readHieFile _ _ = return (HieFileResult (HieFile () []), ())
4652data HieFile = HieFile {hie_module :: (), hie_exports :: [AvailInfo]}
4753data HieFileResult = HieFileResult { hie_file_result :: HieFile }
4854#endif
55+
56+#if __GLASGOW_HASKELL__ < 806
57+includePathsGlobal, includePathsQuote :: [String] -> [String]
58+includePathsGlobal = id
59+includePathsQuote = const []
60+#endif
61+
62+
63+addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
64+#if __GLASGOW_HASKELL__ >= 806
65+addIncludePathsQuote path x = x{includePaths = f $ includePaths x}
66+ where f i = i{includePathsQuote = path : includePathsQuote i}
67+#else
68+addIncludePathsQuote path x = x{includePaths = path : includePaths x}
69+#endif
70+
71+ghcEnumerateExtensions :: [Extension]
72+#if __GLASGOW_HASKELL__ >= 808
73+ghcEnumerateExtensions = enumerate
74+#elif __GLASGOW_HASKELL__ >= 806
75+ghcEnumerateExtensions = [Cpp .. StarIsType]
76+#else
77+ghcEnumerateExtensions = [Cpp .. EmptyDataDeriving]
78+#endif
src/Development/IDE/GHC/Util.hs+8−3
@@ -2,6 +2,7 @@
22-- SPDX-License-Identifier: Apache-2.0
33
44{-# OPTIONS_GHC -Wno-missing-fields #-} -- to enable prettyPrint
5+{-# LANGUAGE CPP #-}
56
67-- | GHC utility functions. Importantly, code using our GHC should never:
78--
@@ -20,7 +21,9 @@ module Development.IDE.GHC.Util(
2021
2122import Config
2223import Data.List.Extra
24+#if __GLASGOW_HASKELL__ >= 806
2325import Fingerprint
26+#endif
2427import GHC
2528import GhcMonad
2629import GhcPlugins
@@ -75,15 +78,17 @@ runGhcEnv env act = do
7578-- Fake DynFlags which are mostly undefined, but define enough to do a
7679-- little bit.
7780fakeDynFlags :: DynFlags
78−fakeDynFlags = defaultDynFlags settings ([], [])
81+fakeDynFlags = defaultDynFlags settings mempty
7982 where
8083 settings = Settings
8184 { sTargetPlatform = platform
8285 , sPlatformConstants = platformConstants
8386 , sProgramName = "ghc"
8487 , sProjectVersion = cProjectVersion
85− , sOpt_P_fingerprint = fingerprint0
86− }
88+#if __GLASGOW_HASKELL__ >= 806
89+ , sOpt_P_fingerprint = fingerprint0
90+#endif
91+ }
8792 platform = Platform
8893 { platformWordSize=8
8994 , platformOS=OSUnknown
src/Development/IDE/Import/FindImports.hs+21−24
@@ -1,6 +1,7 @@
11-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22-- SPDX-License-Identifier: Apache-2.0
33
4+{-# LANGUAGE CPP #-}
45
56module Development.IDE.Import.FindImports
67 ( locateModule
@@ -87,35 +88,31 @@ notFoundErr dfs modName reason =
8788 \case
8889 LookupFound _m _pkgConfig ->
8990 pprPanic "Impossible: called lookupToFind on found module." (ppr modName0)
90− LookupMultiple rs -> (FoundMultiple rs)
91+ LookupMultiple rs -> FoundMultiple rs
9192 LookupHidden pkg_hiddens mod_hiddens ->
92− (NotFound
93− { fr_paths = []
94− , fr_pkg = Nothing
95− , fr_pkgs_hidden = map (moduleUnitId . fst) pkg_hiddens
93+ notFound
94+ { fr_pkgs_hidden = map (moduleUnitId . fst) pkg_hiddens
9695 , fr_mods_hidden = map (moduleUnitId . fst) mod_hiddens
97− , fr_unusables = []
98− , fr_suggestions = []
99− })
96+ }
97+#if __GLASGOW_HASKELL__ >= 806
10098 LookupUnusable unusable ->
10199 let unusables' = map get_unusable unusable
102100 get_unusable (m, ModUnusable r) = (moduleUnitId m, r)
103101 get_unusable (_, r) =
104102 pprPanic "findLookupResult: unexpected origin" (ppr r)
105− in (NotFound
106− { fr_paths = []
107− , fr_pkg = Nothing
108− , fr_pkgs_hidden = []
109− , fr_mods_hidden = []
110− , fr_unusables = unusables'
111− , fr_suggestions = []
112− })
103+ in notFound {fr_unusables = unusables'}
104+#endif
113105 LookupNotFound suggest ->
114− (NotFound
115− { fr_paths = []
116− , fr_pkg = Nothing
117− , fr_pkgs_hidden = []
118− , fr_mods_hidden = []
119− , fr_unusables = []
120− , fr_suggestions = suggest
121− })
106+ notFound {fr_suggestions = suggest}
107+
108+notFound :: FindResult
109+notFound = NotFound
110+ { fr_paths = []
111+ , fr_pkg = Nothing
112+ , fr_pkgs_hidden = []
113+ , fr_mods_hidden = []
114+#if __GLASGOW_HASKELL__ >= 806
115+ , fr_unusables = []
116+#endif
117+ , fr_suggestions = []
118+ }
src/Development/IDE/LSP/CodeAction.hs+2−2
@@ -9,7 +9,7 @@ module Development.IDE.LSP.CodeAction
99 ) where
1010
1111import Language.Haskell.LSP.Types
12−import GHC.LanguageExtensions.Type
12+import Development.IDE.GHC.Compat
1313import Development.IDE.Core.Rules
1414import Development.IDE.LSP.Server
1515import qualified Data.HashMap.Strict as Map
@@ -80,7 +80,7 @@ suggestAction _ _ = []
8080
8181-- | All the GHC extensions
8282ghcExtensions :: Set.HashSet T.Text
83−ghcExtensions = Set.fromList $ map (T.pack . show) [Cpp .. StarIsType] -- use enumerate from GHC 8.8 and beyond
83+ghcExtensions = Set.fromList $ map (T.pack . show) ghcEnumerateExtensions
8484
8585
8686textAtPosition :: Position -> T.Text -> (T.Text, T.Text)
src/Development/IDE/Spans/Calculate.hs+22−13
@@ -3,6 +3,7 @@
33
44-- ORIGINALLY COPIED FROM https://github.com/commercialhaskell/intero
55
6+{-# LANGUAGE CPP #-}
67{-# LANGUAGE RankNTypes #-}
78
89-- | Get information on modules, identifiers, etc.
@@ -31,6 +32,14 @@ import Development.IDE.Core.Compile
3132import Development.IDE.GHC.Util
3233
3334
35+-- A lot of things gained an extra X argument in GHC 8.6, which we mostly ignore
36+-- this U ignores that arg in 8.6, but is hidden in 8.4
37+#if __GLASGOW_HASKELL__ >= 806
38+#define U _
39+#else
40+#define U
41+#endif
42+
3443-- | Get source span info, used for e.g. AtPoint and Goto Definition.
3544getSrcSpanInfos
3645 :: HscEnv
@@ -75,12 +84,12 @@ getExports m
7584 ]
7685getExports _ = []
7786
78−-- | Variant of GHC’s ieNames that produces LIdP instead of IdP
79−ieLNames :: IE pass -> [LIdP pass]
80−ieLNames (IEVar _ n ) = [ieLWrappedName n]
81−ieLNames (IEThingAbs _ n ) = [ieLWrappedName n]
82−ieLNames (IEThingAll _ n ) = [ieLWrappedName n]
83−ieLNames (IEThingWith _ n _ ns _) = ieLWrappedName n : map ieLWrappedName ns
87+-- | Variant of GHC's ieNames that produces LIdP instead of IdP
88+ieLNames :: IE pass -> [Located (IdP pass)]
89+ieLNames (IEVar U n ) = [ieLWrappedName n]
90+ieLNames (IEThingAbs U n ) = [ieLWrappedName n]
91+ieLNames (IEThingAll U n ) = [ieLWrappedName n]
92+ieLNames (IEThingWith U n _ ns _) = ieLWrappedName n : map ieLWrappedName ns
8493ieLNames _ = []
8594
8695-- | Get the name and type of a binding.
@@ -88,7 +97,7 @@ getTypeLHsBind :: (GhcMonad m)
8897 => TypecheckedModule
8998 -> LHsBind GhcTc
9099 -> m [(SpanSource, SrcSpan, Maybe Type)]
91−getTypeLHsBind _ (L _spn FunBind{fun_id = pid,fun_matches = MG _ _ _typ}) =
100+getTypeLHsBind _ (L _spn FunBind{fun_id = pid,fun_matches = MG{}}) =
92101 return [(Named $ getName (unLoc pid), getLoc pid, Just (varType (unLoc pid)))]
93102getTypeLHsBind _ _ = return []
94103
@@ -107,11 +116,11 @@ getTypeLHsExpr _ e = do
107116 Nothing -> Nothing
108117 where
109118 getSpanSource :: HsExpr GhcTc -> SpanSource
110− getSpanSource (HsVar _ (L _ i)) = Named (getName i)
111− getSpanSource (HsConLikeOut _ (RealDataCon dc)) = Named (dataConName dc)
119+ getSpanSource (HsVar U (L _ i)) = Named (getName i)
120+ getSpanSource (HsConLikeOut U (RealDataCon dc)) = Named (dataConName dc)
112121 getSpanSource RecordCon {rcon_con_name} = Named (getName rcon_con_name)
113− getSpanSource (HsWrap _ _ xpr) = getSpanSource xpr
114− getSpanSource (HsPar _ xpr) = getSpanSource (unLoc xpr)
122+ getSpanSource (HsWrap U _ xpr) = getSpanSource xpr
123+ getSpanSource (HsPar U xpr) = getSpanSource (unLoc xpr)
115124 getSpanSource _ = NoSource
116125
117126-- | Get the name and type of a pattern.
@@ -124,7 +133,7 @@ getTypeLPat _ pat =
124133 return $ Just (src, spn, Just (hsPatType pat))
125134 where
126135 getSpanSource :: Pat GhcTc -> (SpanSource, SrcSpan)
127− getSpanSource (VarPat _ (L spn vid)) = (Named (getName vid), spn)
136+ getSpanSource (VarPat U (L spn vid)) = (Named (getName vid), spn)
128137 getSpanSource (ConPatOut (L spn (RealDataCon dc)) _ _ _ _ _ _) =
129138 (Named (dataConName dc), spn)
130139 getSpanSource _ = (NoSource, noSrcSpan)
@@ -134,7 +143,7 @@ getLHsType
134143 => TypecheckedModule
135144 -> LHsType GhcRn
136145 -> m [(SpanSource, SrcSpan, Maybe Type)]
137−getLHsType _ (L spn (HsTyVar _ _ v)) = pure [(Named $ unLoc v, spn, Nothing)]
146+getLHsType _ (L spn (HsTyVar U _ v)) = pure [(Named $ unLoc v, spn, Nothing)]
138147getLHsType _ _ = pure []
139148
140149importInfo :: [(Located ModuleName, Maybe NormalizedFilePath)]
stack.yaml+1−1
@@ -11,7 +11,7 @@ extra-deps:
1111- git: https://github.com/bubba/lsp-test.git
1212 commit: d126623dc6895d325e3d204d74e2a22d4f515587
1313- git: https://github.com/mpickering/hie-bios.git
14− commit: 7a75f520b2e7a482440edd023be8e267a0fa153f
14+ commit: 89e4ba24f87aac9909d9814b0e8c51b679a0ccd4
1515nix:
1616 packages: [zlib]
1717allow-newer: true
stack84.yamlnew file+21
@@ -0,0 +1,21 @@
1+resolver: lts-12.26
2+packages:
3+- .
4+
5+extra-deps:
6+- rope-utf16-splay-0.3.1.0
7+- shake-0.18.3
8+- filepattern-0.1.1
9+- js-dgtable-0.5.2
10+- git: https://github.com/alanz/haskell-lsp.git
11+ commit: bfbd8630504ebc57b70948689c37b85cfbe589da
12+ subdirs:
13+ - .
14+ - haskell-lsp-types
15+- git: https://github.com/bubba/lsp-test.git
16+ commit: d126623dc6895d325e3d204d74e2a22d4f515587
17+- git: https://github.com/mpickering/hie-bios.git
18+ commit: 89e4ba24f87aac9909d9814b0e8c51b679a0ccd4
19+nix:
20+ packages: [zlib]
21+allow-newer: true