Skip to content

Commit bf06abd

Browse files
fendorfendor
committed
Update plugins to use GHC API Compat modules
1 parent 4268719 commit bf06abd

File tree

77 files changed

+951
-747
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

77 files changed

+951
-747
lines changed

‎cabal-ghc901.project

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -64,10 +64,10 @@ source-repository-package
6464

6565
source-repository-package
6666
type: git
67-
location: https://github.com/anka-213/dependent-sum
68-
tag: 8cf4c7fbc3bfa2be475a17bb7c94a1e1e9a830b5
67+
location: https://github.com/fendor/dependent-sum
68+
tag: 5de03c38b0de4945f4e9bce1b026110e69dc8118
6969
subdir: dependent-sum-template
70-
-- https://github.com/obsidiansystems/dependent-sum/pull/57
70+
-- https://github.com/obsidiansystems/dependent-sum/pull/59
7171

7272
-- benchmark dependency
7373
source-repository-package

‎cabal-ghc921.project

Lines changed: 21 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ packages:
2323
./plugins/hls-module-name-plugin
2424
./plugins/hls-ormolu-plugin
2525
./plugins/hls-call-hierarchy-plugin
26-
../../../head.hackage/packages/th-extras-0.0.0.4
2726

2827
tests: true
2928

@@ -44,18 +43,26 @@ source-repository-package
4443
tag: b6245884ae83e00dd2b5261762549b37390179f8
4544
-- https://github.com/lspitzner/czipwith/pull/2
4645

47-
source-repository-package
48-
type: git
49-
location: https://github.com/alanz/ghc-exactprint
50-
tag: 9f20a4e880b9e81369e0d2024e60ae02c158c57c
51-
-- https://github.com/alanz/ghc-exactprint/pull/101
52-
5346
-- benchmark dependency
5447
source-repository-package
5548
type: git
5649
location: https://github.com/HeinrichApfelmus/operational
5750
tag: 16e19aaf34e286f3d27b3988c61040823ec66537
5851

52+
source-repository-package
53+
type: git
54+
location: https://github.com/anka-213/th-extras
55+
tag: 57a97b4df128eb7b360e8ab9c5759392de8d1659
56+
-- https://github.com/mokus0/th-extras/pull/8
57+
-- https://github.com/mokus0/th-extras/issues/7
58+
59+
source-repository-package
60+
type: git
61+
location: https://github.com/fendor/dependent-sum
62+
tag: 5de03c38b0de4945f4e9bce1b026110e69dc8118
63+
subdir: dependent-sum-template
64+
-- https://github.com/obsidiansystems/dependent-sum/pull/59
65+
5966
-- Head of hie-bios
6067
source-repository-package
6168
type: git
@@ -68,6 +75,13 @@ source-repository-package
6875
location: https://github.com/wz1000/HieDb
6976
tag: 45c4671db2da8ce5cd11e964573846cfbf3bbec8
7077

78+
-- GHC 9.2 for ghc-check
79+
source-repository-package
80+
type: git
81+
location: https://github.com/fendor/ghc-check
82+
tag: 224f3901eaa1b32a27e097968afd4a3894efa77e
83+
-- https://github.com/pepeiborra/ghc-check/pull/14/files
84+
7185
write-ghc-environment-files: never
7286

7387
index-state: 2021-08-17T02:21:16Z

‎ghcide/ghcide.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -162,6 +162,7 @@ library
162162
Development.IDE.GHC.Compat.Parser
163163
Development.IDE.GHC.Compat.Plugins
164164
Development.IDE.GHC.Compat.Units
165+
Development.IDE.GHC.Compat.Util
165166
Development.IDE.Core.Compile
166167
Development.IDE.GHC.Error
167168
Development.IDE.GHC.ExactPrint

‎ghcide/session-loader/Development/IDE/Session.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ module Development.IDE.Session
1919

