{-
(c) The University of Glasgow, 2000-2006

-}


{-# LANGUAGE FlexibleContexts #-}

-- | Module finder
module GHC.Unit.Finder (
    FindResult(..),
    InstalledFindResult(..),
    FinderOpts(..),
    FinderCache,
    initFinderCache,
    flushFinderCaches,
    findImportedModule,
    findPluginModule,
    findExactModule,
    findHomeModule,
    findExposedPackageModule,
    mkHomeModLocation,
    mkHomeModLocation2,
    mkHiOnlyModLocation,
    mkHiPath,
    mkObjPath,
    addModuleToFinder,
    addHomeModuleToFinder,
    uncacheModule,
    mkStubPaths,

    findObjectLinkableMaybe,
    findObjectLinkable,

    -- Hash cache
    lookupFileCache
  ) where

import GHC.Prelude

import GHC.Platform.Ways

import GHC.Builtin.Names ( gHC_PRIM )

import GHC.Unit.Env
import GHC.Unit.Types
import GHC.Unit.Module
import GHC.Unit.Home
import GHC.Unit.State
import GHC.Unit.Finder.Types

import GHC.Data.Maybe    ( expectJust )
import qualified GHC.Data.ShortText as ST

import GHC.Utils.Misc
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic

import GHC.Linker.Types
import GHC.Types.PkgQual

import GHC.Fingerprint
import Data.IORef
import System.Directory
import System.FilePath
import Control.Monad
import Data.Time
import qualified Data.Map as M
import GHC.Driver.Env
    ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) )
import GHC.Driver.Config.Finder
import qualified Data.Set as Set

type FileExt = String   -- Filename extension
type BaseName = String  -- Basename of file

-- -----------------------------------------------------------------------------
-- The Finder

-- The Finder provides a thin filesystem abstraction to the rest of
-- the compiler.  For a given module, it can tell you where the
-- source, interface, and object files for that module live.

-- It does *not* know which particular package a module lives in.  Use
-- Packages.lookupModuleInAllUnits for that.

-- -----------------------------------------------------------------------------
-- The finder's cache


