{-# LANGUAGE CPP #-}
#include "ghc-api-version.h"
module Development.IDE.Import.FindImports
( locateModule
, Import(..)
, ArtifactsLocation(..)
, modSummaryToArtifactsLocation
, isBootLocation
, mkImportDirs
) where
import Development.IDE.GHC.Error as ErrUtils
import Development.IDE.GHC.Orphans()
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.GHC.Compat
import FastString
import qualified Module as M
import Packages
import Outputable (showSDoc, ppr, pprPanic)
import Finder
import Control.DeepSeq
import Control.Monad.Extra
import Control.Monad.IO.Class
import System.FilePath
import DriverPhases
import Data.Maybe
import Data.List (isSuffixOf)
data Import
= FileImport !ArtifactsLocation
| PackageImport !M.InstalledUnitId
deriving (Int -> Import -> ShowS
[Import] -> ShowS
Import -> String
(Int -> Import -> ShowS)
-> (Import -> String) -> ([Import] -> ShowS) -> Show Import
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Import] -> ShowS
$cshowList :: [Import] -> ShowS
show :: Import -> String
$cshow :: Import -> String
showsPrec :: Int -> Import -> ShowS
$cshowsPrec :: Int -> Import -> ShowS
Show)
data ArtifactsLocation = ArtifactsLocation
{ ArtifactsLocation -> NormalizedFilePath
artifactFilePath :: !NormalizedFilePath
, ArtifactsLocation -> Maybe ModLocation
artifactModLocation :: !(Maybe ModLocation)
, ArtifactsLocation -> Bool
artifactIsSource :: !Bool
}
deriving (Int -> ArtifactsLocation -> ShowS
[ArtifactsLocation] -> ShowS
ArtifactsLocation -> String
(Int -> ArtifactsLocation -> ShowS)
-> (ArtifactsLocation -> String)
-> ([ArtifactsLocation] -> ShowS)
-> Show ArtifactsLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactsLocation] -> ShowS
$cshowList :: [ArtifactsLocation] -> ShowS
show :: ArtifactsLocation -> String
$cshow :: ArtifactsLocation -> String
showsPrec :: Int -> ArtifactsLocation -> ShowS
$cshowsPrec :: Int -> ArtifactsLocation -> ShowS
Show)
instance NFData ArtifactsLocation where
rnf :: ArtifactsLocation -> ()
rnf ArtifactsLocation{Bool
Maybe ModLocation
NormalizedFilePath
artifactIsSource :: Bool
artifactModLocation :: Maybe ModLocation
artifactFilePath :: NormalizedFilePath
artifactIsSource :: ArtifactsLocation -> Bool
artifactModLocation :: ArtifactsLocation -> Maybe ModLocation
artifactFilePath :: ArtifactsLocation -> NormalizedFilePath
..} = NormalizedFilePath -> ()
forall a. NFData a => a -> ()
rnf NormalizedFilePath
artifactFilePath () -> () -> ()
`seq` Maybe ModLocation -> ()
forall a. a -> ()
rwhnf Maybe ModLocation
artifactModLocation () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
artifactIsSource
isBootLocation :: ArtifactsLocation -> Bool
isBootLocation :: ArtifactsLocation -> Bool
isBootLocation = Bool -> Bool
not (Bool -> Bool)
-> (ArtifactsLocation -> Bool) -> ArtifactsLocation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtifactsLocation -> Bool
artifactIsSource
instance NFData Import where
rnf :: Import -> ()
rnf (FileImport ArtifactsLocation
x) = ArtifactsLocation -> ()
forall a. NFData a => a -> ()
rnf ArtifactsLocation
x
rnf (PackageImport InstalledUnitId
x) = InstalledUnitId -> ()
forall a. NFData a => a -> ()
rnf InstalledUnitId
x
modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
modSummaryToArtifactsLocation NormalizedFilePath
nfp Maybe ModSummary
ms = NormalizedFilePath
-> Maybe ModLocation -> Bool -> ArtifactsLocation
ArtifactsLocation NormalizedFilePath
nfp (ModSummary -> ModLocation
ms_location (ModSummary -> ModLocation)
-> Maybe ModSummary -> Maybe ModLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModSummary
ms) Bool
source
where
isSource :: HscSource -> Bool
isSource HscSource
HsSrcFile = Bool
True
isSource HscSource
_ = Bool
False
source :: Bool
source = case Maybe ModSummary
ms of
Maybe ModSummary
Nothing -> String
"-boot" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp
Just ModSummary
ms -> HscSource -> Bool
isSource (ModSummary -> HscSource
ms_hsc_src ModSummary
ms)
locateModuleFile :: MonadIO m
=> [[FilePath]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile :: [[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile [[String]]
import_dirss [String]
exts ModuleName -> NormalizedFilePath -> m Bool
doesExist Bool
isSource ModuleName
modName = do
let candidates :: [String] -> [NormalizedFilePath]
candidates [String]
import_dirs =
[ String -> NormalizedFilePath
toNormalizedFilePath' (String
prefix String -> ShowS
</> ModuleName -> String
M.moduleNameSlashes ModuleName
modName String -> ShowS
<.> ShowS
maybeBoot String
ext)
| String
prefix <- [String]
import_dirs , String
ext <- [String]
exts]
(NormalizedFilePath -> m Bool)
-> [NormalizedFilePath] -> m (Maybe NormalizedFilePath)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (ModuleName -> NormalizedFilePath -> m Bool
doesExist ModuleName
modName) (([String] -> [NormalizedFilePath])
-> [[String]] -> [NormalizedFilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [String] -> [NormalizedFilePath]
candidates [[String]]
import_dirss)
where
maybeBoot :: ShowS
maybeBoot String
ext
| Bool
isSource = String
ext String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-boot"
| Bool
otherwise = String
ext
mkImportDirs :: DynFlags -> (M.InstalledUnitId, DynFlags) -> Maybe (PackageName, [FilePath])
mkImportDirs :: DynFlags
-> (InstalledUnitId, DynFlags) -> Maybe (PackageName, [String])
mkImportDirs DynFlags
df (InstalledUnitId
i, DynFlags{[String]
importPaths :: DynFlags -> [String]
importPaths :: [String]
importPaths}) = (, [String]
importPaths) (PackageName -> (PackageName, [String]))
-> Maybe PackageName -> Maybe (PackageName, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> InstalledUnitId -> Maybe PackageName
getPackageName DynFlags
df InstalledUnitId
i
locateModule
:: MonadIO m
=> DynFlags
-> [(M.InstalledUnitId, DynFlags)]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Located ModuleName
-> Maybe FastString
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule :: DynFlags
-> [(InstalledUnitId, DynFlags)]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Located ModuleName
-> Maybe FastString
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule DynFlags
dflags [(InstalledUnitId, DynFlags)]
comp_info [String]
exts ModuleName -> NormalizedFilePath -> m Bool
doesExist Located ModuleName
modName Maybe FastString
mbPkgName Bool
isSource = do
case Maybe FastString
mbPkgName of
Just FastString
"this" -> do
[[String]] -> m (Either [FileDiagnostic] Import)
lookupLocal [DynFlags -> [String]
importPaths DynFlags
dflags]
Just FastString
pkgName
| Just [String]
dirs <- PackageName -> [(PackageName, [String])] -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FastString -> PackageName
PackageName FastString
pkgName) [(PackageName, [String])]
import_paths
-> [[String]] -> m (Either [FileDiagnostic] Import)
lookupLocal [[String]
dirs]
| Bool
otherwise -> DynFlags -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *).
Monad m =>
DynFlags -> m (Either [FileDiagnostic] Import)
lookupInPackageDB DynFlags
dflags
Maybe FastString
Nothing -> do
Maybe NormalizedFilePath
mbFile <- [[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
forall (m :: * -> *).
MonadIO m =>
[[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile (DynFlags -> [String]
importPaths DynFlags
dflags [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: ((PackageName, [String]) -> [String])
-> [(PackageName, [String])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, [String]) -> [String]
forall a b. (a, b) -> b
snd [(PackageName, [String])]
import_paths) [String]
exts ModuleName -> NormalizedFilePath -> m Bool
doesExist Bool
isSource (ModuleName -> m (Maybe NormalizedFilePath))
-> ModuleName -> m (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName
case Maybe NormalizedFilePath
mbFile of
Maybe NormalizedFilePath
Nothing -> DynFlags -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *).
Monad m =>
DynFlags -> m (Either [FileDiagnostic] Import)
lookupInPackageDB DynFlags
dflags
Just NormalizedFilePath
file -> NormalizedFilePath -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a.
MonadIO m =>
NormalizedFilePath -> m (Either a Import)
toModLocation NormalizedFilePath
file
where
import_paths :: [(PackageName, [String])]
import_paths = ((InstalledUnitId, DynFlags) -> Maybe (PackageName, [String]))
-> [(InstalledUnitId, DynFlags)] -> [(PackageName, [String])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DynFlags
-> (InstalledUnitId, DynFlags) -> Maybe (PackageName, [String])
mkImportDirs DynFlags
dflags) [(InstalledUnitId, DynFlags)]
comp_info
toModLocation :: NormalizedFilePath -> m (Either a Import)
toModLocation NormalizedFilePath
file = IO (Either a Import) -> m (Either a Import)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either a Import) -> m (Either a Import))
-> IO (Either a Import) -> m (Either a Import)
forall a b. (a -> b) -> a -> b
$ do
ModLocation
loc <- DynFlags -> ModuleName -> String -> IO ModLocation
mkHomeModLocation DynFlags
dflags (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName) (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file)
Either a Import -> IO (Either a Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a Import -> IO (Either a Import))
-> Either a Import -> IO (Either a Import)
forall a b. (a -> b) -> a -> b
$ Import -> Either a Import
forall a b. b -> Either a b
Right (Import -> Either a Import) -> Import -> Either a Import
forall a b. (a -> b) -> a -> b
$ ArtifactsLocation -> Import
FileImport (ArtifactsLocation -> Import) -> ArtifactsLocation -> Import
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> Maybe ModLocation -> Bool -> ArtifactsLocation
ArtifactsLocation NormalizedFilePath
file (ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
loc) (Bool -> Bool
not Bool
isSource)
lookupLocal :: [[String]] -> m (Either [FileDiagnostic] Import)
lookupLocal [[String]]
dirs = do
Maybe NormalizedFilePath
mbFile <- [[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
forall (m :: * -> *).
MonadIO m =>
[[String]]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile [[String]]
dirs [String]
exts ModuleName -> NormalizedFilePath -> m Bool
doesExist Bool
isSource (ModuleName -> m (Maybe NormalizedFilePath))
-> ModuleName -> m (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName
case Maybe NormalizedFilePath
mbFile of
Maybe NormalizedFilePath
Nothing -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import))
-> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a b. (a -> b) -> a -> b
$ [FileDiagnostic] -> Either [FileDiagnostic] Import
forall a b. a -> Either a b
Left ([FileDiagnostic] -> Either [FileDiagnostic] Import)
-> [FileDiagnostic] -> Either [FileDiagnostic] Import
forall a b. (a -> b) -> a -> b
$ DynFlags -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr DynFlags
dflags Located ModuleName
modName (LookupResult -> [FileDiagnostic])
-> LookupResult -> [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ [ModuleSuggestion] -> LookupResult
LookupNotFound []
Just NormalizedFilePath
file -> NormalizedFilePath -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a.
MonadIO m =>
NormalizedFilePath -> m (Either a Import)
toModLocation NormalizedFilePath
file
lookupInPackageDB :: DynFlags -> m (Either [FileDiagnostic] Import)
lookupInPackageDB DynFlags
dfs =
case DynFlags -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions DynFlags
dfs (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName) Maybe FastString
mbPkgName of
LookupFound Module
_m PackageConfig
pkgConfig -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import))
-> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a b. (a -> b) -> a -> b
$ Import -> Either [FileDiagnostic] Import
forall a b. b -> Either a b
Right (Import -> Either [FileDiagnostic] Import)
-> Import -> Either [FileDiagnostic] Import
forall a b. (a -> b) -> a -> b
$ InstalledUnitId -> Import
PackageImport (InstalledUnitId -> Import) -> InstalledUnitId -> Import
forall a b. (a -> b) -> a -> b
$ PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
pkgConfig
LookupResult
reason -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import))
-> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a b. (a -> b) -> a -> b
$ [FileDiagnostic] -> Either [FileDiagnostic] Import
forall a b. a -> Either a b
Left ([FileDiagnostic] -> Either [FileDiagnostic] Import)
-> [FileDiagnostic] -> Either [FileDiagnostic] Import
forall a b. (a -> b) -> a -> b
$ DynFlags -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr DynFlags
dfs Located ModuleName
modName LookupResult
reason
notFoundErr :: DynFlags -> Located M.ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr :: DynFlags -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr DynFlags
dfs Located ModuleName
modName LookupResult
reason =
String -> [FileDiagnostic]
mkError' (String -> [FileDiagnostic]) -> String -> [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ SDoc -> String
ppr' (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> ModuleName -> FindResult -> SDoc
cannotFindModule DynFlags
dfs ModuleName
modName0 (FindResult -> SDoc) -> FindResult -> SDoc
forall a b. (a -> b) -> a -> b
$ LookupResult -> FindResult
lookupToFindResult LookupResult
reason
where
mkError' :: String -> [FileDiagnostic]
mkError' = Text -> DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
diagFromString Text
"not found" DiagnosticSeverity
DsError (Located ModuleName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located ModuleName
modName)
modName0 :: SrcSpanLess (Located ModuleName)
modName0 = Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
modName
ppr' :: SDoc -> String
ppr' = DynFlags -> SDoc -> String
showSDoc DynFlags
dfs
lookupToFindResult :: LookupResult -> FindResult
lookupToFindResult =
\case
LookupFound Module
_m PackageConfig
_pkgConfig ->
String -> SDoc -> FindResult
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Impossible: called lookupToFind on found module." (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
modName0)
LookupMultiple [(Module, ModuleOrigin)]
rs -> [(Module, ModuleOrigin)] -> FindResult
FoundMultiple [(Module, ModuleOrigin)]
rs
LookupHidden [(Module, ModuleOrigin)]
pkg_hiddens [(Module, ModuleOrigin)]
mod_hiddens ->
FindResult
notFound
{ fr_pkgs_hidden :: [UnitId]
fr_pkgs_hidden = ((Module, ModuleOrigin) -> UnitId)
-> [(Module, ModuleOrigin)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> UnitId
moduleUnitId (Module -> UnitId)
-> ((Module, ModuleOrigin) -> Module)
-> (Module, ModuleOrigin)
-> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module, ModuleOrigin) -> Module
forall a b. (a, b) -> a
fst) [(Module, ModuleOrigin)]
pkg_hiddens
, fr_mods_hidden :: [UnitId]
fr_mods_hidden = ((Module, ModuleOrigin) -> UnitId)
-> [(Module, ModuleOrigin)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> UnitId
moduleUnitId (Module -> UnitId)
-> ((Module, ModuleOrigin) -> Module)
-> (Module, ModuleOrigin)
-> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module, ModuleOrigin) -> Module
forall a b. (a, b) -> a
fst) [(Module, ModuleOrigin)]
mod_hiddens
}
LookupUnusable [(Module, ModuleOrigin)]
unusable ->
let unusables' :: [(UnitId, UnusablePackageReason)]
unusables' = ((Module, ModuleOrigin) -> (UnitId, UnusablePackageReason))
-> [(Module, ModuleOrigin)] -> [(UnitId, UnusablePackageReason)]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> (UnitId, UnusablePackageReason)
get_unusable [(Module, ModuleOrigin)]
unusable
get_unusable :: (Module, ModuleOrigin) -> (UnitId, UnusablePackageReason)
get_unusable (Module
m, ModUnusable UnusablePackageReason
r) = (Module -> UnitId
moduleUnitId Module
m, UnusablePackageReason
r)
get_unusable (Module
_, ModuleOrigin
r) =
String -> SDoc -> (UnitId, UnusablePackageReason)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"findLookupResult: unexpected origin" (ModuleOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
r)
in FindResult
notFound {fr_unusables :: [(UnitId, UnusablePackageReason)]
fr_unusables = [(UnitId, UnusablePackageReason)]
unusables'}
LookupNotFound [ModuleSuggestion]
suggest ->
FindResult
notFound {fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
suggest}
notFound :: FindResult
notFound :: FindResult
notFound = NotFound :: [String]
-> Maybe UnitId
-> [UnitId]
-> [UnitId]
-> [(UnitId, UnusablePackageReason)]
-> [ModuleSuggestion]
-> FindResult
NotFound
{ fr_paths :: [String]
fr_paths = []
, fr_pkg :: Maybe UnitId
fr_pkg = Maybe UnitId
forall a. Maybe a
Nothing
, fr_pkgs_hidden :: [UnitId]
fr_pkgs_hidden = []
, fr_mods_hidden :: [UnitId]
fr_mods_hidden = []
, fr_unusables :: [(UnitId, UnusablePackageReason)]
fr_unusables = []
, fr_suggestions :: [ModuleSuggestion]
fr_suggestions = []
}