2020
import Control.Concurrent.Async
2121
import Control.Concurrent.Strict
22-
import Control.Exception.Safe
22+
import Control.Exception.Safe as Safe
2323
import Control.Monad
2424
import Control.Monad.Extra
2525
import Control.Monad.IO.Class
@@ -170,7 +170,7 @@ runWithDb :: FilePath -> (HieDb -> IndexQueue -> IO ()) -> IO ()
170170
runWithDb fp k = do
171171
-- Delete the database if it has an incompatible schema version
172172
withHieDb fp (const $ pure ())
173-
`catch` \IncompatibleSchemaVersion{} -> removeFile fp
173+
`Safe.catch` \IncompatibleSchemaVersion{} -> removeFile fp
174174
withHieDb fp $ \writedb -> do
175175
initConn writedb
176176
chan <- newTQueueIO
@@ -184,9 +184,9 @@ runWithDb fp k = do
184184
forever $ do
185185
k <- atomically $ readTQueue chan
186186
k db
187-
`catch` \e@SQLError{} -> do
187+
`Safe.catch` \e@SQLError{} -> do
188188
hPutStrLn stderr $ "SQLite error in worker, ignoring: " ++ show e
189-
`catchAny` \e -> do
189+
`Safe.catchAny` \e -> do
190190
hPutStrLn stderr $ "Uncaught error in database worker, ignoring: " ++ show e
191191

192192

@@ -479,7 +479,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
479479
ncfp <- toNormalizedFilePath' <$> canonicalizePath file
480480
cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap
481481
hieYaml <- cradleLoc file
482-
sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `catch` \e ->
482+
sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e ->
483483
return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml)
484484

485485
returnWithVersion $ \file -> do
@@ -730,7 +730,7 @@ getDependencyInfo fs = Map.fromList <$> mapM do_one fs
730730

731731
where
732732
tryIO :: IO a -> IO (Either IOException a)
733-
tryIO = try
733+
tryIO = Safe.try
734734

735735
do_one :: FilePath -> IO (FilePath, Maybe UTCTime)
736736
do_one fp = (fp,) . eitherToMaybe <$> tryIO (getModificationTime fp)

‎ghcide/src/Development/IDE/Core/Compile.hs

Lines changed: 21 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -44,11 +44,13 @@ import Development.IDE.Types.Diagnostics
4444
import Development.IDE.Types.Location
4545
import Development.IDE.Types.Options
4646

47+
import Development.IDE.GHC.Compat.Outputable
4748
import Development.IDE.GHC.Compat hiding (writeHieFile,
4849
parseModule,
4950
loadInterface,
5051
parseHeader)
5152
import qualified Development.IDE.GHC.Compat as Compat
53+
import qualified Development.IDE.GHC.Compat.Util as Util
5254
import qualified Development.IDE.GHC.Compat as GHC
5355