initFinderCache :: IO FinderCache
initFinderCache :: IO FinderCache
initFinderCache = IORef FinderCacheState -> IORef FileCacheState -> FinderCache
FinderCache (IORef FinderCacheState -> IORef FileCacheState -> FinderCache)
-> IO (IORef FinderCacheState)
-> IO (IORef FileCacheState -> FinderCache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinderCacheState -> IO (IORef FinderCacheState)
forall a. a -> IO (IORef a)
newIORef FinderCacheState
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv
                              IO (IORef FileCacheState -> FinderCache)
-> IO (IORef FileCacheState) -> IO FinderCache
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileCacheState -> IO (IORef FileCacheState)
forall a. a -> IO (IORef a)
newIORef FileCacheState
forall k a. Map k a
M.empty

-- remove all the home modules from the cache; package modules are
-- assumed to not move around during a session; also flush the file hash
-- cache
flushFinderCaches :: FinderCache -> UnitEnv -> IO ()
flushFinderCaches :: FinderCache -> UnitEnv -> IO ()
flushFinderCaches (FinderCache IORef FinderCacheState
ref IORef FileCacheState
file_ref) UnitEnv
ue = do
  IORef FinderCacheState
-> (FinderCacheState -> (FinderCacheState, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FinderCacheState
ref ((FinderCacheState -> (FinderCacheState, ())) -> IO ())
-> (FinderCacheState -> (FinderCacheState, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FinderCacheState
fm -> ((InstalledModule -> InstalledFindResult -> Bool)
-> FinderCacheState -> FinderCacheState
forall a.
(InstalledModule -> a -> Bool)
-> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv InstalledModule -> InstalledFindResult -> Bool
is_ext FinderCacheState
fm, ())
  IORef FileCacheState
-> (FileCacheState -> (FileCacheState, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FileCacheState
file_ref ((FileCacheState -> (FileCacheState, ())) -> IO ())
-> (FileCacheState -> (FileCacheState, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FileCacheState
_ -> (FileCacheState
forall k a. Map k a
M.empty, ())
 where
  is_ext :: InstalledModule -> InstalledFindResult -> Bool
is_ext InstalledModule
mod InstalledFindResult
_ = Bool -> Bool
not (UnitEnv -> InstalledModule -> Bool
isUnitEnvInstalledModule UnitEnv
ue InstalledModule
mod)

addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache (FinderCache IORef FinderCacheState
ref IORef FileCacheState
_) InstalledModule
key InstalledFindResult
val =
  IORef FinderCacheState
-> (FinderCacheState -> (FinderCacheState, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FinderCacheState
ref ((FinderCacheState -> (FinderCacheState, ())) -> IO ())
-> (FinderCacheState -> (FinderCacheState, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FinderCacheState
c -> (FinderCacheState
-> InstalledModule -> InstalledFindResult -> FinderCacheState
forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv FinderCacheState
c InstalledModule
key InstalledFindResult
val, ())

removeFromFinderCache :: FinderCache -> InstalledModule -> IO ()
removeFromFinderCache :: FinderCache -> InstalledModule -> IO ()
removeFromFinderCache (FinderCache IORef FinderCacheState
ref IORef FileCacheState
_) InstalledModule
key =
  IORef FinderCacheState
-> (FinderCacheState -> (FinderCacheState, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FinderCacheState
ref ((FinderCacheState -> (FinderCacheState, ())) -> IO ())
-> (FinderCacheState -> (FinderCacheState, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FinderCacheState
c -> (FinderCacheState -> InstalledModule -> FinderCacheState
forall a.
InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
delInstalledModuleEnv FinderCacheState
c InstalledModule
key, ())

lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache (FinderCache IORef FinderCacheState
ref IORef FileCacheState
_) InstalledModule
key = do
   FinderCacheState
c <- IORef FinderCacheState -> IO FinderCacheState
forall a. IORef a -> IO a
readIORef IORef FinderCacheState
ref
   Maybe InstalledFindResult -> IO (Maybe InstalledFindResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe InstalledFindResult -> IO (Maybe InstalledFindResult))
-> Maybe InstalledFindResult -> IO (Maybe InstalledFindResult)
forall a b. (a -> b) -> a -> b
$! FinderCacheState -> InstalledModule -> Maybe InstalledFindResult
forall a. InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv FinderCacheState
c InstalledModule
key

lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint
lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint
lookupFileCache (FinderCache IORef FinderCacheState
_ IORef FileCacheState
ref) FilePath
key = do
   FileCacheState
c <- IORef FileCacheState -> IO FileCacheState
forall a. IORef a -> IO a
readIORef IORef FileCacheState
ref
   case FilePath -> FileCacheState -> Maybe Fingerprint
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
key FileCacheState
c of
     Maybe Fingerprint
Nothing -> do
       Fingerprint
hash <- FilePath -> IO Fingerprint
getFileHash FilePath
key
       IORef FileCacheState
-> (FileCacheState -> (FileCacheState, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FileCacheState
ref ((FileCacheState -> (FileCacheState, ())) -> IO ())
-> (FileCacheState -> (FileCacheState, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FileCacheState
c -> (FilePath -> Fingerprint -> FileCacheState -> FileCacheState
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
key Fingerprint
hash FileCacheState
c, ())
       Fingerprint -> IO Fingerprint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fingerprint
hash
     Just Fingerprint
fp -> Fingerprint -> IO Fingerprint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fingerprint
fp

-- -----------------------------------------------------------------------------
-- The three external entry points


-- | Locate a module that was imported by the user.  We have the
-- module's name, and possibly a package name.  Without a package
-- name, this function will use the search path and the known exposed
-- packages to find the module, if a package is specified then only
-- that package is searched for the module.

findImportedModule :: HscEnv -> ModuleName -> PkgQual -> IO FindResult
findImportedModule :: HscEnv -> ModuleName -> PkgQual -> IO FindResult
findImportedModule HscEnv
hsc_env ModuleName
mod PkgQual
pkg_qual =
  let fc :: FinderCache
fc        = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
      mhome_unit :: Maybe HomeUnit
mhome_unit = HscEnv -> Maybe HomeUnit
hsc_home_unit_maybe HscEnv
hsc_env
      dflags :: DynFlags
dflags    = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
      fopts :: FinderOpts
fopts     = DynFlags -> FinderOpts
initFinderOpts DynFlags
dflags
  in do
    FinderCache
-> FinderOpts
-> UnitEnv
-> Maybe HomeUnit
-> ModuleName
-> PkgQual
-> IO FindResult
findImportedModuleNoHsc FinderCache
fc FinderOpts
fopts (HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env) Maybe HomeUnit
mhome_unit ModuleName
mod PkgQual
pkg_qual

findImportedModuleNoHsc
  :: FinderCache
  -> FinderOpts
  -> UnitEnv
  -> Maybe HomeUnit
  -> ModuleName
  -> PkgQual
  -> IO FindResult
findImportedModuleNoHsc :: FinderCache
-> FinderOpts
-> UnitEnv
-> Maybe HomeUnit
-> ModuleName
-> PkgQual
-> IO FindResult
findImportedModuleNoHsc FinderCache
fc FinderOpts
fopts UnitEnv
ue Maybe HomeUnit
mhome_unit ModuleName
mod_name PkgQual
mb_pkg =
  case PkgQual
mb_pkg of
    PkgQual
NoPkgQual  -> IO FindResult
unqual_import
    ThisPkg UnitId
uid | (HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId (HomeUnit -> UnitId) -> Maybe HomeUnit -> Maybe UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HomeUnit
mhome_unit) Maybe UnitId -> Maybe UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just UnitId
uid -> IO FindResult
home_import
                | Just FinderOpts
os <- UnitId -> [(UnitId, FinderOpts)] -> Maybe FinderOpts
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup UnitId
uid [(UnitId, FinderOpts)]
other_fopts -> (UnitId, FinderOpts) -> IO FindResult
home_pkg_import (UnitId
uid, FinderOpts
os)
                | Bool
otherwise -> FilePath -> SDoc -> IO FindResult
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"findImportModule" (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ PkgQual -> SDoc
forall a. Outputable a => a -> SDoc
ppr PkgQual
mb_pkg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Maybe UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId (HomeUnit -> UnitId) -> Maybe HomeUnit -> Maybe UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HomeUnit
mhome_unit) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [UnitId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (((UnitId, FinderOpts) -> UnitId)
-> [(UnitId, FinderOpts)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, FinderOpts) -> UnitId
forall a b. (a, b) -> a
fst [(UnitId, FinderOpts)]
all_opts))
    OtherPkg UnitId
_ -> IO FindResult
pkg_import
  where
    all_opts :: [(UnitId, FinderOpts)]
all_opts = case Maybe HomeUnit
mhome_unit of
                Maybe HomeUnit
Nothing -> [(UnitId, FinderOpts)]
other_fopts
                Just HomeUnit
home_unit -> (HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId HomeUnit
home_unit, FinderOpts
fopts) (UnitId, FinderOpts)
-> [(UnitId, FinderOpts)] -> [(UnitId, FinderOpts)]
forall a. a -> [a] -> [a]
: [(UnitId, FinderOpts)]
other_fopts


    home_import :: IO FindResult
home_import = case Maybe HomeUnit
mhome_unit of
                   Just HomeUnit
home_unit -> FinderCache
-> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult
findHomeModule FinderCache
fc FinderOpts
fopts HomeUnit
home_unit ModuleName
mod_name
                   Maybe HomeUnit
Nothing -> FindResult -> IO FindResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FindResult -> IO FindResult) -> FindResult -> IO FindResult
forall a b. (a -> b) -> a -> b
$ Unit -> FindResult
NoPackage (FilePath -> Unit
forall a. HasCallStack => FilePath -> a
panic FilePath
"findImportedModule: no home-unit")


    home_pkg_import :: (UnitId, FinderOpts) -> IO FindResult
home_pkg_import (UnitId
uid, FinderOpts
opts)
      -- If the module is reexported, then look for it as if it was from the perspective
      -- of that package which reexports it.
      | ModuleName
mod_name ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` FinderOpts -> Set ModuleName
finder_reexportedModules FinderOpts
opts =
        FinderCache
-> FinderOpts
-> UnitEnv
-> Maybe HomeUnit
-> ModuleName
-> PkgQual
-> IO FindResult
findImportedModuleNoHsc FinderCache
fc FinderOpts
opts UnitEnv
ue (HomeUnit -> Maybe HomeUnit
forall a. a -> Maybe a
Just (HomeUnit -> Maybe HomeUnit) -> HomeUnit -> Maybe HomeUnit
forall a b. (a -> b) -> a -> b
$ UnitId -> Maybe (UnitId, GenInstantiations UnitId) -> HomeUnit
forall u. UnitId -> Maybe (u, GenInstantiations u) -> GenHomeUnit u
DefiniteHomeUnit UnitId
uid Maybe (UnitId, GenInstantiations UnitId)
forall a. Maybe a
Nothing) ModuleName
mod_name PkgQual
NoPkgQual
      | ModuleName
mod_name ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` FinderOpts -> Set ModuleName
finder_hiddenModules FinderOpts
opts =
        FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId -> FindResult
mkHomeHidden UnitId
uid)
      | Bool
otherwise =
        FinderCache -> FinderOpts -> UnitId -> ModuleName -> IO FindResult
findHomePackageModule FinderCache
fc FinderOpts
opts UnitId
uid ModuleName
mod_name

    -- Do not be smart and change this to `foldr orIfNotFound home_import hs` as
    -- that is not the same!! home_import is first because we need to look within ourselves
    -- first before looking at the packages in order.
    any_home_import :: IO FindResult
any_home_import = (IO FindResult -> IO FindResult -> IO FindResult)
-> [IO FindResult] -> IO FindResult
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 IO FindResult -> IO FindResult -> IO FindResult
forall (m :: * -> *).
Monad m =>
m FindResult -> m FindResult -> m FindResult
orIfNotFound (IO FindResult
home_importIO FindResult -> [IO FindResult] -> [IO FindResult]
forall a. a -> [a] -> [a]
: ((UnitId, FinderOpts) -> IO FindResult)
-> [(UnitId, FinderOpts)] -> [IO FindResult]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, FinderOpts) -> IO FindResult
home_pkg_import [(UnitId, FinderOpts)]
other_fopts)

    pkg_import :: IO FindResult
pkg_import    = FinderCache
-> FinderOpts
-> UnitState
-> ModuleName
-> PkgQual
-> IO FindResult
findExposedPackageModule FinderCache
fc FinderOpts
fopts UnitState
units  ModuleName
mod_name PkgQual
mb_pkg

    unqual_import :: IO FindResult
unqual_import = IO FindResult
any_home_import
                    IO FindResult -> IO FindResult -> IO FindResult
forall (m :: * -> *).
Monad m =>
m FindResult -> m FindResult -> m FindResult
`orIfNotFound`
                    FinderCache
-> FinderOpts
-> UnitState
-> ModuleName
-> PkgQual
-> IO FindResult
findExposedPackageModule FinderCache
fc FinderOpts
fopts UnitState
units ModuleName
mod_name PkgQual
NoPkgQual

    units :: UnitState
units     = case Maybe HomeUnit
mhome_unit of
                  Maybe HomeUnit
Nothing -> (() :: Constraint) => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
ue
                  Just HomeUnit
home_unit -> HomeUnitEnv -> UnitState
homeUnitEnv_units (HomeUnitEnv -> UnitState) -> HomeUnitEnv -> UnitState
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv (HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId HomeUnit
home_unit) UnitEnv
ue
    hpt_deps :: [UnitId]
    hpt_deps :: [UnitId]
hpt_deps  = UnitState -> [UnitId]
homeUnitDepends UnitState
units
    other_fopts :: [(UnitId, FinderOpts)]
other_fopts  = (UnitId -> (UnitId, FinderOpts))
-> [UnitId] -> [(UnitId, FinderOpts)]
forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
uid -> (UnitId
uid, DynFlags -> FinderOpts
initFinderOpts (HomeUnitEnv -> DynFlags
homeUnitEnv_dflags ((() :: Constraint) => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
ue)))) [UnitId]
hpt_deps

-- | Locate a plugin module requested by the user, for a compiler
-- plugin.  This consults the same set of exposed packages as
-- 'findImportedModule', unless @-hide-all-plugin-packages@ or
-- @-plugin-package@ are specified.
findPluginModule :: FinderCache -> FinderOpts -> UnitState -> Maybe HomeUnit -> ModuleName -> IO FindResult
findPluginModule :: FinderCache
-> FinderOpts
-> UnitState
-> Maybe HomeUnit
-> ModuleName
-> IO FindResult
findPluginModule FinderCache
fc FinderOpts
fopts UnitState
units (Just HomeUnit
home_unit) ModuleName
mod_name =
  FinderCache
-> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult
findHomeModule FinderCache
fc FinderOpts
fopts HomeUnit
home_unit ModuleName
mod_name
  IO FindResult -> IO FindResult -> IO FindResult
forall (m :: * -> *).
Monad m =>
m FindResult -> m FindResult -> m FindResult
`orIfNotFound`
  FinderCache
-> FinderOpts -> UnitState -> ModuleName -> IO FindResult
findExposedPluginPackageModule FinderCache
fc FinderOpts
fopts UnitState
units ModuleName
mod_name
findPluginModule FinderCache
fc FinderOpts
fopts UnitState
units Maybe HomeUnit
Nothing ModuleName
mod_name =
  FinderCache
-> FinderOpts -> UnitState -> ModuleName -> IO FindResult
findExposedPluginPackageModule FinderCache
fc FinderOpts
fopts UnitState
units ModuleName
mod_name

-- | Locate a specific 'Module'.  The purpose of this function is to
-- create a 'ModLocation' for a given 'Module', that is to find out
-- where the files associated with this module live.  It is used when
-- reading the interface for a module mentioned by another interface,
-- for example (a "system import").

findExactModule :: FinderCache -> FinderOpts ->  UnitEnvGraph FinderOpts -> UnitState -> Maybe HomeUnit -> InstalledModule -> IO InstalledFindResult
findExactModule :: FinderCache
-> FinderOpts
-> UnitEnvGraph FinderOpts
-> UnitState
-> Maybe HomeUnit
-> InstalledModule
-> IO InstalledFindResult
findExactModule FinderCache
fc FinderOpts
fopts UnitEnvGraph FinderOpts
other_fopts UnitState
unit_state Maybe HomeUnit
mhome_unit InstalledModule
mod = do
  case Maybe HomeUnit
mhome_unit of
    Just HomeUnit
home_unit
     | HomeUnit -> InstalledModule -> Bool
forall u. GenHomeUnit u -> InstalledModule -> Bool
isHomeInstalledModule HomeUnit
home_unit InstalledModule
mod
        -> FinderCache
-> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule FinderCache
fc FinderOpts
fopts (HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId HomeUnit
home_unit) (InstalledModule -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)
     | Just FinderOpts
home_fopts <- UnitId -> UnitEnvGraph FinderOpts -> Maybe FinderOpts
forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe (InstalledModule -> UnitId
forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod) UnitEnvGraph FinderOpts
other_fopts
        -> FinderCache
-> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule FinderCache
fc FinderOpts
home_fopts (InstalledModule -> UnitId
forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod) (InstalledModule -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)
    Maybe HomeUnit
_ -> FinderCache
-> UnitState
-> FinderOpts
-> InstalledModule
-> IO InstalledFindResult
findPackageModule FinderCache
fc UnitState
unit_state FinderOpts
fopts InstalledModule
mod

-- -----------------------------------------------------------------------------
-- Helpers

-- | Given a monadic actions @this@ and @or_this@, first execute
-- @this@.  If the returned 'FindResult' is successful, return
-- it; otherwise, execute @or_this@.  If both failed, this function
-- also combines their failure messages in a reasonable way.
orIfNotFound :: Monad m => m FindResult -> m FindResult -> m FindResult
orIfNotFound :: forall (m :: * -> *).
Monad m =>
m FindResult -> m FindResult -> m FindResult
orIfNotFound m FindResult
this m FindResult
or_this = do
  FindResult
res <- m FindResult
this
  case FindResult
res of
    NotFound { fr_paths :: FindResult -> [FilePath]
fr_paths = [FilePath]
paths1, fr_mods_hidden :: FindResult -> [Unit]
fr_mods_hidden = [Unit]
mh1
             , fr_pkgs_hidden :: FindResult -> [Unit]
fr_pkgs_hidden = [Unit]
ph1, fr_unusables :: FindResult -> [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
u1, fr_suggestions :: FindResult -> [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
s1 }
     -> do FindResult
res2 <- m FindResult
or_this
           case FindResult
res2 of
             NotFound { fr_paths :: FindResult -> [FilePath]
fr_paths = [FilePath]
paths2, fr_pkg :: FindResult -> Maybe Unit
fr_pkg = Maybe Unit
mb_pkg2, fr_mods_hidden :: FindResult -> [Unit]
fr_mods_hidden = [Unit]
mh2
                      , fr_pkgs_hidden :: FindResult -> [Unit]
fr_pkgs_hidden = [Unit]
ph2, fr_unusables :: FindResult -> [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
u2
                      , fr_suggestions :: FindResult -> [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
s2 }
              -> FindResult -> m FindResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound { fr_paths :: [FilePath]
fr_paths = [FilePath]
paths1 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
paths2
                                  , fr_pkg :: Maybe Unit
fr_pkg = Maybe Unit
mb_pkg2 -- snd arg is the package search
                                  , fr_mods_hidden :: [Unit]
fr_mods_hidden = [Unit]
mh1 [Unit] -> [Unit] -> [Unit]
forall a. [a] -> [a] -> [a]
++ [Unit]
mh2
                                  , fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = [Unit]
ph1 [Unit] -> [Unit] -> [Unit]
forall a. [a] -> [a] -> [a]
++ [Unit]
ph2
                                  , fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
u1 [(Unit, UnusableUnitReason)]
-> [(Unit, UnusableUnitReason)] -> [(Unit, UnusableUnitReason)]
forall a. [a] -> [a] -> [a]
++ [(Unit, UnusableUnitReason)]
u2
                                  , fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
s1  [ModuleSuggestion] -> [ModuleSuggestion] -> [ModuleSuggestion]
forall a. [a] -> [a] -> [a]
++ [ModuleSuggestion]
s2 })
             FindResult
_other -> FindResult -> m FindResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FindResult
res2
    FindResult
_other -> FindResult -> m FindResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FindResult
res

-- | Helper function for 'findHomeModule': this function wraps an IO action
-- which would look up @mod_name@ in the file system (the home package),
-- and first consults the 'hsc_FC' cache to see if the lookup has already
-- been done.  Otherwise, do the lookup (with the IO action) and save
-- the result in the finder cache and the module location cache (if it
-- was successful.)
homeSearchCache :: FinderCache -> UnitId -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
homeSearchCache :: FinderCache
-> UnitId
-> ModuleName
-> IO InstalledFindResult
-> IO InstalledFindResult
homeSearchCache FinderCache
fc UnitId
home_unit ModuleName
mod_name IO InstalledFindResult
do_this = do
  let mod :: InstalledModule
mod = UnitId -> ModuleName -> InstalledModule
forall u. u -> ModuleName -> GenModule u
mkModule UnitId
home_unit ModuleName
mod_name
  FinderCache
-> InstalledModule
-> IO InstalledFindResult
-> IO InstalledFindResult
modLocationCache FinderCache
fc InstalledModule
mod IO InstalledFindResult
do_this

findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> PkgQual -> IO FindResult
findExposedPackageModule :: FinderCache
-> FinderOpts
-> UnitState
-> ModuleName
-> PkgQual
-> IO FindResult
findExposedPackageModule FinderCache
fc FinderOpts
fopts UnitState
units ModuleName
mod_name PkgQual
mb_pkg =
  FinderCache -> FinderOpts -> LookupResult -> IO FindResult
findLookupResult FinderCache
fc FinderOpts
fopts
    (LookupResult -> IO FindResult) -> LookupResult -> IO FindResult
forall a b. (a -> b) -> a -> b
$ UnitState -> ModuleName -> PkgQual -> LookupResult
lookupModuleWithSuggestions UnitState
units ModuleName
mod_name PkgQual
mb_pkg

findExposedPluginPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> IO FindResult
findExposedPluginPackageModule :: FinderCache
-> FinderOpts -> UnitState -> ModuleName -> IO FindResult
findExposedPluginPackageModule FinderCache
fc FinderOpts
fopts UnitState
units ModuleName
mod_name =
  FinderCache -> FinderOpts -> LookupResult -> IO FindResult
findLookupResult FinderCache
fc FinderOpts
fopts
    (LookupResult -> IO FindResult) -> LookupResult -> IO FindResult
forall a b. (a -> b) -> a -> b
$ UnitState -> ModuleName -> PkgQual -> LookupResult
lookupPluginModuleWithSuggestions UnitState
units ModuleName
mod_name PkgQual
NoPkgQual

findLookupResult :: FinderCache -> FinderOpts -> LookupResult -> IO FindResult
findLookupResult :: FinderCache -> FinderOpts -> LookupResult -> IO FindResult
findLookupResult FinderCache
fc FinderOpts
fopts LookupResult
r = case LookupResult
r of
     LookupFound Module
m (UnitInfo, ModuleOrigin)
pkg_conf -> do
       let im :: InstalledModule
im = (InstalledModule, Maybe InstantiatedModule) -> InstalledModule
forall a b. (a, b) -> a
fst (Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
m)
       InstalledFindResult
r' <- FinderCache
-> FinderOpts
-> InstalledModule
-> UnitInfo
-> IO InstalledFindResult
findPackageModule_ FinderCache
fc FinderOpts
fopts InstalledModule
im ((UnitInfo, ModuleOrigin) -> UnitInfo
forall a b. (a, b) -> a
fst (UnitInfo, ModuleOrigin)
pkg_conf)
       case InstalledFindResult
r' of
        -- TODO: ghc -M is unlikely to do the right thing
        -- with just the location of the thing that was
        -- instantiated; you probably also need all of the
        -- implicit locations from the instances
        InstalledFound ModLocation
loc   InstalledModule
_ -> FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> Module -> FindResult
Found ModLocation
loc Module
m)
        InstalledNoPackage   UnitId
_ -> FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Unit -> FindResult
NoPackage (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m))
        InstalledNotFound [FilePath]
fp Maybe UnitId
_ -> FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound{ fr_paths :: [FilePath]
fr_paths = [FilePath]
fp, fr_pkg :: Maybe Unit
fr_pkg = Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m)
                                         , fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = []
                                         , fr_mods_hidden :: [Unit]
fr_mods_hidden = []
                                         , fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = []
                                         , fr_suggestions :: [ModuleSuggestion]
fr_suggestions = []})
     LookupMultiple [(Module, ModuleOrigin)]
rs ->
       FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Module, ModuleOrigin)] -> FindResult
FoundMultiple [(Module, ModuleOrigin)]
rs)
     LookupHidden [(Module, ModuleOrigin)]
pkg_hiddens [(Module, ModuleOrigin)]
mod_hiddens ->
       FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound{ fr_paths :: [FilePath]
fr_paths = [], fr_pkg :: Maybe Unit
fr_pkg = Maybe Unit
forall a. Maybe a
Nothing
                       , fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = ((Module, ModuleOrigin) -> Unit)
-> [(Module, ModuleOrigin)] -> [Unit]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit(Module -> Unit)
-> ((Module, ModuleOrigin) -> Module)
-> (Module, ModuleOrigin)
-> Unit
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 :: [Unit]
fr_mods_hidden = ((Module, ModuleOrigin) -> Unit)
-> [(Module, ModuleOrigin)] -> [Unit]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit(Module -> Unit)
-> ((Module, ModuleOrigin) -> Module)
-> (Module, ModuleOrigin)
-> Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Module, ModuleOrigin) -> Module
forall a b. (a, b) -> a
fst) [(Module, ModuleOrigin)]
mod_hiddens
                       , fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = []
                       , fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [] })
     LookupUnusable [(Module, ModuleOrigin)]
unusable ->
       let unusables' :: [(Unit, UnusableUnitReason)]
unusables' = ((Module, ModuleOrigin) -> (Unit, UnusableUnitReason))
-> [(Module, ModuleOrigin)] -> [(Unit, UnusableUnitReason)]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> (Unit, UnusableUnitReason)
forall {a}. (GenModule a, ModuleOrigin) -> (a, UnusableUnitReason)
get_unusable [(Module, ModuleOrigin)]
unusable
           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)
           get_unusable (GenModule a
_, ModuleOrigin
r)             =
             FilePath -> SDoc -> (a, UnusableUnitReason)
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"findLookupResult: unexpected origin" (ModuleOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
r)
       in FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound{ fr_paths :: [FilePath]
fr_paths = [], fr_pkg :: Maybe Unit
fr_pkg = Maybe Unit
forall a. Maybe a
Nothing
                          , fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = []
                          , fr_mods_hidden :: [Unit]
fr_mods_hidden = []
                          , fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
unusables'
                          , fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [] })
     LookupNotFound [ModuleSuggestion]
suggest -> do
       let suggest' :: [ModuleSuggestion]
suggest'
             | FinderOpts -> Bool
finder_enableSuggestions FinderOpts
fopts = [ModuleSuggestion]
suggest
             | Bool
otherwise = []
       FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound{ fr_paths :: [FilePath]
fr_paths = [], fr_pkg :: Maybe Unit
fr_pkg = Maybe Unit
forall a. Maybe a
Nothing
                       , fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = []
                       , fr_mods_hidden :: [Unit]
fr_mods_hidden = []
                       , fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = []
                       , fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
suggest' })

modLocationCache :: FinderCache -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
modLocationCache :: FinderCache
-> InstalledModule
-> IO InstalledFindResult
-> IO InstalledFindResult
modLocationCache FinderCache
fc InstalledModule
mod IO InstalledFindResult
do_this = do
  Maybe InstalledFindResult
m <- FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache FinderCache
fc InstalledModule
mod
  case Maybe InstalledFindResult
m of
    Just InstalledFindResult
result -> InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledFindResult
result
    Maybe InstalledFindResult
Nothing     -> do
        InstalledFindResult
result <- IO InstalledFindResult
do_this
        FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache FinderCache
fc InstalledModule
mod InstalledFindResult
result
        InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledFindResult
result

addModuleToFinder :: FinderCache -> Module -> ModLocation -> IO ()
addModuleToFinder :: FinderCache -> Module -> ModLocation -> IO ()
addModuleToFinder FinderCache
fc Module
mod ModLocation
loc = do
  let imod :: InstalledModule
imod = Unit -> UnitId
toUnitId (Unit -> UnitId) -> Module -> InstalledModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module
mod
  FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache FinderCache
fc InstalledModule
imod (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound ModLocation
loc InstalledModule
imod)

-- This returns a module because it's more convenient for users
addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder FinderCache
fc HomeUnit
home_unit ModuleName
mod_name ModLocation
loc = do
  let mod :: InstalledModule
mod = HomeUnit -> ModuleName -> InstalledModule
forall u. GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule HomeUnit
home_unit ModuleName
mod_name
  FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache FinderCache
fc InstalledModule
mod (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound ModLocation
loc InstalledModule
mod)
  Module -> IO Module
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit ModuleName
mod_name)

uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO ()
uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO ()
uncacheModule FinderCache
fc HomeUnit
home_unit ModuleName
mod_name = do
  let mod :: InstalledModule
mod = HomeUnit -> ModuleName -> InstalledModule
forall u. GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule HomeUnit
home_unit ModuleName
mod_name
  FinderCache -> InstalledModule -> IO ()
removeFromFinderCache FinderCache
fc InstalledModule
mod

-- -----------------------------------------------------------------------------
--      The internal workers

findHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult
findHomeModule :: FinderCache
-> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult
findHomeModule FinderCache
fc FinderOpts
fopts  HomeUnit
home_unit ModuleName
mod_name = do
  let uid :: Unit
uid       = HomeUnit -> Unit
homeUnitAsUnit HomeUnit
home_unit
  InstalledFindResult
r <- FinderCache
-> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule FinderCache
fc FinderOpts
fopts (HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId HomeUnit
home_unit) ModuleName
mod_name
  FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FindResult -> IO FindResult) -> FindResult -> IO FindResult
forall a b. (a -> b) -> a -> b
$ case InstalledFindResult
r of
    InstalledFound ModLocation
loc InstalledModule
_ -> ModLocation -> Module -> FindResult
Found ModLocation
loc (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit ModuleName
mod_name)
    InstalledNoPackage UnitId
_ -> Unit -> FindResult
NoPackage Unit
uid -- impossible
    InstalledNotFound [FilePath]
fps Maybe UnitId
_ -> NotFound {
        fr_paths :: [FilePath]
fr_paths = [FilePath]
fps,
        fr_pkg :: Maybe Unit
fr_pkg = Unit -> Maybe Unit
forall a. a -> Maybe a
Just Unit
uid,
        fr_mods_hidden :: [Unit]
fr_mods_hidden = [],
        fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = [],
        fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = [],
        fr_suggestions :: [ModuleSuggestion]
fr_suggestions = []
      }

mkHomeHidden :: UnitId -> FindResult
mkHomeHidden :: UnitId -> FindResult
mkHomeHidden UnitId
uid =
  NotFound { fr_paths :: [FilePath]
fr_paths = []
           , fr_pkg :: Maybe Unit
fr_pkg = Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
uid))
           , fr_mods_hidden :: [Unit]
fr_mods_hidden = [Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
uid)]
           , fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = []
           , fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = []
           , fr_suggestions :: [ModuleSuggestion]
fr_suggestions = []}

findHomePackageModule :: FinderCache -> FinderOpts -> UnitId -> ModuleName -> IO FindResult
findHomePackageModule :: FinderCache -> FinderOpts -> UnitId -> ModuleName -> IO FindResult
findHomePackageModule FinderCache
fc FinderOpts
fopts  UnitId
home_unit ModuleName
mod_name = do
  let uid :: Unit
uid       = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
home_unit)
  InstalledFindResult
r <- FinderCache
-> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule FinderCache
fc FinderOpts
fopts UnitId
home_unit ModuleName
mod_name
  FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FindResult -> IO FindResult) -> FindResult -> IO FindResult
forall a b. (a -> b) -> a -> b
$ case InstalledFindResult
r of
    InstalledFound ModLocation
loc InstalledModule
_ -> ModLocation -> Module -> FindResult
Found ModLocation
loc (Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule Unit
uid ModuleName
mod_name)
    InstalledNoPackage UnitId
_ -> Unit -> FindResult
NoPackage Unit
uid -- impossible
    InstalledNotFound [FilePath]
fps Maybe UnitId
_ -> NotFound {
        fr_paths :: [FilePath]
fr_paths = [FilePath]
fps,
        fr_pkg :: Maybe Unit
fr_pkg = Unit -> Maybe Unit
forall a. a -> Maybe a
Just Unit
uid,
        fr_mods_hidden :: [Unit]
fr_mods_hidden = [],
        fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = [],
        fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = [],
        fr_suggestions :: [ModuleSuggestion]
fr_suggestions = []
      }


-- | Implements the search for a module name in the home package only.  Calling
-- this function directly is usually *not* what you want; currently, it's used
-- as a building block for the following operations:
--
--  1. When you do a normal package lookup, we first check if the module
--  is available in the home module, before looking it up in the package
--  database.
--
--  2. When you have a package qualified import with package name "this",
--  we shortcut to the home module.
--
--  3. When we look up an exact 'Module', if the unit id associated with
--  the module is the current home module do a look up in the home module.
--
--  4. Some special-case code in GHCi (ToDo: Figure out why that needs to
--  call this.)
findInstalledHomeModule :: FinderCache -> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule :: FinderCache
-> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule FinderCache
fc FinderOpts
fopts UnitId
home_unit ModuleName
mod_name = do
  FinderCache
-> UnitId
-> ModuleName
-> IO InstalledFindResult
-> IO InstalledFindResult
homeSearchCache FinderCache
fc UnitId
home_unit ModuleName
mod_name (IO InstalledFindResult -> IO InstalledFindResult)
-> IO InstalledFindResult -> IO InstalledFindResult
forall a b. (a -> b) -> a -> b
$
   let
     maybe_working_dir :: Maybe FilePath
maybe_working_dir = FinderOpts -> Maybe FilePath
finder_workingDirectory FinderOpts
fopts
     home_path :: [FilePath]
home_path = case Maybe FilePath
maybe_working_dir of
                  Maybe FilePath
Nothing -> FinderOpts -> [FilePath]
finder_importPaths FinderOpts
fopts
                  Just FilePath
fp -> FilePath -> [FilePath] -> [FilePath]
augmentImports FilePath
fp (FinderOpts -> [FilePath]
finder_importPaths FinderOpts
fopts)
     hi_dir_path :: [FilePath]
hi_dir_path =
      case FinderOpts -> Maybe FilePath
finder_hiDir FinderOpts
fopts of
        Just FilePath
hiDir -> case Maybe FilePath
maybe_working_dir of
                        Maybe FilePath
Nothing -> [FilePath
hiDir]
                        Just FilePath
fp -> [FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
hiDir]
        Maybe FilePath
Nothing -> [FilePath]
home_path
     hisuf :: FilePath
hisuf = FinderOpts -> FilePath
finder_hiSuf FinderOpts
fopts
     mod :: InstalledModule
mod = UnitId -> ModuleName -> InstalledModule
forall u. u -> ModuleName -> GenModule u
mkModule UnitId
home_unit ModuleName
mod_name

     source_exts :: [(FilePath, FilePath -> FilePath -> ModLocation)]
source_exts =
      [ (FilePath
"hs",    FinderOpts
-> ModuleName -> FilePath -> FilePath -> FilePath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod_name FilePath
"hs")
      , (FilePath
"lhs",   FinderOpts
-> ModuleName -> FilePath -> FilePath -> FilePath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod_name FilePath
"lhs")
      , (FilePath
"hsig",  FinderOpts
-> ModuleName -> FilePath -> FilePath -> FilePath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod_name FilePath
"hsig")
      , (FilePath
"lhsig", FinderOpts
-> ModuleName -> FilePath -> FilePath -> FilePath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod_name FilePath
"lhsig")
      ]

     -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that
     -- when hiDir field is set in dflags, we know to look there (see #16500)
     hi_exts :: [(FilePath, FilePath -> FilePath -> ModLocation)]
hi_exts = [ (FilePath
hisuf,                FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
mkHomeModHiOnlyLocation FinderOpts
fopts ModuleName
mod_name)
               , (FilePath -> FilePath
addBootSuffix FilePath
hisuf,  FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
mkHomeModHiOnlyLocation FinderOpts
fopts ModuleName
mod_name)
               ]

        -- In compilation manager modes, we look for source files in the home
        -- package because we can compile these automatically.  In one-shot
        -- compilation mode we look for .hi and .hi-boot files only.
     ([FilePath]
search_dirs, [(FilePath, FilePath -> FilePath -> ModLocation)]
exts)
          | FinderOpts -> Bool
finder_lookupHomeInterfaces FinderOpts
fopts = ([FilePath]
hi_dir_path, [(FilePath, FilePath -> FilePath -> ModLocation)]
hi_exts)
          | Bool
otherwise                         = ([FilePath]
home_path, [(FilePath, FilePath -> FilePath -> ModLocation)]
source_exts)
   in

   -- special case for GHC.Prim; we won't find it in the filesystem.
   -- This is important only when compiling the base package (where GHC.Prim
   -- is a home module).
   if InstalledModule
mod InstalledModule -> Module -> Bool
`installedModuleEq` Module
gHC_PRIM
         then InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound (FilePath -> ModLocation
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.Prim ModLocation") InstalledModule
mod)
         else [FilePath]
-> InstalledModule
-> [(FilePath, FilePath -> FilePath -> ModLocation)]
-> IO InstalledFindResult
searchPathExts [FilePath]
search_dirs InstalledModule
mod [(FilePath, FilePath -> FilePath -> ModLocation)]
exts

-- | Prepend the working directory to the search path.
augmentImports :: FilePath -> [FilePath] -> [FilePath]
augmentImports :: FilePath -> [FilePath] -> [FilePath]
augmentImports FilePath
_work_dir [] = []
augmentImports FilePath
work_dir (FilePath
fp:[FilePath]
fps) | FilePath -> Bool
isAbsolute FilePath
fp = FilePath
fp FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath] -> [FilePath]
augmentImports FilePath
work_dir [FilePath]
fps
                                 | Bool
otherwise     = (FilePath
work_dir FilePath -> FilePath -> FilePath
</> FilePath
fp) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath] -> [FilePath]
augmentImports FilePath
work_dir [FilePath]
fps

-- | Search for a module in external packages only.
findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult
findPackageModule :: FinderCache
-> UnitState
-> FinderOpts
-> InstalledModule
-> IO InstalledFindResult
findPackageModule FinderCache
fc UnitState
unit_state FinderOpts
fopts InstalledModule
mod = do
  let pkg_id :: UnitId
pkg_id = InstalledModule -> UnitId
forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod
  case UnitState -> UnitId -> Maybe UnitInfo
lookupUnitId UnitState
unit_state UnitId
pkg_id of
     Maybe UnitInfo
Nothing -> InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId -> InstalledFindResult
InstalledNoPackage UnitId
pkg_id)
     Just UnitInfo
