{-# 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
data Import
= FileImport !ArtifactsLocation
| PackageImport
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 Import
PackageImport = ()
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 (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile :: [[String]]
-> [String]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile [[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]
(NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> [NormalizedFilePath] -> m (Maybe NormalizedFilePath)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor 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 :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, [FilePath])
mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, [String])
mkImportDirs HscEnv
env (UnitId
i, DynFlags
flags) = (, DynFlags -> [String]
importPaths DynFlags
flags) (PackageName -> (PackageName, [String]))
-> Maybe PackageName -> Maybe (PackageName, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv -> UnitId -> Maybe PackageName
getUnitName HscEnv
env UnitId
i
locateModule
:: MonadIO m
=> HscEnv
-> [(UnitId, DynFlags)]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> Maybe FastString
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule :: 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
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 -> HscEnv -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *).
Monad m =>
HscEnv -> m (Either [FileDiagnostic] Import)
lookupInPackageDB HscEnv
env
Maybe FastString
Nothing -> do
Maybe NormalizedFilePath
mbFile <- [[String]]
-> [String]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
forall (m :: * -> *).
MonadIO m =>
[[String]]
-> [String]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> 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 (Maybe NormalizedFilePath)
targetFor 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 -> HscEnv -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *).
Monad m =>
HscEnv -> m (Either [FileDiagnostic] Import)
lookupInPackageDB HscEnv
env
Just NormalizedFilePath
file -> NormalizedFilePath -> m (Either [FileDiagnostic] Import)
forall (m :: * -> *) a.
MonadIO m =>
NormalizedFilePath -> m (Either a Import)
toModLocation NormalizedFilePath
file
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
env
import_paths :: [(PackageName, [String])]
import_paths = ((UnitId, DynFlags) -> Maybe (PackageName, [String]))
-> [(UnitId, DynFlags)] -> [(PackageName, [String])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, [String])
mkImportDirs HscEnv
env) [(UnitId, 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 (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
forall (m :: * -> *).
MonadIO m =>
[[String]]
-> [String]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
locateModuleFile [[String]]
dirs [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor 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
$ HscEnv -> Located ModuleName -> LookupResult -> [FileDiagnostic]
notFoundErr HscEnv
env 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 :: HscEnv -> m (Either [FileDiagnostic] Import)
lookupInPackageDB HscEnv
env =
case HscEnv -> ModuleName -> Maybe FastString -> LookupResult
Compat.lookupModuleWithSuggestions HscEnv
env (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
PackageImport
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
$ 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' (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
$ HscEnv -> ModuleName -> FindResult -> SDoc
cannotFindModule HscEnv
env ModuleName
modName0 (FindResult -> SDoc) -> FindResult -> SDoc
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 (Located ModuleName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
Compat.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
moduleUnit (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
moduleUnit (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
moduleUnit 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 = []
}