5456
import HieDb
@@ -455,16 +457,16 @@ generateHieAsts hscEnv tcm =
455457
-- These varBinds use unitDataConId but it could be anything as the id name is not used
456458
-- during the hie file generation process. It's a workaround for the fact that the hie modules
457459
-- don't export an interface which allows for additional information to be added to hie files.
458-
let fake_splice_binds = listToBag (map (mkVarBind unitDataConId) (spliceExpresions $ tmrTopLevelSplices tcm))
460+
let fake_splice_binds = Util.listToBag (map (mkVarBind unitDataConId) (spliceExpresions $ tmrTopLevelSplices tcm))
459461
real_binds = tcg_binds $ tmrTypechecked tcm
460462
#if MIN_VERSION_ghc(9,0,1)
461463
ts = tmrTypechecked tcm :: TcGblEnv
462-
top_ev_binds = tcg_ev_binds ts :: Bag EvBind
464+
top_ev_binds = tcg_ev_binds ts :: Util.Bag EvBind
463465
insts = tcg_insts ts :: [ClsInst]
464466
tcs = tcg_tcs ts :: [TyCon]
465-
Just <$> GHC.enrichHie (fake_splice_binds `unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs
467+
Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs
466468
#else
467-
Just <$> GHC.enrichHie (fake_splice_binds `unionBags` real_binds) (tmrRenamed tcm)
469+
Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm)
468470
#endif
469471
where
470472
dflags = hsc_dflags hscEnv
@@ -507,7 +509,7 @@ spliceExpresions Splices{..} =
507509
-- TVar to 0 in order to set it up for a fresh indexing session. Otherwise, we
508510
-- can just increment the 'indexCompleted' TVar and exit.
509511
--
510-
indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Fingerprint -> Compat.HieFile -> IO ()
512+
indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Util.Fingerprint -> Compat.HieFile -> IO ()
511513
indexHieFile se mod_summary srcPath !hash hf = do
512514
IdeOptions{optProgressStyle} <- getIdeOptionsIO se
513515
atomically $ do
@@ -614,7 +616,7 @@ writeAndIndexHieFile hscEnv se mod_summary srcPath exports ast source =
614616
hf <- runHsc hscEnv $
615617
GHC.mkHieFile' mod_summary exports ast source
616618
atomicFileWrite targetPath $ flip GHC.writeHieFile hf
617-
hash <- getFileHash targetPath
619+
hash <- Util.getFileHash targetPath
618620
indexHieFile se mod_summary srcPath hash hf
619621
where
620622
dflags = hsc_dflags hscEnv
@@ -698,7 +700,7 @@ getModSummaryFromImports
698700
:: HscEnv
699701
-> FilePath
700702
-> UTCTime
701-
-> Maybe StringBuffer
703+
-> Maybe Util.StringBuffer
702704
-> ExceptT [FileDiagnostic] IO ModSummaryResult
703705
getModSummaryFromImports env fp modTime contents = do
704706
(contents, opts, dflags) <- preprocessor env fp contents
@@ -710,7 +712,7 @@ getModSummaryFromImports env fp modTime contents = do
710712
let mb_mod = hsmodName hsmod
711713
imps = hsmodImports hsmod
712714

713-
mod = fmap unLoc mb_mod `orElse` mAIN_NAME
715+
mod = fmap unLoc mb_mod `Util.orElse` mAIN_NAME
714716

715717
(src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource.unLoc) imps
716718

@@ -765,29 +767,29 @@ getModSummaryFromImports env fp modTime contents = do
765767
-- eliding the timestamps, the preprocessed source and other non relevant fields
766768
computeFingerprint opts ModSummary{..} = do
767769
fingerPrintImports <- fingerprintFromPut $ do
768-
put $ uniq $ moduleNameFS $ moduleName ms_mod
770+
put $ Util.uniq $ moduleNameFS $ moduleName ms_mod
769771
forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do
770-
put $ uniq $ moduleNameFS $ unLoc m
771-
whenJust mb_p $ put . uniq
772-
return $! fingerprintFingerprints $
773-
[ fingerprintString fp
772+
put $ Util.uniq $ moduleNameFS $ unLoc m
773+
whenJust mb_p $ put . Util.uniq
774+
return $! Util.fingerprintFingerprints $
775+
[ Util.fingerprintString fp
774776
, fingerPrintImports
775-
] ++ map fingerprintString opts
777+
] ++ map Util.fingerprintString opts
776778

777779

778780
-- | Parse only the module header
779781
parseHeader
780782
:: Monad m
781783
=> DynFlags -- ^ flags to use
782784
-> FilePath -- ^ the filename (for source locations)
783-
-> StringBuffer -- ^ Haskell module source text (full Unicode is supported)
785+
-> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
784786
#if MIN_VERSION_ghc(9,0,1)
785787
-> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule))
786788
#else
787789
-> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))
788790
#endif
789791
parseHeader dflags filename contents = do
790-
let loc = mkRealSrcLoc (mkFastString filename) 1 1
792+
let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1
791793
case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of
792794
#if MIN_VERSION_ghc(8,10,0)
793795
PFailed pst ->
@@ -823,7 +825,7 @@ parseFileContents
823825
-> ModSummary
824826
-> ExceptT [FileDiagnostic] IO ([FileDiagnostic], ParsedModule)
825827
parseFileContents env customPreprocessor filename ms = do
826-
let loc = mkRealSrcLoc (mkFastString filename) 1 1
828+
let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1
827829
dflags = ms_hspp_opts ms
828830
contents = fromJust $ ms_hspp_buf ms
829831
case unP Compat.parseModule (initParserState (initParserOpts dflags) contents loc) of
@@ -875,7 +877,7 @@ parseFileContents env customPreprocessor filename ms = do
875877
$ filter (/= n_hspp)
876878
$ map normalise
877879
$ filter (not . isPrefixOf "<")
878-
$ map unpackFS
880+
$ map Util.unpackFS
879881
$ srcfiles pst
880882
srcs1 = case ml_hs_file (ms_location ms) of
881883
Just f -> filter (/= normalise f) srcs0
@@ -980,7 +982,7 @@ getDocsBatch hsc_env _mod _names = do
980982
UnhelpfulLoc {} -> True
981983

982984
fakeSpan :: RealSrcSpan
983-
fakeSpan = realSrcLocSpan $ mkRealSrcLoc (fsLit "<ghcide>") 1 1
985+
fakeSpan = realSrcLocSpan $ mkRealSrcLoc (Util.fsLit "<ghcide>") 1 1
984986

985987
-- | Non-interactive, batch version of 'InteractiveEval.lookupNames'.
986988
-- The interactive paths create problems in ghc-lib builds

‎ghcide/src/Development/IDE/Core/Preprocessor.hs

Lines changed: 15 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@ module Development.IDE.Core.Preprocessor
77

88
import Development.IDE.GHC.CPP
99
import Development.IDE.GHC.Compat
10+
import Development.IDE.GHC.Compat.Outputable
11+
import qualified Development.IDE.GHC.Compat.Util as Util
1012
import Development.IDE.GHC.Orphans ()
1113

1214
import Control.DeepSeq (NFData (rnf))
@@ -30,15 +32,15 @@ import System.IO.Extra
3032

3133
-- | Given a file and some contents, apply any necessary preprocessors,
3234
-- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies.
33-
preprocessor :: HscEnv -> FilePath -> Maybe StringBuffer -> ExceptT [FileDiagnostic] IO (StringBuffer, [String], DynFlags)
35+
preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], DynFlags)
3436
preprocessor env0 filename mbContents = do
3537
-- Perform unlit
3638
(isOnDisk, contents) <-
3739
if isLiterate filename then do
3840
newcontent <- liftIO $ runLhs env0 filename mbContents
3941
return (False, newcontent)
4042
else do
41-
contents <- liftIO $ maybe (hGetStringBuffer filename) return mbContents
43+
contents <- liftIO $ maybe (Util.hGetStringBuffer filename) return mbContents
4244
let isOnDisk = isNothing mbContents
4345
return (isOnDisk, contents)
4446

@@ -56,7 +58,7 @@ preprocessor env0 filename mbContents = do
5658
$ (Right <$> (runCpp (putLogHook newLogger env1) filename
5759
$ if isOnDisk then Nothing else Just contents))
5860
`catch`
59-
( \(e :: GhcException) -> do
61+
( \(e :: Util.GhcException) -> do
6062
logs <- readIORef cppLogs
6163
case diagsFromCPPLogs filename (reverse logs) of
6264
[] -> throw e
@@ -129,7 +131,7 @@ isLiterate x = takeExtension x `elem` [".lhs",".lhs-boot"]
129131
parsePragmasIntoDynFlags
130132
:: HscEnv
131133
-> FilePath
132-
-> StringBuffer
134+
-> Util.StringBuffer
133135
-> IO (Either [FileDiagnostic] ([String], DynFlags))
134136
parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do
135137
let opts = getOptions dflags0 contents fp
@@ -143,7 +145,7 @@ parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do
143145
where dflags0 = hsc_dflags env
144146

145147
-- | Run (unlit) literate haskell preprocessor on a file, or buffer if set
146-
runLhs :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer
148+
runLhs :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
147149
runLhs env filename contents = withTempDir $ \dir -> do
148150
let fout = dir </> takeFileName filename <.> "unlit"
149151
filesrc <- case contents of
@@ -154,7 +156,7 @@ runLhs env filename contents = withTempDir $ \dir -> do
154156
hPutStringBuffer h cnts
155157
return fsrc
156158
unlit filesrc fout
157-
hGetStringBuffer fout
159+
Util.hGetStringBuffer fout
158160
where
159161
logger = hsc_logger env
160162
dflags = hsc_dflags env
@@ -173,10 +175,10 @@ runLhs env filename contents = withTempDir $ \dir -> do
173175
escape [] = []
174176

175177
-- | Run CPP on a file
176-
runCpp :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer
178+
runCpp :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
177179
runCpp env0 filename contents = withTempDir $ \dir -> do
178180
let out = dir </> takeFileName filename <.> "out"
179-
dflags1 <- pure $ addOptP "-D__GHCIDE__" (hsc_dflags env0)
181+
let dflags1 = addOptP "-D__GHCIDE__" (hsc_dflags env0)
180182
let env1 = hscSetFlags dflags1 env0
181183

182184
case contents of
@@ -185,14 +187,14 @@ runCpp env0 filename contents = withTempDir $ \dir -> do
185187
-- which also makes things like relative #include files work
186188
-- and means location information is correct
187189
doCpp env1 True filename out
188-
liftIO $ hGetStringBuffer out
190+
liftIO $ Util.hGetStringBuffer out
189191

190192
Just contents -> do
191193
-- Sad path, we have to create a version of the path in a temp dir
192194
-- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)
193195

194196
-- Relative includes aren't going to work, so we fix that by adding to the include path.
195-
dflags2 <- return $ addIncludePathsQuote (takeDirectory filename) dflags1
197+
let dflags2 = addIncludePathsQuote (takeDirectory filename) dflags1
196198
let env2 = hscSetFlags dflags2 env0
197199
-- Location information is wrong, so we fix that by patching it afterwards.
198200
let inp = dir </> "___GHCIDE_MAGIC___"
@@ -210,11 +212,11 @@ runCpp env0 filename contents = withTempDir $ \dir -> do
210212
-- and GHC gets all confused
211213
= "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\""
212214
| otherwise = x
213-
stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out
215+
Util.stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out
214216

215217

216218
-- | Run a preprocessor on a file
217-
runPreprocessor :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer
219+
runPreprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
218220
runPreprocessor env filename contents = withTempDir $ \dir -> do
219221
let out = dir </> takeFileName filename <.> "out"
220222
inp <- case contents of
@@ -225,7 +227,7 @@ runPreprocessor env filename contents = withTempDir $ \dir -> do
225227
hPutStringBuffer h contents
226228
return inp
227229
runPp logger dflags [Option filename, Option inp, FileOption "" out]
228-
hGetStringBuffer out
230+
Util.hGetStringBuffer out
229231
where
230232
logger = hsc_logger env
231233
dflags = hsc_dflags env

‎ghcide/src/Development/IDE/Core/RuleTypes.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ import Data.Time.Clock.POSIX
2525
import Data.Typeable
2626
import Development.IDE.GHC.Compat hiding
2727
(HieFileResult)
28+
import Development.IDE.GHC.Compat.Util
2829
import Development.IDE.GHC.Util
2930
import Development.IDE.Graph
3031
import Development.IDE.Import.DependencyInformation

0 commit comments

Comments
 (0)