u  -> FinderCache
-> FinderOpts
-> InstalledModule
-> UnitInfo
-> IO InstalledFindResult
findPackageModule_ FinderCache
fc FinderOpts
fopts InstalledModule
mod UnitInfo
u

-- | Look up the interface file associated with module @mod@.  This function
-- requires a few invariants to be upheld: (1) the 'Module' in question must
-- be the module identifier of the *original* implementation of a module,
-- not a reexport (this invariant is upheld by "GHC.Unit.State") and (2)
-- the 'UnitInfo' must be consistent with the unit id in the 'Module'.
-- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config.
findPackageModule_ :: FinderCache -> FinderOpts -> InstalledModule -> UnitInfo -> IO InstalledFindResult
findPackageModule_ :: FinderCache
-> FinderOpts
-> InstalledModule
-> UnitInfo
-> IO InstalledFindResult
findPackageModule_ FinderCache
fc FinderOpts
fopts InstalledModule
mod UnitInfo
pkg_conf = do
  Bool -> SDoc -> IO ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (InstalledModule -> UnitId
forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitInfo -> UnitId
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId UnitInfo
pkg_conf)
             (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (InstalledModule -> UnitId
forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> UnitId
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId UnitInfo
pkg_conf))
  FinderCache
-> InstalledModule
-> IO InstalledFindResult
-> IO InstalledFindResult
modLocationCache FinderCache
fc InstalledModule
mod (IO InstalledFindResult -> IO InstalledFindResult)
-> IO InstalledFindResult -> IO InstalledFindResult
forall a b. (a -> b) -> a -> b
$

    -- special case for GHC.Prim; we won't find it in the filesystem.
    if InstalledModule
