{-# LANGUAGE CPP #-}
module Development.IDE.Import.FindImports
( locateModule
, locateModuleFile
, Import(..)
, ArtifactsLocation(..)
, modSummaryToArtifactsLocation
, isBootLocation
, mkImportDirs
) where
import Control.DeepSeq
import Development.IDE.GHC.Compat as Compat
import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.Error as ErrUtils
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Control.Monad.Extra
import Control.Monad.IO.Class
import Data.List (isSuffixOf)
import Data.Maybe
import System.FilePath
#if MIN_VERSION_ghc(9,3,0)
import GHC.Types.PkgQual
#endif
data Import
= FileImport !ArtifactsLocation
| PackageImport
deriving (Int -> Import -> ShowS
[Import] -> ShowS
Import -> String
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
, ArtifactsLocation -> Maybe Module
artifactModule :: !(Maybe Module)
} deriving Int -> ArtifactsLocation -> ShowS
[ArtifactsLocation] -> ShowS
ArtifactsLocation -> String
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
Maybe Module
NormalizedFilePath
artifactModule :: Maybe Module
artifactIsSource :: Bool
artifactModLocation :: Maybe ModLocation
artifactFilePath :: NormalizedFilePath
artifactModule :: ArtifactsLocation -> Maybe Module
artifactIsSource :: ArtifactsLocation -> Bool
artifactModLocation :: ArtifactsLocation -> Maybe ModLocation
artifactFilePath :: ArtifactsLocation -> NormalizedFilePath
..} = forall a. NFData a => a -> ()
rnf NormalizedFilePath
artifactFilePath seq :: forall a b. a -> b -> b
`seq` forall a. a -> ()
rwhnf Maybe ModLocation
artifactModLocation seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Bool
artifactIsSource seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Module
artifactModule
isBootLocation :: ArtifactsLocation -> Bool
isBootLocation :: ArtifactsLocation -> Bool
isBootLocation = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtifactsLocation -> Bool
artifactIsSource
instance NFData Import where
rnf :: Import -> ()
rnf (FileImport ArtifactsLocation
x) = forall a. NFData a => a -> ()
rnf ArtifactsLocation
x
rnf Import
PackageImport = ()
modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
modSummaryToArtifactsLocation NormalizedFilePath
nfp Maybe ModSummary
ms = NormalizedFilePath
-> Maybe ModLocation -> Bool -> Maybe Module -> ArtifactsLocation
ArtifactsLocation NormalizedFilePath
nfp (ModSummary -> ModLocation
ms_location forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModSummary
ms) Bool
source Maybe Module
mod
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" 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)
mod :: Maybe Module
mod = ModSummary -> Module
ms_mod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModSummary
ms
locateModuleFile :: MonadIO m
=> [(UnitId, [FilePath])]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe (UnitId, NormalizedFilePath))
locateModuleFile :: forall (m :: * -> *).
MonadIO m =>
[(UnitId, [String])]
-> [String]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe (UnitId, NormalizedFilePath))
locateModuleFile [(UnitId, [String])]
import_dirss [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Bool
isSource ModuleName
modName = do
let candidates :: [String] -> [NormalizedFilePath]
candidates [String]
import_dirs =
[ String -> NormalizedFilePath
toNormalizedFilePath' (String
prefix String -> ShowS
</> ModuleName -> String
moduleNameSlashes ModuleName
modName String -> ShowS
<.> ShowS
maybeBoot String
ext)
| String
prefix <- [String]
import_dirs , String
ext <- [String]
exts]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM forall {t}.
(t, NormalizedFilePath) -> m (Maybe (t, NormalizedFilePath))
go (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a b. (a -> b) -> [a] -> [b]
map (UnitId
uid,) ([String] -> [NormalizedFilePath]
candidates [String]
dirs) | (UnitId
uid, [String]
dirs) <- [(UnitId, [String])]
import_dirss])
where
go :: (t, NormalizedFilePath) -> m (Maybe (t, NormalizedFilePath))
go (t
uid, NormalizedFilePath
candidate) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t
uid,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall a b. (a -> b) -> a -> b
$ ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor ModuleName
modName NormalizedFilePath
candidate
maybeBoot :: ShowS
maybeBoot String
ext
| Bool
isSource = String
ext forall a. [a] -> [a] -> [a]
++ String
"-boot"
| Bool
otherwise = String
ext
#if MIN_VERSION_ghc(9,3,0)
mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (UnitId, [FilePath])
mkImportDirs env (i, flags) = Just (i, importPaths flags)
#else
mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, (UnitId, [FilePath]))
mkImportDirs :: HscEnv
-> (UnitId, DynFlags) -> Maybe (PackageName, (UnitId, [String]))
mkImportDirs HscEnv
env (UnitId
i, DynFlags
flags) = (, (UnitId
i, DynFlags -> [String]
importPaths DynFlags
flags)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv -> UnitId -> Maybe PackageName
getUnitName HscEnv
env UnitId
i
#endif
locateModule
:: MonadIO m
=> HscEnv
-> [(UnitId, DynFlags)]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
#if MIN_VERSION_ghc(9,3,0)
-> PkgQual
#else
-> Maybe FastString
#endif
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule :: forall (m :: * -> *).
MonadIO m =>
HscEnv
-> [(UnitId, DynFlags)]
-> [String]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> Maybe FastString
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule HscEnv
env [(UnitId, DynFlags)]
comp_info [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Located ModuleName
modName Maybe FastString
mbPkgName Bool
isSource = do
case Maybe FastString
mbPkgName of
#if MIN_VERSION_ghc(9,3,0)
ThisPkg _ -> do
#else
Just FastString
"this" -> do
#endif
UnitId -> [String] -> m (Either [FileDiagnostic] Import)
lookupLocal (DynFlags -> UnitId
homeUnitId_ DynFlags
dflags) (DynFlags -> [String]
importPaths DynFlags
dflags)
#if MIN_VERSION_ghc(9,3,0)
OtherPkg uid
| Just dirs <- lookup uid import_paths
-> lookupLocal uid dirs
#else
Just FastString
pkgName
| Just (UnitId
uid, [String]
dirs) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FastString -> PackageName
PackageName FastString
pkgName) [(PackageName, (UnitId, [String]))]
import_paths
-> UnitId -> [String] -> m (Either [FileDiagnostic] Import)
lookupLocal UnitId
uid [String]
dirs
#endif
| Bool
otherwise -> forall {m :: * -> *}.
Monad m =>
HscEnv -> m (Either [FileDiagnostic] Import)
lookupInPackageDB HscEnv
env
#if MIN_VERSION_ghc(9,3,0)
NoPkgQual -> do
#else
Maybe FastString
Nothing -> do
#endif
let import_paths' :: [(UnitId, [String])]
import_paths' =
#if MIN_VERSION_ghc(9,3,0)
import_paths
#else
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(PackageName, (UnitId, [String]))]
import_paths
#endif
Maybe (UnitId, NormalizedFilePath)
mbFile <- forall (m :: * -> *).
MonadIO m =>
[(UnitId, [String])]
-> [String]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe (UnitId, NormalizedFilePath))
locateModuleFile ((DynFlags -> UnitId
homeUnitId_ DynFlags
dflags, DynFlags -> [String]
importPaths DynFlags
dflags) forall a. a -> [a] -> [a]
: [(UnitId, [String])]
import_paths') [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Bool
isSource forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName
case Maybe (UnitId, NormalizedFilePath)
mbFile of
Maybe (UnitId, NormalizedFilePath)
Nothing -> forall {m :: * -> *}.
Monad m =>
HscEnv -> m (Either [FileDiagnostic] Import)
lookupInPackageDB HscEnv
env
Just (UnitId
uid, NormalizedFilePath
file) -> forall {m :: * -> *} {a}.
MonadIO m =>
UnitId -> NormalizedFilePath -> m (Either a Import)
toModLocation UnitId
uid NormalizedFilePath
file
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
env
import_paths :: [(PackageName, (UnitId, [String]))]
import_paths = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HscEnv
-> (UnitId, DynFlags) -> Maybe (PackageName, (UnitId, [String]))
mkImportDirs HscEnv
env) [(UnitId, DynFlags)]
comp_info
toModLocation :: UnitId -> NormalizedFilePath -> m (Either a Import)
toModLocation UnitId
uid NormalizedFilePath
file = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
ModLocation
loc <- DynFlags -> ModuleName -> String -> IO ModLocation
mkHomeModLocation DynFlags
dflags (forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName) (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file)
#if MIN_VERSION_ghc(9,0,0)
let mod :: Module
mod = forall u. u -> ModuleName -> GenModule u
mkModule (forall uid. Definite uid -> GenUnit uid
RealUnit forall a b. (a -> b) -> a -> b
$ forall unit. unit -> Definite unit
Definite UnitId
uid) (forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName)
#else
let mod = mkModule uid (unLoc modName)
#endif
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ArtifactsLocation -> Import
FileImport forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> Maybe ModLocation -> Bool -> Maybe Module -> ArtifactsLocation
ArtifactsLocation NormalizedFilePath
file (forall a. a -> Maybe a
Just ModLocation
loc) (Bool -> Bool
not Bool
isSource) (forall a. a -> Maybe a
Just Module
mod)
lookupLocal :: UnitId -> [String] -> m (Either [FileDiagnostic] Import)
lookupLocal UnitId
uid [String]
dirs = do
Maybe (UnitId, NormalizedFilePath)
mbFile <- forall (m :: * -> *).
MonadIO m =>
[(UnitId, [String])]
-> [String]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe (UnitId, NormalizedFilePath))
locateModuleFile [(UnitId
uid, [String]
dirs)] [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Bool
isSource forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName
case Maybe (UnitId, NormalizedFilePath)
mbFile of
Maybe (UnitId, NormalizedFilePath)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ HscEnv -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr HscEnv
env Located ModuleName
modName forall a b. (a -> b) -> a -> b
$ [ModuleSuggestion] -> LookupResult
LookupNotFound []
Just (UnitId
uid, NormalizedFilePath
file) -> forall {m :: * -> *} {a}.
MonadIO m =>
UnitId -> NormalizedFilePath -> m (Either a Import)
toModLocation UnitId
uid NormalizedFilePath
file
lookupInPackageDB :: HscEnv -> m (Either [FileDiagnostic] Import)
lookupInPackageDB HscEnv
env = do
case HscEnv -> ModuleName -> Maybe FastString -> LookupResult
Compat.lookupModuleWithSuggestions HscEnv
env (forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName) Maybe FastString
mbPkgName of
LookupFound Module
_m (UnitInfo, ModuleOrigin)
_pkgConfig -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Import
PackageImport
LookupResult
reason -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ HscEnv -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr HscEnv
env Located ModuleName
modName LookupResult
reason
notFoundErr :: HscEnv -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr :: HscEnv -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr HscEnv
env Located ModuleName
modName LookupResult
reason =
String -> [FileDiagnostic]
mkError' forall a b. (a -> b) -> a -> b
$ SDoc -> String
ppr' forall a b. (a -> b) -> a -> b
$ HscEnv -> ModuleName -> FindResult -> SDoc
cannotFindModule HscEnv
env ModuleName
modName0 forall a b. (a -> b) -> a -> b
$ LookupResult -> FindResult
lookupToFindResult LookupResult
reason
where
dfs :: DynFlags
dfs = HscEnv -> DynFlags
hsc_dflags HscEnv
env
mkError' :: String -> [FileDiagnostic]
mkError' = Text -> DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
diagFromString Text
"not found" DiagnosticSeverity
DsError (forall a. HasSrcSpan a => a -> SrcSpan
Compat.getLoc Located ModuleName
modName)
modName0 :: ModuleName
modName0 = forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName
ppr' :: SDoc -> String
ppr' = DynFlags -> SDoc -> String
showSDoc DynFlags
dfs
lookupToFindResult :: LookupResult -> FindResult
lookupToFindResult =
\case
LookupFound Module
_m (UnitInfo, ModuleOrigin)
_pkgConfig ->
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Impossible: called lookupToFind on found module." (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 :: [GenUnit UnitId]
fr_pkgs_hidden = forall a b. (a -> b) -> [a] -> [b]
map (Module -> GenUnit UnitId
moduleUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Module, ModuleOrigin)]
pkg_hiddens
, fr_mods_hidden :: [GenUnit UnitId]
fr_mods_hidden = forall a b. (a -> b) -> [a] -> [b]
map (Module -> GenUnit UnitId
moduleUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Module, ModuleOrigin)]
mod_hiddens
}
LookupUnusable [(Module, ModuleOrigin)]
unusable ->
let unusables' :: [(GenUnit UnitId, UnusableUnitReason)]
unusables' = forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> (GenUnit UnitId, UnusableUnitReason)
get_unusable [(Module, ModuleOrigin)]
unusable
get_unusable :: (Module, ModuleOrigin) -> (GenUnit UnitId, UnusableUnitReason)
get_unusable (Module
m, ModUnusable UnusableUnitReason
r) = (Module -> GenUnit UnitId
moduleUnit Module
m, UnusableUnitReason
r)
get_unusable (Module
_, ModuleOrigin
r) =
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"findLookupResult: unexpected origin" (forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
r)
in FindResult
notFound {fr_unusables :: [(GenUnit UnitId, UnusableUnitReason)]
fr_unusables = [(GenUnit UnitId, UnusableUnitReason)]
unusables'}
LookupNotFound [ModuleSuggestion]
suggest ->
FindResult
notFound {fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
suggest}
notFound :: FindResult
notFound :: FindResult
notFound = NotFound
{ fr_paths :: [String]
fr_paths = []
, fr_pkg :: Maybe (GenUnit UnitId)
fr_pkg = forall a. Maybe a
Nothing
, fr_pkgs_hidden :: [GenUnit UnitId]
fr_pkgs_hidden = []
, fr_mods_hidden :: [GenUnit UnitId]
fr_mods_hidden = []
, fr_unusables :: [(GenUnit UnitId, UnusableUnitReason)]
fr_unusables = []
, fr_suggestions :: [ModuleSuggestion]
fr_suggestions = []
}