-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE CPP #-}

module Development.IDE.Import.FindImports
  ( locateModule
  , locateModuleFile
  , Import(..)
  , ArtifactsLocation(..)
  , modSummaryToArtifactsLocation
  , isBootLocation
  , mkImportDirs
  ) where

import           Control.DeepSeq
import           Control.Monad.Extra
import           Control.Monad.IO.Class
import           Data.List                         (find, isSuffixOf)
import           Data.Maybe
import qualified Data.Set                          as S
import           Development.IDE.GHC.Compat        as Compat
import           Development.IDE.GHC.Error         as ErrUtils
import           Development.IDE.GHC.Orphans       ()
import           Development.IDE.Types.Diagnostics
import           Development.IDE.Types.Location
import           GHC.Types.PkgQual
import           GHC.Unit.State
import           System.FilePath


#if MIN_VERSION_ghc(9,11,0)
import           GHC.Driver.DynFlags
#endif

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
$cshowsPrec :: Int -> Import -> ShowS
showsPrec :: Int -> Import -> ShowS
$cshow :: Import -> String
show :: Import -> String
$cshowList :: [Import] -> ShowS
showList :: [Import] -> ShowS
Show)

data ArtifactsLocation = ArtifactsLocation
  { ArtifactsLocation -> NormalizedFilePath
artifactFilePath    :: !NormalizedFilePath
  , ArtifactsLocation -> Maybe ModLocation
artifactModLocation :: !(Maybe ModLocation)
  , ArtifactsLocation -> Bool
artifactIsSource    :: !Bool          -- ^ True if a module is a source input
  , ArtifactsLocation -> Maybe Module
artifactModule      :: !(Maybe Module)
  } 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
$cshowsPrec :: Int -> ArtifactsLocation -> ShowS
showsPrec :: Int -> ArtifactsLocation -> ShowS
$cshow :: ArtifactsLocation -> String
show :: ArtifactsLocation -> String
$cshowList :: [ArtifactsLocation] -> ShowS
showList :: [ArtifactsLocation] -> ShowS
Show

instance NFData ArtifactsLocation where
  rnf :: ArtifactsLocation -> ()
rnf ArtifactsLocation{Bool
Maybe Module
Maybe ModLocation
NormalizedFilePath
artifactFilePath :: ArtifactsLocation -> NormalizedFilePath
artifactModLocation :: ArtifactsLocation -> Maybe ModLocation
artifactIsSource :: ArtifactsLocation -> Bool
artifactModule :: ArtifactsLocation -> Maybe Module
artifactFilePath :: NormalizedFilePath
artifactModLocation :: Maybe ModLocation
artifactIsSource :: Bool
artifactModule :: Maybe Module
..} = NormalizedFilePath -> ()
forall a. NFData a => a -> ()
rnf NormalizedFilePath
artifactFilePath () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe ModLocation -> ()
forall a. a -> ()
rwhnf Maybe ModLocation
artifactModLocation () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
artifactIsSource () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Module -> ()
forall a. NFData a => a -> ()
rnf Maybe Module
artifactModule

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 -> Maybe Module -> 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 Maybe Module
mbMod
  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
modSum -> HscSource -> Bool
isSource (ModSummary -> HscSource
ms_hsc_src ModSummary
modSum)
    mbMod :: Maybe Module
mbMod = ModSummary -> Module
ms_mod (ModSummary -> Module) -> Maybe ModSummary -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModSummary
ms

data LocateResult
  = LocateNotFound
  | LocateFoundReexport UnitId
  | LocateFoundFile UnitId NormalizedFilePath

-- | locate a module in the file system. Where we go from *daml to Haskell
locateModuleFile :: MonadIO m
             => [(UnitId, [FilePath], S.Set ModuleName)]
             -> [String]
             -> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
             -> Bool
             -> ModuleName
             -> m LocateResult
locateModuleFile :: forall (m :: * -> *).
MonadIO m =>
[(UnitId, [String], Set ModuleName)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m LocateResult
locateModuleFile [(UnitId, [String], Set ModuleName)]
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]
  Maybe (UnitId, NormalizedFilePath)
mf <- ((UnitId, NormalizedFilePath)
 -> m (Maybe (UnitId, NormalizedFilePath)))