mod InstalledModule -> Module -> Bool
`installedModuleEq` Module
gHC_PRIM
          then InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound (FilePath -> ModLocation
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.Prim ModLocation") InstalledModule
mod)
          else

    let
       tag :: FilePath
tag = Ways -> FilePath
waysBuildTag (FinderOpts -> Ways
finder_ways FinderOpts
fopts)

             -- hi-suffix for packages depends on the build tag.
       package_hisuf :: FilePath
package_hisuf | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
tag  = FilePath
"hi"
                     | Bool
otherwise = FilePath
tag FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_hi"

       package_dynhisuf :: FilePath
package_dynhisuf = Ways -> FilePath
waysBuildTag (Way -> Ways -> Ways
addWay Way
WayDyn (FinderOpts -> Ways
finder_ways FinderOpts
fopts)) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_hi"

       mk_hi_loc :: FilePath -> FilePath -> ModLocation
mk_hi_loc = FinderOpts
-> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
mkHiOnlyModLocation FinderOpts
fopts FilePath
package_hisuf FilePath
package_dynhisuf

       import_dirs :: [FilePath]
import_dirs = (FilePathST -> FilePath) -> [FilePathST] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePathST -> FilePath
ST.unpack ([FilePathST] -> [FilePath]) -> [FilePathST] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ UnitInfo -> [FilePathST]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [FilePathST]
unitImportDirs UnitInfo
pkg_conf
        -- we never look for a .hi-boot file in an external package;
        -- .hi-boot files only make sense for the home package.
    in
    case [FilePath]
