git.iko.soy/ghcide
on 116a5ba help sign in
ghcide/src/Development/IDE/Import/FindImports.hs
153 lines 5.3 kB history raw
1-- Copyright (c) 2019 The DAML Authors. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4{-# LANGUAGE CPP #-}
5#include "ghc-api-version.h"
7module Development.IDE.Import.FindImports
8 ( locateModule
9 , Import(..)
10 , ArtifactsLocation(..)
11 , isBootLocation
12 ) where
14import Development.IDE.GHC.Error as ErrUtils
15import Development.IDE.GHC.Orphans()
16import Development.IDE.Types.Diagnostics
17import Development.IDE.Types.Location
18-- GHC imports
19import DynFlags
20import FastString
21import GHC
22import qualified Module as M
23import Packages
24import Outputable (showSDoc, ppr, pprPanic)
25import Finder
26import Control.DeepSeq
28-- standard imports
29import Control.Monad.Extra
30import Control.Monad.IO.Class
31import System.FilePath
33data Import
34 = FileImport !ArtifactsLocation
35 | PackageImport !M.InstalledUnitId
36 deriving (Show)
38data ArtifactsLocation = ArtifactsLocation
39 { artifactFilePath :: !NormalizedFilePath
40 , artifactModLocation :: !ModLocation
41 , artifactIsSource :: !Bool -- ^ True if a module is a source input
42 }
43 deriving (Show)
45instance NFData ArtifactsLocation where
46 rnf ArtifactsLocation{..} = rnf artifactFilePath `seq` rwhnf artifactModLocation `seq` rnf artifactIsSource
48isBootLocation :: ArtifactsLocation -> Bool
49isBootLocation = not . artifactIsSource
51instance NFData Import where
52 rnf (FileImport x) = rnf x
53 rnf (PackageImport x) = rnf x
56-- | locate a module in the file system. Where we go from *daml to Haskell
57locateModuleFile :: MonadIO m
58 => DynFlags
59 -> [String]
60 -> (NormalizedFilePath -> m Bool)
61 -> Bool
62 -> ModuleName
63 -> m (Maybe NormalizedFilePath)
64locateModuleFile dflags exts doesExist isSource modName = do
65 let candidates =
66 [ toNormalizedFilePath' (prefix </> M.moduleNameSlashes modName <.> maybeBoot ext)
67 | prefix <- importPaths dflags, ext <- exts]
68 findM doesExist candidates
69 where
70 maybeBoot ext
71 | isSource = ext ++ "-boot"
72 | otherwise = ext
74-- | locate a module in either the file system or the package database. Where we go from *daml to
75-- Haskell
76locateModule
77 :: MonadIO m
78 => DynFlags
79 -> [String]
80 -> (NormalizedFilePath -> m Bool)
81 -> Located ModuleName
82 -> Maybe FastString
83 -> Bool
84 -> m (Either [FileDiagnostic] Import)
85locateModule dflags exts doesExist modName mbPkgName isSource = do
86 case mbPkgName of
87 -- "this" means that we should only look in the current package
88 Just "this" -> do
89 mbFile <- locateModuleFile dflags exts doesExist isSource $ unLoc modName
90 case mbFile of
91 Nothing -> return $ Left $ notFoundErr dflags modName $ LookupNotFound []
92 Just file -> toModLocation file
93 -- if a package name is given we only go look for a package
94 Just _pkgName -> lookupInPackageDB dflags
95 Nothing -> do
96 -- first try to find the module as a file. If we can't find it try to find it in the package
97 -- database.
98 mbFile <- locateModuleFile dflags exts doesExist isSource $ unLoc modName
99 case mbFile of
100 Nothing -> lookupInPackageDB dflags
101 Just file -> toModLocation file
102 where
103 toModLocation file = liftIO $ do
104 loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file)
105 return $ Right $ FileImport $ ArtifactsLocation file loc (not isSource)
108 lookupInPackageDB dfs =
109 case lookupModuleWithSuggestions dfs (unLoc modName) mbPkgName of
110 LookupFound _m pkgConfig -> return $ Right $ PackageImport $ unitId pkgConfig
111 reason -> return $ Left $ notFoundErr dfs modName reason
113-- | Don't call this on a found module.
114notFoundErr :: DynFlags -> Located M.ModuleName -> LookupResult -> [FileDiagnostic]
115notFoundErr dfs modName reason =
116 mkError' $ ppr' $ cannotFindModule dfs modName0 $ lookupToFindResult reason
117 where
118 mkError' = diagFromString "not found" DsError (getLoc modName)
119 modName0 = unLoc modName
120 ppr' = showSDoc dfs
121 -- We convert the lookup result to a find result to reuse GHC's cannotFindMoudle pretty printer.
122 lookupToFindResult =
123 \case
124 LookupFound _m _pkgConfig ->
125 pprPanic "Impossible: called lookupToFind on found module." (ppr modName0)
126 LookupMultiple rs -> FoundMultiple rs
127 LookupHidden pkg_hiddens mod_hiddens ->
128 notFound
129 { fr_pkgs_hidden = map (moduleUnitId . fst) pkg_hiddens
130 , fr_mods_hidden = map (moduleUnitId . fst) mod_hiddens
131 }
132#if MIN_GHC_API_VERSION(8,6,0)
133 LookupUnusable unusable ->
134 let unusables' = map get_unusable unusable
135 get_unusable (m, ModUnusable r) = (moduleUnitId m, r)
136 get_unusable (_, r) =
137 pprPanic "findLookupResult: unexpected origin" (ppr r)
138 in notFound {fr_unusables = unusables'}
139#endif
140 LookupNotFound suggest ->
141 notFound {fr_suggestions = suggest}
143notFound :: FindResult
144notFound = NotFound
145 { fr_paths = []
146 , fr_pkg = Nothing
147 , fr_pkgs_hidden = []
148 , fr_mods_hidden = []
149#if MIN_GHC_API_VERSION(8,6,0)
150 , fr_unusables = []
151#endif
152 , fr_suggestions = []
153 }