-> [(UnitId, NormalizedFilePath)]
-> m (Maybe (UnitId, NormalizedFilePath))
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM (UnitId, NormalizedFilePath)
-> m (Maybe (UnitId, NormalizedFilePath))
forall {t}.
(t, NormalizedFilePath) -> m (Maybe (t, NormalizedFilePath))
go ([[(UnitId, NormalizedFilePath)]] -> [(UnitId, NormalizedFilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(NormalizedFilePath -> (UnitId, NormalizedFilePath))
-> [NormalizedFilePath] -> [(UnitId, NormalizedFilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId
uid,) ([String] -> [NormalizedFilePath]
candidates [String]
dirs) | (UnitId
uid, [String]
dirs, Set ModuleName
_) <- [(UnitId, [String], Set ModuleName)]
import_dirss])
  case Maybe (UnitId, NormalizedFilePath)
mf of
    Maybe (UnitId, NormalizedFilePath)
Nothing ->
      case ((UnitId, [String], Set ModuleName) -> Bool)
-> [(UnitId, [String], Set ModuleName)]
-> Maybe (UnitId, [String], Set ModuleName)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(UnitId
_ , [String]
_, Set ModuleName
reexports) -> ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ModuleName
modName Set ModuleName
reexports) [(UnitId, [String], Set ModuleName)]
import_dirss of
        Just (UnitId
uid,[String]
_,Set ModuleName
_) -> LocateResult -> m LocateResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocateResult -> m LocateResult) -> LocateResult -> m LocateResult
forall a b. (a -> b) -> a -> b
$ UnitId -> LocateResult
LocateFoundReexport UnitId
uid
        Maybe (UnitId, [String], Set ModuleName)
Nothing        -> LocateResult -> m LocateResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocateResult
LocateNotFound
    Just (UnitId
uid,NormalizedFilePath
file) -> LocateResult -> m LocateResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocateResult -> m LocateResult) -> LocateResult -> m LocateResult
forall a b. (a -> b) -> a -> b
$ UnitId -> NormalizedFilePath -> LocateResult
LocateFoundFile UnitId
uid NormalizedFilePath
file
  where
    go :: (t, NormalizedFilePath) -> m (Maybe (t, NormalizedFilePath))
go (t
uid, NormalizedFilePath
candidate) = (Maybe NormalizedFilePath -> Maybe (t, NormalizedFilePath))
-> m (Maybe NormalizedFilePath)
-> m (Maybe (t, NormalizedFilePath))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t
uid,) <$>) (m (Maybe NormalizedFilePath) -> m (Maybe (t, NormalizedFilePath)))
-> m (Maybe NormalizedFilePath)
-> m (Maybe (t, NormalizedFilePath))
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-boot"
      | Bool
otherwise = String
ext

-- | This function is used to map a package name to a set of import paths.
-- It only returns Just for unit-ids which are possible to import into the
-- current module. In particular, it will return Nothing for 'main' components
-- as they can never be imported into another package.
mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (UnitId, ([FilePath], S.Set ModuleName))
#if MIN_VERSION_ghc(9,11,0)
mkImportDirs _env (i, flags) = Just (i, (importPaths flags, S.fromList $ map reexportTo $ reexportedModules flags))
#else
mkImportDirs :: HscEnv
-> (UnitId, DynFlags) -> Maybe (UnitId, ([String], Set ModuleName))
mkImportDirs HscEnv
_env (UnitId
i, DynFlags
flags) = (UnitId, ([String], Set ModuleName))
-> Maybe (UnitId, ([String], Set ModuleName))
forall a. a -> Maybe a
Just (UnitId
i, (DynFlags -> [String]
importPaths DynFlags
flags, DynFlags -> Set ModuleName
reexportedModules DynFlags
flags))
#endif

-- | locate a module in either the file system or the package database. Where we go from *daml to
-- Haskell
locateModule
    :: MonadIO m
    => HscEnv
    -> [(UnitId, DynFlags)] -- ^ Import directories
    -> [String]                        -- ^ File extensions
    -> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath))  -- ^ does file exist predicate
    -> Located ModuleName              -- ^ Module name
    -> PkgQual                -- ^ Package name
    -> Bool                            -- ^ Is boot module
    -> m (Either [FileDiagnostic] Import)