import_dirs of
      [FilePath
one] | FinderOpts -> Bool
finder_bypassHiFileCheck FinderOpts
fopts ->
            -- there's only one place that this .hi file can be, so
            -- don't bother looking for it.
            let basename :: FilePath
basename = ModuleName -> FilePath
moduleNameSlashes (InstalledModule -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)
                loc :: ModLocation
loc = FilePath -> FilePath -> ModLocation
mk_hi_loc FilePath
one FilePath
basename
            in InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledFindResult -> IO InstalledFindResult)
-> InstalledFindResult -> IO InstalledFindResult
forall a b. (a -> b) -> a -> b
$ ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound ModLocation
loc InstalledModule
mod
      [FilePath]
_otherwise ->
            [FilePath]
-> InstalledModule
-> [(FilePath, FilePath -> FilePath -> ModLocation)]
-> IO InstalledFindResult
searchPathExts [FilePath]
import_dirs InstalledModule
mod [(FilePath
package_hisuf, FilePath -> FilePath -> ModLocation
mk_hi_loc)]

-- -----------------------------------------------------------------------------
-- General path searching

searchPathExts :: [FilePath]      -- paths to search
               -> InstalledModule -- module name
               -> [ (
                     FileExt,                             -- suffix
                     FilePath -> BaseName -> ModLocation  -- action
                    )
                  ]
               -> IO InstalledFindResult

