87c68e1 · ghcide · git.iko.soy

git.iko.soy/ghcide

ghcide: support hs-boot files (#2827)

commit87c68e102987fe86cf18455576b2fa918450ab77 authorGanesh Sittampalam <ganesh@earth.li> dateTue 10 Sep 2019, 10:35 (7 years ago) parent6176093

5 files changed+80−24

compare with master

unifiedsplit

extension/package.json+2−1 src/Development/IDE/Core/Compile.hs+22−16 src/Development/IDE/Core/Rules.hs+3−3 src/Development/IDE/Import/FindImports.hs+12−4 test/exe/Main.hs+41

extension/package.json+2−1

@@ -22,7 +22,8 @@

2222 "languages": [{

2323 "id": "haskell",

2424 "extensions": [

25− "hs"

25+ "hs",

26+ "hs-boot"

2627 ]

2728 }],

2829 "configuration": {

src/Development/IDE/Core/Compile.hs+22−16

@@ -45,6 +45,8 @@ import qualified GHC.LanguageExtensions as LangExt

4545import Control.Monad.Extra

4646import Control.Monad.Except

4747import Control.Monad.Trans.Except

48+import Data.Function

49+import Data.Ord

4850import qualified Data.Text as T

4951import Data.IORef

5052import Data.List.Extra

@@ -149,7 +151,12 @@ mkTcModuleResult tcm = do

149151-- | Setup the environment that GHC needs according to our

150152-- best understanding (!)

151153setupEnv :: GhcMonad m => [TcModuleResult] -> m ()

152−setupEnv tms = do

154+setupEnv tmsIn = do

155+ -- if both a .hs-boot file and a .hs file appear here, we want to make sure that the .hs file

156+ -- takes precedence, so put the .hs-boot file earlier in the list

157+ let isSourceFile = (==HsBootFile) . ms_hsc_src . pm_mod_summary . tm_parsed_module . tmrModule

158+ tms = sortBy (compare `on` Down . isSourceFile) tmsIn

159+

153160 session <- getSession

154161

155162 let mss = map (pm_mod_summary . tm_parsed_module . tmrModule) tms

@@ -191,24 +198,17 @@ loadModuleHome tmr = modifySession $ \e ->

191198-- name and its imports.

192199getImportsParsed :: DynFlags ->

193200 GHC.ParsedSource ->

194− Either [FileDiagnostic] (GHC.ModuleName, [(Maybe FastString, Located GHC.ModuleName)])

201+ Either [FileDiagnostic] (GHC.ModuleName, [(Bool, (Maybe FastString, Located GHC.ModuleName))])

195202getImportsParsed dflags (L loc parsed) = do

196203 let modName = maybe (GHC.mkModuleName "Main") GHC.unLoc $ GHC.hsmodName parsed

197204

198− -- refuse source imports

199− let srcImports = filter (ideclSource . GHC.unLoc) $ GHC.hsmodImports parsed

200− when (not $ null srcImports) $ Left $

201− concat

202− [ diagFromString "imports" mloc ("Illegal source import of " <> GHC.moduleNameString (GHC.unLoc $ GHC.ideclName i))

203− | L mloc i <- srcImports ]

204−

205205 -- most of these corner cases are also present in https://hackage.haskell.org/package/ghc-8.6.1/docs/src/HeaderInfo.html#getImports

206206 -- but we want to avoid parsing the module twice

207207 let implicit_prelude = xopt GHC.ImplicitPrelude dflags

208208 implicit_imports = Hdr.mkPrelImports modName loc implicit_prelude $ GHC.hsmodImports parsed

209209

210210 -- filter out imports that come from packages

211− return (modName, [(fmap sl_fs $ ideclPkgQual i, ideclName i)

211+ return (modName, [(ideclSource i, (fmap sl_fs $ ideclPkgQual i, ideclName i))

212212 | i <- map GHC.unLoc $ implicit_imports ++ GHC.hsmodImports parsed

213213 , GHC.moduleNameString (GHC.unLoc $ ideclName i) /= "GHC.Prim"

214214 ])

@@ -227,10 +227,10 @@ getModSummaryFromBuffer fp contents dflags parsed = do

227227

228228 let modLoc = ModLocation

229229 { ml_hs_file = Just fp

230− , ml_hi_file = replaceExtension fp "hi"

231− , ml_obj_file = replaceExtension fp "o"

230+ , ml_hi_file = derivedFile "hi"

231+ , ml_obj_file = derivedFile "o"

232232#ifndef GHC_STABLE

233− , ml_hie_file = replaceExtension fp "hie"

233+ , ml_hie_file = derivedFile "hie"

234234#endif

235235 -- This does not consider the dflags configuration

236236 -- (-osuf and -hisuf, object and hi dir.s).

@@ -245,21 +245,27 @@ getModSummaryFromBuffer fp contents dflags parsed = do

245245 -- To avoid silent issues where something is not processed because the date

246246 -- has not changed, we make sure that things blow up if they depend on the

247247 -- date.

248− , ms_textual_imps = imports

248+ , ms_textual_imps = [imp | (False, imp) <- imports]

249249 , ms_hspp_file = fp

250250 , ms_hspp_opts = dflags

251251 , ms_hspp_buf = Just contents

252252

253253 -- defaults:

254− , ms_hsc_src = HsSrcFile

254+ , ms_hsc_src = sourceType

255255 , ms_obj_date = Nothing

256256 , ms_iface_date = Nothing

257257#ifndef GHC_STABLE

258258 , ms_hie_date = Nothing

259259#endif

260− , ms_srcimps = [] -- source imports are not allowed

260+ , ms_srcimps = [imp | (True, imp) <- imports]

261261 , ms_parsed_mod = Nothing

262262 }

263+ where

264+ (sourceType, derivedFile) =

265+ let (stem, ext) = splitExtension fp in

266+ if "-boot" `isSuffixOf` ext

267+ then (HsBootFile, \newExt -> stem <.> newExt ++ "-boot")

268+ else (HsSrcFile , \newExt -> stem <.> newExt)

263269

264270-- | Run CPP on a file

265271runCpp :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer

src/Development/IDE/Core/Rules.hs+3−3

@@ -183,12 +183,12 @@ getLocatedImportsRule =

183183 define $ \GetLocatedImports file -> do

184184 pm <- use_ GetParsedModule file

185185 let ms = pm_mod_summary pm

186− let imports = ms_textual_imps ms

186+ let imports = [(False, imp) | imp <- ms_textual_imps ms] ++ [(True, imp) | imp <- ms_srcimps ms]

187187 env <- useNoFile_ GhcSession

188188 let dflags = addRelativeImport pm $ hsc_dflags env

189189 opt <- getIdeOptions

190− (diags, imports') <- fmap unzip $ forM imports $ \(mbPkgName, modName) -> do

191− diagOrImp <- locateModule dflags (optExtensions opt) getFileExists modName mbPkgName

190+ (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do

191+ diagOrImp <- locateModule dflags (optExtensions opt) getFileExists modName mbPkgName isSource

192192 case diagOrImp of

193193 Left diags -> pure (diags, Left (modName, Nothing))

194194 Right (FileImport path) -> pure ([], Left (modName, Just path))

src/Development/IDE/Import/FindImports.hs+12−4

@@ -42,11 +42,18 @@ locateModuleFile :: MonadIO m

4242 => DynFlags

4343 -> [String]

4444 -> (NormalizedFilePath -> m Bool)

45+ -> Bool

4546 -> ModuleName

4647 -> m (Maybe NormalizedFilePath)

47−locateModuleFile dflags exts doesExist modName = do

48− let candidates = [ toNormalizedFilePath (prefix </> M.moduleNameSlashes modName <.> ext) | prefix <- importPaths dflags, ext <- exts]

48+locateModuleFile dflags exts doesExist isSource modName = do

49+ let candidates =

50+ [ toNormalizedFilePath (prefix </> M.moduleNameSlashes modName <.> maybeBoot ext)

51+ | prefix <- importPaths dflags, ext <- exts]

4952 findM doesExist candidates

53+ where

54+ maybeBoot ext

55+ | isSource = ext ++ "-boot"

56+ | otherwise = ext

5057

5158-- | locate a module in either the file system or the package database. Where we go from *daml to

5259-- Haskell

@@ -57,15 +64,16 @@ locateModule

5764 -> (NormalizedFilePath -> m Bool)

5865 -> Located ModuleName

5966 -> Maybe FastString

67+ -> Bool

6068 -> m (Either [FileDiagnostic] Import)

61−locateModule dflags exts doesExist modName mbPkgName = do

69+locateModule dflags exts doesExist modName mbPkgName isSource = do

6270 case mbPkgName of

6371 -- if a package name is given we only go look for a package

6472 Just _pkgName -> lookupInPackageDB dflags

6573 Nothing -> do

6674 -- first try to find the module as a file. If we can't find it try to find it in the package

6775 -- database.

68− mbFile <- locateModuleFile dflags exts doesExist $ unLoc modName

76+ mbFile <- locateModuleFile dflags exts doesExist isSource $ unLoc modName

6977 case mbFile of

7078 Nothing -> lookupInPackageDB dflags

7179 Just file -> return $ Right $ FileImport file

test/exe/Main.hs+41

@@ -125,6 +125,47 @@ diagnosticTests = testGroup "diagnostics"

125125 , [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]

126126 )

127127 ]

128+ , testSession "cyclic module dependency with hs-boot" $ do

129+ let contentA = T.unlines

130+ [ "module ModuleA where"

131+ , "import {-# SOURCE #-} ModuleB"

132+ ]

133+ let contentB = T.unlines

134+ [ "module ModuleB where"

135+ , "import ModuleA"

136+ ]

137+ let contentBboot = T.unlines

138+ [ "module ModuleB where"

139+ ]

140+ _ <- openDoc' "ModuleA.hs" "haskell" contentA

141+ _ <- openDoc' "ModuleB.hs" "haskell" contentB

142+ _ <- openDoc' "ModuleB.hs-boot" "haskell" contentBboot

143+ expectDiagnostics []

144+ , testSession "correct reference used with hs-boot" $ do

145+ let contentB = T.unlines

146+ [ "module ModuleB where"

147+ , "import {-# SOURCE #-} ModuleA"

148+ ]

149+ let contentA = T.unlines

150+ [ "module ModuleA where"

151+ , "import ModuleB"

152+ , "x = 5"

153+ ]

154+ let contentAboot = T.unlines

155+ [ "module ModuleA where"

156+ ]

157+ let contentC = T.unlines

158+ [ "module ModuleC where"

159+ , "import ModuleA"

160+ -- this reference will fail if it gets incorrectly

161+ -- resolved to the hs-boot file

162+ , "y = x"

163+ ]

164+ _ <- openDoc' "ModuleB.hs" "haskell" contentB

165+ _ <- openDoc' "ModuleA.hs" "haskell" contentA

166+ _ <- openDoc' "ModuleA.hs-boot" "haskell" contentAboot

167+ _ <- openDoc' "ModuleC.hs" "haskell" contentC

168+ expectDiagnostics []

128169 , testSession "redundant import" $ do

129170 let contentA = T.unlines ["module ModuleA where"]

130171 let contentB = T.unlines