locateModule :: forall (m :: * -> *).
MonadIO m =>
HscEnv
-> [(UnitId, DynFlags)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> PkgQual
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule HscEnv
env [(UnitId, DynFlags)]
comp_info [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Located ModuleName
modName PkgQual
mbPkgName Bool
isSource = do
  case PkgQual
mbPkgName of
    -- 'ThisPkg' just means some home module, not the current unit
    ThisPkg UnitId
uid
      | Just ([String]
dirs, Set ModuleName
reexports) <- UnitId
-> [(UnitId, ([String], Set ModuleName))]
-> Maybe ([String], Set ModuleName)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup UnitId
uid [(UnitId, ([String], Set ModuleName))]
import_paths
          -> UnitId
-> [String] -> Set ModuleName -> m (Either [FileDiagnostic] Import)
lookupLocal UnitId
uid [String]
dirs Set ModuleName
reexports
      | Bool
otherwise -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a. a -> m a
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 []
    -- if a package name is given we only go look for a package
    OtherPkg UnitId
uid
      | Just ([String]
dirs, Set ModuleName
reexports) <- UnitId
-> [(UnitId, ([String], Set ModuleName))]
-> Maybe ([String], Set ModuleName)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup UnitId
uid [(UnitId, ([String], Set ModuleName))]
import_paths
          -> UnitId
-> [String] -> Set ModuleName -> m (Either [FileDiagnostic] Import)
lookupLocal UnitId
uid [String]
dirs Set ModuleName
reexports
      | Bool
otherwise -> m (Either [FileDiagnostic] Import)
lookupInPackageDB
    PkgQual
NoPkgQual -> do

      -- Reexports for current unit have to be empty because they only apply to other units depending on the
      -- current unit. If we set the reexports to be the actual reexports then we risk looping forever trying
      -- to find the module from the perspective of the current unit.
      LocateResult
mbFile <- [(UnitId, [String], Set ModuleName)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m LocateResult
forall (m :: * -> *).
MonadIO m =>
[(UnitId, [String], Set ModuleName)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m LocateResult
locateModuleFile ((DynFlags -> UnitId
homeUnitId_ DynFlags
dflags, DynFlags -> [String]
importPaths DynFlags
dflags, Set ModuleName
forall a. Set a
S.empty) (UnitId, [String], Set ModuleName)
-> [(UnitId, [String], Set ModuleName)]
-> [(UnitId, [String], Set ModuleName)]
forall a. a -> [a] -> [a]
: [(UnitId, [String], Set ModuleName)]
other_imports) [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Bool
isSource (ModuleName -> m LocateResult) -> ModuleName -> m LocateResult
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName
      case LocateResult
mbFile of
        LocateResult
LocateNotFound -> m (Either [FileDiagnostic] Import)
lookupInPackageDB
        -- Lookup again with the perspective of the unit reexporting the file
        LocateFoundReexport UnitId
uid -> HscEnv
-> [(UnitId, DynFlags)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> PkgQual
-> Bool
-> m (Either [FileDiagnostic] Import)
forall (m :: * -> *).
MonadIO m =>
HscEnv
-> [(UnitId, DynFlags)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> PkgQual
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule ((() :: Constraint) => UnitId -> HscEnv -> HscEnv
UnitId -> HscEnv -> HscEnv
hscSetActiveUnitId UnitId
uid HscEnv
env) [(UnitId, DynFlags)]
comp_info [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Located ModuleName
modName PkgQual
noPkgQual Bool
isSource
        LocateFoundFile UnitId
uid NormalizedFilePath
file -> UnitId -> NormalizedFilePath -> m (Either [FileDiagnostic] Import)
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 :: [(UnitId, ([String], Set ModuleName))]
import_paths = ((UnitId, DynFlags) -> Maybe (UnitId, ([String], Set ModuleName)))
-> [(UnitId, DynFlags)] -> [(UnitId, ([String], Set ModuleName))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HscEnv
-> (UnitId, DynFlags) -> Maybe (UnitId, ([String], Set ModuleName))
mkImportDirs HscEnv
env) [(UnitId, DynFlags)]
comp_info
    other_imports :: [(UnitId, [String], Set ModuleName)]
other_imports =
#if MIN_VERSION_ghc(9,4,0)
      -- On 9.4+ instead of bringing all the units into scope, only bring into scope the units
      -- this one depends on
      -- This way if you have multiple units with the same module names, we won't get confused
      -- For example if unit a imports module M from unit B, when there is also a module M in unit C,
      -- and unit a only depends on unit b, without this logic there is the potential to get confused
      -- about which module unit a imports.
      -- Without multi-component support it is hard to recontruct the dependency environment so
      -- unit a will have both unit b and unit c in scope.
#if MIN_VERSION_ghc(9,11,0)
      map (\uid -> let this_df = homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue) in (uid, importPaths this_df, S.fromList $ map reexportTo $ reexportedModules this_df)) hpt_deps
#else
      (UnitId -> (UnitId, [String], Set ModuleName))
-> [UnitId] -> [(UnitId, [String], Set ModuleName)]
forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
uid -> let this_df :: DynFlags
this_df = HomeUnitEnv -> DynFlags
homeUnitEnv_dflags ((() :: Constraint) => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
ue) in (UnitId
uid, DynFlags -> [String]
importPaths DynFlags
this_df, DynFlags -> Set ModuleName
reexportedModules DynFlags
this_df)) [UnitId]
hpt_deps
#endif
    ue :: UnitEnv
ue = HscEnv -> UnitEnv
hsc_unit_env HscEnv
env
    units :: UnitState
units = HomeUnitEnv -> UnitState
homeUnitEnv_units (HomeUnitEnv -> UnitState) -> HomeUnitEnv -> UnitState
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv (DynFlags -> UnitId
homeUnitId_ DynFlags
dflags) UnitEnv
ue
    hpt_deps :: [UnitId]
    hpt_deps :: [UnitId]
hpt_deps = UnitState -> [UnitId]
homeUnitDepends UnitState
units
#else
      _import_paths'
#endif

      -- first try to find the module as a file. If we can't find it try to find it in the package
      -- database.
      -- Here the importPaths for the current modules are added to the front of the import paths from the other components.
      -- This is particularly important for Paths_* modules which get generated for every component but unless you use it in
      -- each component will end up being found in the wrong place and cause a multi-cradle match failure.
    _import_paths' :: [(UnitId, ([String], Set ModuleName))]
_import_paths' = -- import_paths' is only used in GHC < 9.4
            [(UnitId, ([String], Set ModuleName))]
import_paths

    toModLocation :: UnitId -> NormalizedFilePath -> m (Either a Import)
toModLocation UnitId
uid NormalizedFilePath
file = IO (Either a Import) -> m (Either a Import)
forall a. IO a -> m a
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 -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName) (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file)
        let genMod :: Module
genMod = GenUnit UnitId -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (Definite UnitId -> GenUnit UnitId
forall uid. Definite uid -> GenUnit uid
RealUnit (Definite UnitId -> GenUnit UnitId)
-> Definite UnitId -> GenUnit UnitId
forall a b. (a -> b) -> a -> b
$ UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
uid) (Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName)  -- TODO support backpack holes
        Either a Import -> IO (Either a Import)
forall a. a -> IO a
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 -> Maybe Module -> ArtifactsLocation
ArtifactsLocation NormalizedFilePath
file (ModLocation -> Maybe ModLocation
forall a. a -> Maybe a
Just ModLocation
loc) (Bool -> Bool
not Bool
isSource) (Module -> Maybe Module
forall a. a -> Maybe a
Just Module
genMod)

    lookupLocal :: UnitId
-> [String] -> Set ModuleName -> m (Either [FileDiagnostic] Import)
lookupLocal UnitId
uid [String]
dirs Set ModuleName
reexports = do
      LocateResult
mbFile <- [(UnitId, [String], Set ModuleName)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m LocateResult
forall (m :: * -> *).
MonadIO m =>
[(UnitId, [String], Set ModuleName)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Bool
-> ModuleName
-> m LocateResult
locateModuleFile [(UnitId
uid, [String]
dirs, Set ModuleName
reexports)] [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Bool
isSource (ModuleName -> m LocateResult) -> ModuleName -> m LocateResult
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName
      case LocateResult
mbFile of
        LocateResult
LocateNotFound -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a. a -> m a
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 []
        -- Lookup again with the perspective of the unit reexporting the file
        LocateFoundReexport UnitId
uid' -> HscEnv
-> [(UnitId, DynFlags)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> PkgQual
-> Bool
-> m (Either [FileDiagnostic] Import)
forall (m :: * -> *).
MonadIO m =>
HscEnv
-> [(UnitId, DynFlags)]
-> [String]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> PkgQual
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule ((() :: Constraint) => UnitId -> HscEnv -> HscEnv
UnitId -> HscEnv -> HscEnv
hscSetActiveUnitId UnitId
uid' HscEnv
env) [(UnitId, DynFlags)]
comp_info [String]
exts ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)
targetFor Located ModuleName
modName PkgQual
noPkgQual Bool
isSource
        LocateFoundFile UnitId
uid' NormalizedFilePath
file -> UnitId -> NormalizedFilePath -> m (Either [FileDiagnostic] Import)
forall {m :: * -> *} {a}.
MonadIO m =>
UnitId -> NormalizedFilePath -> m (Either a Import)
toModLocation UnitId
uid' NormalizedFilePath
file

    lookupInPackageDB :: m (Either [FileDiagnostic] Import)
lookupInPackageDB = do
      case HscEnv -> ModuleName -> PkgQual -> LookupResult
Compat.lookupModuleWithSuggestions HscEnv
env (Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName) PkgQual
mbPkgName of
        LookupFound Module
_m (UnitInfo, ModuleOrigin)
_pkgConfig -> Either [FileDiagnostic] Import
-> m (Either [FileDiagnostic] Import)
forall a. a -> m a
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 a. a -> m a
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

-- | Don't call this on a found module.
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' String
doc = Text
-> DiagnosticSeverity
-> SrcSpan
-> String
-> Maybe (MsgEnvelope GhcMessage)
-> [FileDiagnostic]
diagFromString Text
"not found" DiagnosticSeverity
DiagnosticSeverity_Error (Located ModuleName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
Compat.getLoc Located ModuleName
modName) String
doc Maybe (MsgEnvelope GhcMessage)
forall a. Maybe a
Nothing
    modName0 :: ModuleName
modName0 = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
modName
    ppr' :: SDoc -> String
ppr' = DynFlags -> SDoc -> String
showSDoc DynFlags
dfs
    -- We convert the lookup result to a find result to reuse GHC's cannotFindModule pretty printer.
    lookupToFindResult :: LookupResult -> FindResult
lookupToFindResult =
      \case
        LookupFound Module
_m (UnitInfo, ModuleOrigin)
_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 = map (moduleUnit . fst) pkg_hiddens
             , fr_mods_hidden = map (moduleUnit . fst) mod_hiddens
             }
        LookupUnusable [(Module, ModuleOrigin)]
unusable ->
          let unusables' :: [(GenUnit UnitId, UnusableUnitReason)]
unusables' = ((Module, ModuleOrigin) -> (GenUnit UnitId, UnusableUnitReason))
-> [(Module, ModuleOrigin)]
-> [(GenUnit UnitId, UnusableUnitReason)]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> (GenUnit UnitId, UnusableUnitReason)
forall {a}. (GenModule a, ModuleOrigin) -> (a, UnusableUnitReason)
get_unusable [(Module, ModuleOrigin)]
unusable
#if MIN_VERSION_ghc(9,6,4) && (!MIN_VERSION_ghc(9,8,1) || MIN_VERSION_ghc(9,8,2))
              get_unusable (_m, ModUnusable r) = r
#else
              get_unusable :: (GenModule a, ModuleOrigin) -> (a, UnusableUnitReason)
get_unusable (GenModule a
m, ModUnusable UnusableUnitReason
r) = (GenModule a -> a
forall unit. GenModule unit -> unit
moduleUnit GenModule a
m, UnusableUnitReason
r)
#endif
              get_unusable (GenModule a
_, ModuleOrigin
r) =
                String -> SDoc -> (a, UnusableUnitReason)
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 = unusables'}
        LookupNotFound [ModuleSuggestion]
suggest ->
          FindResult
notFound {fr_suggestions = suggest}

notFound :: FindResult
notFound :: FindResult
notFound = NotFound
  { fr_paths :: [String]
fr_paths = []
  , fr_pkg :: Maybe (GenUnit UnitId)
fr_pkg = Maybe (GenUnit UnitId)
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 = []
  }

noPkgQual :: PkgQual
noPkgQual :: PkgQual
noPkgQual = PkgQual
NoPkgQual