searchPathExts :: [FilePath]
-> InstalledModule
-> [(FilePath, FilePath -> FilePath -> ModLocation)]
-> IO InstalledFindResult
searchPathExts [FilePath]
paths InstalledModule
mod [(FilePath, FilePath -> FilePath -> ModLocation)]
exts = [(FilePath, ModLocation)] -> IO InstalledFindResult
search [(FilePath, ModLocation)]
to_search
  where
    basename :: FilePath
basename = ModuleName -> FilePath
moduleNameSlashes (InstalledModule -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)

    to_search :: [(FilePath, ModLocation)]
    to_search :: [(FilePath, ModLocation)]
to_search = [ (FilePath
file, FilePath -> FilePath -> ModLocation
fn FilePath
path FilePath
basename)
                | FilePath
path <- [FilePath]
paths,
                  (FilePath
ext,FilePath -> FilePath -> ModLocation
fn) <- [(FilePath, FilePath -> FilePath -> ModLocation)]
exts,
                  let base :: FilePath
base | FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"." = FilePath
basename
                           | Bool
otherwise   = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
basename
                      file :: FilePath
file = FilePath
base FilePath -> FilePath -> FilePath
<.> FilePath
ext
                ]

    search :: [(FilePath, ModLocation)] -> IO InstalledFindResult
search [] = InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> Maybe UnitId -> InstalledFindResult
InstalledNotFound (((FilePath, ModLocation) -> FilePath)
-> [(FilePath, ModLocation)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, ModLocation) -> FilePath
forall a b. (a, b) -> a
fst [(FilePath, ModLocation)]
to_search) (UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (InstalledModule -> UnitId
forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod)))

    search ((FilePath
file, ModLocation
loc) : [(FilePath, ModLocation)]
rest) = do
      Bool
b <- FilePath -> IO Bool
doesFileExist FilePath
file
      if Bool
b
        then InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledFindResult -> IO InstalledFindResult)
-> InstalledFindResult -> IO InstalledFindResult
forall a b. (a -> b) -> a -> b
$ ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound ModLocation
loc InstalledModule
mod
        else [(FilePath, ModLocation)] -> IO InstalledFindResult
search [(FilePath, ModLocation)]
rest

mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt
                          -> FilePath -> BaseName -> ModLocation
mkHomeModLocationSearched :: FinderOpts
-> ModuleName -> FilePath -> FilePath -> FilePath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod FilePath
suff FilePath
path FilePath
basename =
  FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
mkHomeModLocation2 FinderOpts
fopts ModuleName
mod (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
basename) FilePath
suff


-- -----------------------------------------------------------------------------
-- Constructing a home module location

-- This is where we construct the ModLocation for a module in the home
-- package, for which we have a source file.  It is called from three
-- places:
--
--  (a) Here in the finder, when we are searching for a module to import,
--      using the search path (-i option).
--
--  (b) The compilation manager, when constructing the ModLocation for
--      a "root" module (a source file named explicitly on the command line
--      or in a :load command in GHCi).
--
--  (c) The driver in one-shot mode, when we need to construct a
--      ModLocation for a source file named on the command-line.
--
-- Parameters are:
--
-- mod
--      The name of the module
--
-- path
--      (a): The search path component where the source file was found.
--      (b) and (c): "."
--
-- src_basename
--      (a): (moduleNameSlashes mod)
--      (b) and (c): The filename of the source file, minus its extension
--
-- ext
--      The filename extension of the source file (usually "hs" or "lhs").

mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation
mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation
mkHomeModLocation FinderOpts
dflags ModuleName
mod FilePath
src_filename =
   let (FilePath
basename,FilePath
extension) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
src_filename
   in FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
mkHomeModLocation2 FinderOpts
dflags ModuleName
mod FilePath
basename FilePath
extension

mkHomeModLocation2 :: FinderOpts
                   -> ModuleName
                   -> FilePath  -- Of source module, without suffix
                   -> String    -- Suffix
                   -> ModLocation
mkHomeModLocation2 :: FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
mkHomeModLocation2 FinderOpts
fopts ModuleName
mod FilePath
src_basename FilePath
ext =
   let mod_basename :: FilePath
mod_basename = ModuleName -> FilePath
moduleNameSlashes ModuleName
mod

       obj_fn :: FilePath
obj_fn = FinderOpts -> FilePath -> FilePath -> FilePath
mkObjPath  FinderOpts
fopts FilePath
src_basename FilePath
mod_basename
       dyn_obj_fn :: FilePath
dyn_obj_fn = FinderOpts -> FilePath -> FilePath -> FilePath
mkDynObjPath  FinderOpts
fopts FilePath
src_basename FilePath
mod_basename
       hi_fn :: FilePath
hi_fn  = FinderOpts -> FilePath -> FilePath -> FilePath
mkHiPath   FinderOpts
fopts FilePath
src_basename FilePath
mod_basename
       dyn_hi_fn :: FilePath
dyn_hi_fn  = FinderOpts -> FilePath -> FilePath -> FilePath
mkDynHiPath   FinderOpts
fopts FilePath
src_basename FilePath
mod_basename
       hie_fn :: FilePath
hie_fn = FinderOpts -> FilePath -> FilePath -> FilePath
mkHiePath  FinderOpts
fopts FilePath
src_basename FilePath
mod_basename

   in (ModLocation{ ml_hs_file :: Maybe FilePath
ml_hs_file   = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
src_basename FilePath -> FilePath -> FilePath
<.> FilePath
ext),
                        ml_hi_file :: FilePath
ml_hi_file   = FilePath
hi_fn,
                        ml_dyn_hi_file :: FilePath
ml_dyn_hi_file = FilePath
dyn_hi_fn,
                        ml_obj_file :: FilePath
ml_obj_file  = FilePath
obj_fn,
                        ml_dyn_obj_file :: FilePath
ml_dyn_obj_file = FilePath
dyn_obj_fn,
                        ml_hie_file :: FilePath
ml_hie_file  = FilePath
hie_fn })

mkHomeModHiOnlyLocation :: FinderOpts
                        -> ModuleName
                        -> FilePath
                        -> BaseName
                        -> ModLocation
mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
mkHomeModHiOnlyLocation FinderOpts
fopts ModuleName
mod FilePath
path FilePath
basename =
   let loc :: ModLocation
loc = FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
mkHomeModLocation2 FinderOpts
fopts ModuleName
mod (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
basename) FilePath
""
   in ModLocation
loc { ml_hs_file = Nothing }

-- This function is used to make a ModLocation for a package module. Hence why
-- we explicitly pass in the interface file suffixes.
mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String
                    -> ModLocation
mkHiOnlyModLocation :: FinderOpts
-> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
mkHiOnlyModLocation FinderOpts
fopts FilePath
hisuf FilePath
dynhisuf FilePath
path FilePath
basename
 = let full_basename :: FilePath
full_basename = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
basename
       obj_fn :: FilePath
obj_fn = FinderOpts -> FilePath -> FilePath -> FilePath
mkObjPath FinderOpts
fopts FilePath
full_basename FilePath
basename
       dyn_obj_fn :: FilePath
dyn_obj_fn = FinderOpts -> FilePath -> FilePath -> FilePath
mkDynObjPath FinderOpts
fopts FilePath
full_basename FilePath
basename
       hie_fn :: FilePath
hie_fn = FinderOpts -> FilePath -> FilePath -> FilePath
mkHiePath FinderOpts
fopts FilePath
full_basename FilePath
basename
   in ModLocation{    ml_hs_file :: Maybe FilePath
ml_hs_file   = Maybe FilePath
forall a. Maybe a
Nothing,
                             ml_hi_file :: FilePath
ml_hi_file   = FilePath
full_basename FilePath -> FilePath -> FilePath
<.> FilePath
hisuf,
                                -- Remove the .hi-boot suffix from
                                -- hi_file, if it had one.  We always
                                -- want the name of the real .hi file
                                -- in the ml_hi_file field.
                             ml_dyn_obj_file :: FilePath
ml_dyn_obj_file = FilePath
dyn_obj_fn,
                             -- MP: TODO
                             ml_dyn_hi_file :: FilePath
ml_dyn_hi_file  = FilePath
full_basename FilePath -> FilePath -> FilePath
<.> FilePath
dynhisuf,
                             ml_obj_file :: FilePath
ml_obj_file  = FilePath
obj_fn,
                             ml_hie_file :: FilePath
ml_hie_file  = FilePath
hie_fn
                  }

-- | Constructs the filename of a .o file for a given source file.
-- Does /not/ check whether the .o file exists
mkObjPath
  :: FinderOpts
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
  -> FilePath
mkObjPath :: FinderOpts -> FilePath -> FilePath -> FilePath
mkObjPath FinderOpts
fopts FilePath
basename FilePath
mod_basename = FilePath
obj_basename FilePath -> FilePath -> FilePath
<.> FilePath
osuf
  where
                odir :: Maybe FilePath
odir = FinderOpts -> Maybe FilePath
finder_objectDir FinderOpts
fopts
                osuf :: FilePath
osuf = FinderOpts -> FilePath
finder_objectSuf FinderOpts
fopts

                obj_basename :: FilePath
obj_basename | Just FilePath
dir <- Maybe FilePath
odir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
                             | Bool
otherwise        = FilePath
basename

-- | Constructs the filename of a .dyn_o file for a given source file.
-- Does /not/ check whether the .dyn_o file exists
mkDynObjPath
  :: FinderOpts
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
  -> FilePath
mkDynObjPath :: FinderOpts -> FilePath -> FilePath -> FilePath
mkDynObjPath FinderOpts
fopts FilePath
basename FilePath
mod_basename = FilePath
obj_basename FilePath -> FilePath -> FilePath
<.> FilePath
dynosuf
  where
                odir :: Maybe FilePath
odir = FinderOpts -> Maybe FilePath
finder_objectDir FinderOpts
fopts
                dynosuf :: FilePath
dynosuf = FinderOpts -> FilePath
finder_dynObjectSuf FinderOpts
fopts

                obj_basename :: FilePath
obj_basename | Just FilePath
dir <- Maybe FilePath
odir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
                             | Bool
otherwise        = FilePath
basename


-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
mkHiPath
  :: FinderOpts
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
  -> FilePath
mkHiPath :: FinderOpts -> FilePath -> FilePath -> FilePath
mkHiPath FinderOpts
fopts FilePath
basename FilePath
mod_basename = FilePath
hi_basename FilePath -> FilePath -> FilePath
<.> FilePath
hisuf
 where
                hidir :: Maybe FilePath
hidir = FinderOpts -> Maybe FilePath
finder_hiDir FinderOpts
fopts
                hisuf :: FilePath
hisuf = FinderOpts -> FilePath
finder_hiSuf FinderOpts
fopts

                hi_basename :: FilePath
hi_basename | Just FilePath
dir <- Maybe FilePath
hidir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
                            | Bool
otherwise         = FilePath
basename

-- | Constructs the filename of a .dyn_hi file for a given source file.
-- Does /not/ check whether the .dyn_hi file exists
mkDynHiPath
  :: FinderOpts
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
  -> FilePath
mkDynHiPath :: FinderOpts -> FilePath -> FilePath -> FilePath
mkDynHiPath FinderOpts
fopts FilePath
basename FilePath
mod_basename = FilePath
hi_basename FilePath -> FilePath -> FilePath
<.> FilePath
dynhisuf
 where
                hidir :: Maybe FilePath
hidir = FinderOpts -> Maybe FilePath
finder_hiDir FinderOpts
fopts
                dynhisuf :: FilePath
dynhisuf = FinderOpts -> FilePath
finder_dynHiSuf FinderOpts
fopts

                hi_basename :: FilePath
hi_basename | Just FilePath
dir <- Maybe FilePath
hidir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
                            | Bool
otherwise         = FilePath
basename

-- | Constructs the filename of a .hie file for a given source file.
-- Does /not/ check whether the .hie file exists
mkHiePath
  :: FinderOpts
  -> FilePath           -- the filename of the source file, minus the extension
  -> String             -- the module name with dots replaced by slashes
  -> FilePath
mkHiePath :: FinderOpts -> FilePath -> FilePath -> FilePath
mkHiePath FinderOpts
fopts FilePath
basename FilePath
mod_basename = FilePath
hie_basename FilePath -> FilePath -> FilePath
<.> FilePath
hiesuf
 where
                hiedir :: Maybe FilePath
hiedir = FinderOpts -> Maybe FilePath
finder_hieDir FinderOpts
fopts
                hiesuf :: FilePath
hiesuf = FinderOpts -> FilePath
finder_hieSuf FinderOpts
fopts

                hie_basename :: FilePath
hie_basename | Just FilePath
dir <- Maybe FilePath
hiedir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
                             | Bool
otherwise          = FilePath
basename



-- -----------------------------------------------------------------------------
-- Filenames of the stub files

-- We don't have to store these in ModLocations, because they can be derived
-- from other available information, and they're only rarely needed.

mkStubPaths
  :: FinderOpts
  -> ModuleName
  -> ModLocation
  -> FilePath

mkStubPaths :: FinderOpts -> ModuleName -> ModLocation -> FilePath
mkStubPaths FinderOpts
fopts ModuleName
mod ModLocation
location
  = let
        stubdir :: Maybe FilePath
stubdir = FinderOpts -> Maybe FilePath
finder_stubDir FinderOpts
fopts

        mod_basename :: FilePath
mod_basename = ModuleName -> FilePath
moduleNameSlashes ModuleName
mod
        src_basename :: FilePath
src_basename = FilePath -> FilePath
dropExtension (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a. HasCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"mkStubPaths"
                                                  (ModLocation -> Maybe FilePath
ml_hs_file ModLocation
location)

        stub_basename0 :: FilePath
stub_basename0
            | Just FilePath
dir <- Maybe FilePath
stubdir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
            | Bool
otherwise           = FilePath
src_basename

        stub_basename :: FilePath
stub_basename = FilePath
stub_basename0 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_stub"
     in
        FilePath
stub_basename FilePath -> FilePath -> FilePath
<.> FilePath
"h"

-- -----------------------------------------------------------------------------
-- findLinkable isn't related to the other stuff in here,
-- but there's no other obvious place for it

findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe Module
mod ModLocation
locn
   = do let obj_fn :: FilePath
obj_fn = ModLocation -> FilePath
ml_obj_file ModLocation
locn
        Maybe UTCTime
maybe_obj_time <- FilePath -> IO (Maybe UTCTime)
modificationTimeIfExists FilePath
obj_fn
        case Maybe UTCTime
maybe_obj_time of
          Maybe UTCTime
Nothing -> Maybe Linkable -> IO (Maybe Linkable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Linkable
forall a. Maybe a
Nothing
          Just UTCTime
obj_time -> (Linkable -> Maybe Linkable) -> IO Linkable -> IO (Maybe Linkable)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just (Module -> FilePath -> UTCTime -> IO Linkable
findObjectLinkable Module
mod FilePath
obj_fn UTCTime
obj_time)

-- Make an object linkable when we know the object file exists, and we know
-- its modification time.
findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
findObjectLinkable Module
mod FilePath
obj_fn UTCTime
obj_time = Linkable -> IO Linkable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Module -> [Unlinked] -> Linkable
LM UTCTime
obj_time Module
mod [FilePath -> Unlinked
DotO FilePath
obj_fn])
  -- We used to look for _stub.o files here, but that was a bug (#706)
  -- Now GHC merges the stub.o into the main .o (#3687)