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

-}


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards  #-}

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

    findObjectLinkableMaybe,
    findObjectLinkable,
  ) where

import GHC.Prelude

import GHC.Platform.Ways

import GHC.Builtin.Names ( gHC_PRIM )

import GHC.Data.OsPath

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 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.Types.SourceFile

import GHC.Fingerprint
import Data.IORef
import System.Directory.OsPath
import Control.Applicative ((<|>))
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
import qualified System.OsPath as OsPath
import qualified Data.List.NonEmpty as NE

type FileExt = OsString -- Filename extension
type BaseName = OsPath  -- 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

{-
[Note: Monotonic addToFinderCache]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

addToFinderCache is only used by functions that return the cached value
if there is one, or by functions that always write an InstalledFound value.
Without multithreading it is then safe to always directly write the value
without checking the previously cached value.

However, with multithreading, it is possible that another function has
written a value into cache between the lookup and the addToFinderCache call.
in this case we should check to not overwrite an InstalledFound with an
InstalledNotFound.
-}

initFinderCache :: IO FinderCache
initFinderCache :: IO FinderCache
initFinderCache = do
  mod_cache <- InstalledModuleEnv InstalledFindResult
-> IO (IORef (InstalledModuleEnv InstalledFindResult))
forall a. a -> IO (IORef a)
newIORef InstalledModuleEnv InstalledFindResult
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv
  file_cache <- newIORef M.empty
  let flushFinderCaches :: UnitEnv -> IO ()
      flushFinderCaches UnitEnv
ue = do
        IORef (InstalledModuleEnv InstalledFindResult)
-> (InstalledModuleEnv InstalledFindResult
    -> (InstalledModuleEnv InstalledFindResult, ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (InstalledModuleEnv InstalledFindResult)
mod_cache ((InstalledModuleEnv InstalledFindResult
  -> (InstalledModuleEnv InstalledFindResult, ()))
 -> IO ())
-> (InstalledModuleEnv InstalledFindResult
    -> (InstalledModuleEnv InstalledFindResult, ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \InstalledModuleEnv InstalledFindResult
fm -> ((InstalledModule -> InstalledFindResult -> Bool)
-> InstalledModuleEnv InstalledFindResult
-> InstalledModuleEnv InstalledFindResult
forall a.
(InstalledModule -> a -> Bool)
-> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv InstalledModule -> InstalledFindResult -> Bool
is_ext InstalledModuleEnv InstalledFindResult
fm, ())
        IORef (Map FilePath Fingerprint)
-> (Map FilePath Fingerprint -> (Map FilePath Fingerprint, ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Map FilePath Fingerprint)
file_cache ((Map FilePath Fingerprint -> (Map FilePath Fingerprint, ()))
 -> IO ())
-> (Map FilePath Fingerprint -> (Map FilePath Fingerprint, ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Map FilePath Fingerprint
_ -> (Map FilePath Fingerprint
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 :: InstalledModule -> InstalledFindResult -> IO ()
      addToFinderCache InstalledModule
key InstalledFindResult
val =
        IORef (InstalledModuleEnv InstalledFindResult)
-> (InstalledModuleEnv InstalledFindResult
    -> (InstalledModuleEnv InstalledFindResult, ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (InstalledModuleEnv InstalledFindResult)
mod_cache ((InstalledModuleEnv InstalledFindResult
  -> (InstalledModuleEnv InstalledFindResult, ()))
 -> IO ())
-> (InstalledModuleEnv InstalledFindResult
    -> (InstalledModuleEnv InstalledFindResult, ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \InstalledModuleEnv InstalledFindResult
c ->
          case (InstalledModuleEnv InstalledFindResult
-> InstalledModule -> Maybe InstalledFindResult
forall a. InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv InstalledModuleEnv InstalledFindResult
c InstalledModule
key, InstalledFindResult
val) of
            -- Don't overwrite an InstalledFound with an InstalledNotFound
            -- See [Note Monotonic addToFinderCache]
            (Just InstalledFound{}, InstalledNotFound{}) -> (InstalledModuleEnv InstalledFindResult
c, ())
            (Maybe InstalledFindResult, InstalledFindResult)
_ -> (InstalledModuleEnv InstalledFindResult
-> InstalledModule
-> InstalledFindResult
-> InstalledModuleEnv InstalledFindResult
forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv InstalledModuleEnv InstalledFindResult
c InstalledModule
key InstalledFindResult
val, ())

      lookupFinderCache :: InstalledModule -> IO (Maybe InstalledFindResult)
      lookupFinderCache InstalledModule
key = do
         c <- IORef (InstalledModuleEnv InstalledFindResult)
-> IO (InstalledModuleEnv InstalledFindResult)
forall a. IORef a -> IO a
readIORef IORef (InstalledModuleEnv InstalledFindResult)
mod_cache
         return $! lookupInstalledModuleEnv c key

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

-- -----------------------------------------------------------------------------
-- 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

findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult
findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult
findImportedModuleWithIsBoot HscEnv
hsc_env ModuleName
mod IsBootInterface
is_boot PkgQual
pkg_qual = do
  res <- HscEnv -> ModuleName -> PkgQual -> IO FindResult
findImportedModule HscEnv
hsc_env ModuleName
mod PkgQual
pkg_qual
  case (res, is_boot) of
    (Found ModLocation
loc Module
mod, IsBootInterface
IsBoot) -> FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> Module -> FindResult
Found (ModLocation -> ModLocation
addBootSuffixLocn ModLocation
loc) Module
mod)
    (FindResult, IsBootInterface)
_ -> FindResult -> IO FindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FindResult
res

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.
      | Just ModuleName
real_mod_name <- ModuleName
mod_name ModuleName -> Map ModuleName ModuleName -> Maybe ModuleName
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` FinderOpts -> Map ModuleName 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
real_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 -> HasDebugCallStack => 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
$ HasDebugCallStack => 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 (HasDebugCallStack => 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 -> IsBootInterface -> IO InstalledFindResult
findExactModule :: FinderCache
-> FinderOpts
-> UnitEnvGraph FinderOpts
-> UnitState
-> Maybe HomeUnit
-> InstalledModule
-> IsBootInterface
-> IO InstalledFindResult
findExactModule FinderCache
fc FinderOpts
fopts UnitEnvGraph FinderOpts
other_fopts UnitState
unit_state Maybe HomeUnit
mhome_unit InstalledModule
mod IsBootInterface
is_boot = do
  res <- 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
  case (res, is_boot) of
    (InstalledFound ModLocation
loc, IsBootInterface
IsBoot) -> InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> InstalledFindResult
InstalledFound (ModLocation -> ModLocation
addBootSuffixLocn ModLocation
loc))
    (InstalledFindResult, IsBootInterface)
_ -> InstalledFindResult -> IO InstalledFindResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledFindResult
res


-- -----------------------------------------------------------------------------
-- 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
  res <- m FindResult
this
  case 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 -> [UnusableUnit]
fr_unusables = [UnusableUnit]
u1, fr_suggestions :: FindResult -> [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
s1 }
     -> do res2 <- m FindResult
or_this
           case 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 -> [UnusableUnit]
fr_unusables = [UnusableUnit]
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 :: [UnusableUnit]
fr_unusables = [UnusableUnit]
u1 [UnusableUnit] -> [UnusableUnit] -> [UnusableUnit]
forall a. [a] -> [a] -> [a]
++ [UnusableUnit]
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)
       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 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     -> 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 [OsPath]
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 = (OsPath -> FilePath) -> [OsPath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => OsPath -> FilePath
OsPath -> FilePath
unsafeDecodeUtf [OsPath]
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 :: [UnusableUnit]
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 :: [UnusableUnit]
fr_unusables = []
                       , fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [] })
     LookupUnusable [(Module, ModuleOrigin)]
unusable ->
       let unusables' :: [UnusableUnit]
unusables' = ((Module, ModuleOrigin) -> UnusableUnit)
-> [(Module, ModuleOrigin)] -> [UnusableUnit]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> UnusableUnit
forall {a}. (a, ModuleOrigin) -> UnusableUnit
get_unusable [(Module, ModuleOrigin)]
unusable
           get_unusable :: (a, ModuleOrigin) -> UnusableUnit
get_unusable (a
_, ModUnusable UnusableUnit
r) = UnusableUnit
r
           get_unusable (a
_, ModuleOrigin
r)             =
             FilePath -> SDoc -> UnusableUnit
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 :: [UnusableUnit]
fr_unusables = [UnusableUnit]
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 :: [UnusableUnit]
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
  m <- FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache FinderCache
fc InstalledModule
mod
  case 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
        result <- IO InstalledFindResult
do_this
        addToFinderCache fc mod result
        return result

addModuleToFinder :: FinderCache -> Module -> ModLocation -> HscSource -> IO ()
addModuleToFinder :: FinderCache -> Module -> ModLocation -> HscSource -> IO ()
addModuleToFinder FinderCache
fc Module
mod ModLocation
loc HscSource
src_flavour = 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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HscSource
src_flavour HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsBootFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache FinderCache
fc InstalledModule
imod (ModLocation -> InstalledFindResult
InstalledFound ModLocation
loc)

-- This returns a module because it's more convenient for users
addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> HscSource -> IO Module
addHomeModuleToFinder :: FinderCache
-> HomeUnit -> ModuleName -> ModLocation -> HscSource -> IO Module
addHomeModuleToFinder FinderCache
fc HomeUnit
home_unit ModuleName
mod_name ModLocation
loc HscSource
src_flavour = do
  let mod :: InstalledModule
mod = HomeUnit -> ModuleName -> InstalledModule
forall u. GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule HomeUnit
home_unit ModuleName
mod_name
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HscSource
src_flavour HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsBootFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache FinderCache
fc InstalledModule
mod (ModLocation -> InstalledFindResult
InstalledFound ModLocation
loc)
  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)

-- -----------------------------------------------------------------------------
--      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
  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
  return $ case r of
    InstalledFound ModLocation
loc -> 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 [OsPath]
fps Maybe UnitId
_ -> NotFound {
        fr_paths :: [FilePath]
fr_paths = (OsPath -> FilePath) -> [OsPath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => OsPath -> FilePath
OsPath -> FilePath
unsafeDecodeUtf [OsPath]
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 :: [UnusableUnit]
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 :: [UnusableUnit]
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)
  r <- FinderCache
-> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule FinderCache
fc FinderOpts
fopts UnitId
home_unit ModuleName
mod_name
  return $ case r of
    InstalledFound ModLocation
loc -> 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 [OsPath]
fps Maybe UnitId
_ -> NotFound {
        fr_paths :: [FilePath]
fr_paths = (OsPath -> FilePath) -> [OsPath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => OsPath -> FilePath
OsPath -> FilePath
unsafeDecodeUtf [OsPath]
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 :: [UnusableUnit]
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 OsPath
maybe_working_dir = FinderOpts -> Maybe OsPath
finder_workingDirectory FinderOpts
fopts
     home_path :: [OsPath]
home_path = case Maybe OsPath
maybe_working_dir of
                  Maybe OsPath
Nothing -> FinderOpts -> [OsPath]
finder_importPaths FinderOpts
fopts
                  Just OsPath
fp -> OsPath -> [OsPath] -> [OsPath]
augmentImports OsPath
fp (FinderOpts -> [OsPath]
finder_importPaths FinderOpts
fopts)
     hi_dir_path :: [OsPath]
hi_dir_path =
      case FinderOpts -> Maybe OsPath
finder_hiDir FinderOpts
fopts of
        Just OsPath
hiDir -> case Maybe OsPath
maybe_working_dir of
          Maybe OsPath
Nothing -> [OsPath
hiDir]
          Just OsPath
fp -> [OsPath
fp OsPath -> OsPath -> OsPath
</> OsPath
hiDir]
        Maybe OsPath
Nothing -> [OsPath]
home_path
     hisuf :: OsPath
hisuf = FinderOpts -> OsPath
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 :: [(OsPath, OsPath -> OsPath -> ModLocation)]
source_exts =
      [ (FilePath -> OsPath
os FilePath
"hs",    FinderOpts
-> ModuleName -> OsPath -> OsPath -> OsPath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod_name (OsPath -> OsPath -> OsPath -> ModLocation)
-> OsPath -> OsPath -> OsPath -> ModLocation
forall a b. (a -> b) -> a -> b
$ FilePath -> OsPath
os FilePath
"hs")
      , (FilePath -> OsPath
os FilePath
"lhs",   FinderOpts
-> ModuleName -> OsPath -> OsPath -> OsPath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod_name (OsPath -> OsPath -> OsPath -> ModLocation)
-> OsPath -> OsPath -> OsPath -> ModLocation
forall a b. (a -> b) -> a -> b
$ FilePath -> OsPath
os FilePath
"lhs")
      , (FilePath -> OsPath
os FilePath
"hsig",  FinderOpts
-> ModuleName -> OsPath -> OsPath -> OsPath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod_name (OsPath -> OsPath -> OsPath -> ModLocation)
-> OsPath -> OsPath -> OsPath -> ModLocation
forall a b. (a -> b) -> a -> b
$ FilePath -> OsPath
os FilePath
"hsig")
      , (FilePath -> OsPath
os FilePath
"lhsig", FinderOpts
-> ModuleName -> OsPath -> OsPath -> OsPath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod_name (OsPath -> OsPath -> OsPath -> ModLocation)
-> OsPath -> OsPath -> OsPath -> ModLocation
forall a b. (a -> b) -> a -> b
$ FilePath -> OsPath
os 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 :: [(OsPath, OsPath -> OsPath -> ModLocation)]
hi_exts = [ (OsPath
hisuf,                FinderOpts -> ModuleName -> OsPath -> OsPath -> ModLocation
mkHomeModHiOnlyLocation FinderOpts
fopts ModuleName
mod_name)
               , (OsPath -> OsPath
addBootSuffix OsPath
hisuf,  FinderOpts -> ModuleName -> OsPath -> OsPath -> 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.
     ([OsPath]
search_dirs, [(OsPath, OsPath -> OsPath -> ModLocation)]
exts)
          | FinderOpts -> Bool
finder_lookupHomeInterfaces FinderOpts
fopts = ([OsPath]
hi_dir_path, [(OsPath, OsPath -> OsPath -> ModLocation)]
hi_exts)
          | Bool
otherwise                         = ([OsPath]
home_path, [(OsPath, OsPath -> OsPath -> 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 -> InstalledFindResult
InstalledFound (FilePath -> ModLocation
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.Prim ModLocation"))
         else [OsPath]
-> InstalledModule
-> [(OsPath, OsPath -> OsPath -> ModLocation)]
-> IO InstalledFindResult
searchPathExts [OsPath]
search_dirs InstalledModule
mod [(OsPath, OsPath -> OsPath -> ModLocation)]
exts

-- | Prepend the working directory to the search path.
augmentImports :: OsPath -> [OsPath] -> [OsPath]
augmentImports :: OsPath -> [OsPath] -> [OsPath]
augmentImports OsPath
_work_dir [] = []
augmentImports OsPath
work_dir (OsPath
fp:[OsPath]
fps)
  | OsPath -> Bool
OsPath.isAbsolute OsPath
fp = OsPath
fp OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: OsPath -> [OsPath] -> [OsPath]
augmentImports OsPath
work_dir [OsPath]
fps
  | Bool
otherwise            = (OsPath
work_dir OsPath -> OsPath -> OsPath
</> OsPath
fp) OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: OsPath -> [OsPath] -> [OsPath]
augmentImports OsPath
work_dir [OsPath]
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 -> InstalledFindResult
InstalledFound (FilePath -> ModLocation
forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.Prim ModLocation"))
          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 :: OsPath
package_hisuf | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
tag  = FilePath -> OsPath
os FilePath
"hi"
                     | Bool
otherwise = FilePath -> OsPath
os (FilePath
tag FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_hi")

       package_dynhisuf :: OsPath
package_dynhisuf = FilePath -> OsPath
os (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ 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 :: OsPath -> OsPath -> ModLocation
mk_hi_loc = FinderOpts -> OsPath -> OsPath -> OsPath -> OsPath -> ModLocation
mkHiOnlyModLocation FinderOpts
fopts OsPath
package_hisuf OsPath
package_dynhisuf

       import_dirs :: [OsPath]
import_dirs = (FilePathST -> OsPath) -> [FilePathST] -> [OsPath]
forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath)
-> (FilePathST -> FilePath) -> FilePathST -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePathST -> FilePath
ST.unpack) ([FilePathST] -> [OsPath]) -> [FilePathST] -> [OsPath]
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 [OsPath]
import_dirs of
      [OsPath
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 :: OsPath
basename = HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameSlashes (InstalledModule -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)
                loc :: ModLocation
loc = OsPath -> OsPath -> ModLocation
mk_hi_loc OsPath
one OsPath
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 -> InstalledFindResult
InstalledFound ModLocation
loc
      [OsPath]
_otherwise ->
            [OsPath]
-> InstalledModule
-> [(OsPath, OsPath -> OsPath -> ModLocation)]
-> IO InstalledFindResult
searchPathExts [OsPath]
import_dirs InstalledModule
mod [(OsPath
package_hisuf, OsPath -> OsPath -> ModLocation
mk_hi_loc)]

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

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

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

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

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

    search ((OsPath
file, ModLocation
loc) : [(OsPath, ModLocation)]
rest) = do
      b <- OsPath -> IO Bool
doesFileExist OsPath
file
      if b
        then return $ InstalledFound loc
        else search rest

mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt
                          -> OsPath -> BaseName -> ModLocation
mkHomeModLocationSearched :: FinderOpts
-> ModuleName -> OsPath -> OsPath -> OsPath -> ModLocation
mkHomeModLocationSearched FinderOpts
fopts ModuleName
mod OsPath
suff OsPath
path OsPath
basename =
  FinderOpts -> ModuleName -> OsPath -> OsPath -> ModLocation
mkHomeModLocation2 FinderOpts
fopts ModuleName
mod (OsPath
path OsPath -> OsPath -> OsPath
</> OsPath
basename) OsPath
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 -> OsPath -> FileExt -> HscSource -> ModLocation
mkHomeModLocation :: FinderOpts
-> ModuleName -> OsPath -> OsPath -> HscSource -> ModLocation
mkHomeModLocation FinderOpts
dflags ModuleName
mod OsPath
src_basename OsPath
ext HscSource
hsc_src =
   let loc :: ModLocation
loc = FinderOpts -> ModuleName -> OsPath -> OsPath -> ModLocation
mkHomeModLocation2 FinderOpts
dflags ModuleName
mod OsPath
src_basename OsPath
ext
   in case HscSource
hsc_src of
     HscSource
HsBootFile -> ModLocation -> ModLocation
addBootSuffixLocnOut ModLocation
loc
     HscSource
_ -> ModLocation
loc

mkHomeModLocation2 :: FinderOpts
                   -> ModuleName
                   -> OsPath  -- Of source module, without suffix
                   -> FileExt    -- Suffix
                   -> ModLocation
mkHomeModLocation2 :: FinderOpts -> ModuleName -> OsPath -> OsPath -> ModLocation
mkHomeModLocation2 FinderOpts
fopts ModuleName
mod OsPath
src_basename OsPath
ext =
   let mod_basename :: OsPath
mod_basename = HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameSlashes ModuleName
mod

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

   in (OsPathModLocation{ ml_hs_file_ospath :: Maybe OsPath
ml_hs_file_ospath   = OsPath -> Maybe OsPath
forall a. a -> Maybe a
Just (OsPath
src_basename OsPath -> OsPath -> OsPath
<.> OsPath
ext),
                          ml_hi_file_ospath :: OsPath
ml_hi_file_ospath   = OsPath
hi_fn,
                          ml_dyn_hi_file_ospath :: OsPath
ml_dyn_hi_file_ospath = OsPath
dyn_hi_fn,
                          ml_obj_file_ospath :: OsPath
ml_obj_file_ospath  = OsPath
obj_fn,
                          ml_dyn_obj_file_ospath :: OsPath
ml_dyn_obj_file_ospath = OsPath
dyn_obj_fn,
                          ml_hie_file_ospath :: OsPath
ml_hie_file_ospath  = OsPath
hie_fn })

mkHomeModHiOnlyLocation :: FinderOpts
                        -> ModuleName
                        -> OsPath
                        -> BaseName
                        -> ModLocation
mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName -> OsPath -> OsPath -> ModLocation
mkHomeModHiOnlyLocation FinderOpts
fopts ModuleName
mod OsPath
path OsPath
basename =
   let loc :: ModLocation
loc = FinderOpts -> ModuleName -> OsPath -> OsPath -> ModLocation
mkHomeModLocation2 FinderOpts
fopts ModuleName
mod (OsPath
path OsPath -> OsPath -> OsPath
</> OsPath
basename) OsPath
forall a. Monoid a => a
mempty
   in ModLocation
loc { ml_hs_file_ospath = 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 -> FileExt -> FileExt -> OsPath -> OsPath
                    -> ModLocation
mkHiOnlyModLocation :: FinderOpts -> OsPath -> OsPath -> OsPath -> OsPath -> ModLocation
mkHiOnlyModLocation FinderOpts
fopts OsPath
hisuf OsPath
dynhisuf OsPath
path OsPath
basename
 = let full_basename :: OsPath
full_basename = OsPath
path OsPath -> OsPath -> OsPath
</> OsPath
basename
       obj_fn :: OsPath
obj_fn = FinderOpts -> OsPath -> OsPath -> OsPath
mkObjPath FinderOpts
fopts OsPath
full_basename OsPath
basename
       dyn_obj_fn :: OsPath
dyn_obj_fn = FinderOpts -> OsPath -> OsPath -> OsPath
mkDynObjPath FinderOpts
fopts OsPath
full_basename OsPath
basename
       hie_fn :: OsPath
hie_fn = FinderOpts -> OsPath -> OsPath -> OsPath
mkHiePath FinderOpts
fopts OsPath
full_basename OsPath
basename
   in OsPathModLocation{  ml_hs_file_ospath :: Maybe OsPath
ml_hs_file_ospath   = Maybe OsPath
forall a. Maybe a
Nothing,
                          ml_hi_file_ospath :: OsPath
ml_hi_file_ospath   = OsPath
full_basename OsPath -> OsPath -> OsPath
<.> OsPath
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_ospath :: OsPath
ml_dyn_obj_file_ospath = OsPath
dyn_obj_fn,
                          -- MP: TODO
                          ml_dyn_hi_file_ospath :: OsPath
ml_dyn_hi_file_ospath  = OsPath
full_basename OsPath -> OsPath -> OsPath
<.> OsPath
dynhisuf,
                          ml_obj_file_ospath :: OsPath
ml_obj_file_ospath  = OsPath
obj_fn,
                          ml_hie_file_ospath :: OsPath
ml_hie_file_ospath  = OsPath
hie_fn
                  }

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

                obj_basename :: OsPath
obj_basename | Just OsPath
dir <- Maybe OsPath
odir = OsPath
dir OsPath -> OsPath -> OsPath
</> OsPath
mod_basename
                             | Bool
otherwise        = OsPath
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
  -> OsPath             -- the filename of the source file, minus the extension
  -> OsPath             -- the module name with dots replaced by slashes
  -> OsPath
mkDynObjPath :: FinderOpts -> OsPath -> OsPath -> OsPath
mkDynObjPath FinderOpts
fopts OsPath
basename OsPath
mod_basename = OsPath
obj_basename OsPath -> OsPath -> OsPath
<.> OsPath
dynosuf
  where
                odir :: Maybe OsPath
odir = FinderOpts -> Maybe OsPath
finder_objectDir FinderOpts
fopts
                dynosuf :: OsPath
dynosuf = FinderOpts -> OsPath
finder_dynObjectSuf FinderOpts
fopts

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


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

                hi_basename :: OsPath
hi_basename | Just OsPath
dir <- Maybe OsPath
hidir = OsPath
dir OsPath -> OsPath -> OsPath
</> OsPath
mod_basename
                            | Bool
otherwise         = OsPath
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
  -> OsPath             -- the filename of the source file, minus the extension
  -> OsPath             -- the module name with dots replaced by slashes
  -> OsPath
mkDynHiPath :: FinderOpts -> OsPath -> OsPath -> OsPath
mkDynHiPath FinderOpts
fopts OsPath
basename OsPath
mod_basename = OsPath
hi_basename OsPath -> OsPath -> OsPath
<.> OsPath
dynhisuf
 where
                hidir :: Maybe OsPath
hidir = FinderOpts -> Maybe OsPath
finder_hiDir FinderOpts
fopts
                dynhisuf :: OsPath
dynhisuf = FinderOpts -> OsPath
finder_dynHiSuf FinderOpts
fopts

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

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

                hie_basename :: OsPath
hie_basename | Just OsPath
dir <- Maybe OsPath
hiedir = OsPath
dir OsPath -> OsPath -> OsPath
</> OsPath
mod_basename
                             | Bool
otherwise          = OsPath
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.

-- | Compute the file name of a header file for foreign stubs, using either the
-- directory explicitly specified in the command line option @-stubdir@, or the
-- directory of the module's source file.
--
-- When compiling bytecode from interface Core bindings, @ModLocation@ does not
-- contain a source file path, so the header isn't written.
-- This doesn't have an impact, since we cannot support headers importing
-- Haskell symbols defined in bytecode for TH whatsoever at the moment.
mkStubPaths
  :: FinderOpts
  -> ModuleName
  -> ModLocation
  -> Maybe OsPath
mkStubPaths :: FinderOpts -> ModuleName -> ModLocation -> Maybe OsPath
mkStubPaths FinderOpts
fopts ModuleName
mod ModLocation
location = do
  stub_basename <- Maybe OsPath
in_stub_dir Maybe OsPath -> Maybe OsPath -> Maybe OsPath
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe OsPath
src_basename
  pure (stub_basename `mappend` os "_stub" <.> os "h")
  where
    in_stub_dir :: Maybe OsPath
in_stub_dir = (OsPath -> OsPath -> OsPath
</> OsPath
mod_basename) (OsPath -> OsPath) -> Maybe OsPath -> Maybe OsPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FinderOpts -> Maybe OsPath
finder_stubDir FinderOpts
fopts)

    mod_basename :: OsPath
mod_basename = HasCallStack => FilePath -> OsPath
FilePath -> OsPath
unsafeEncodeUtf (FilePath -> OsPath) -> FilePath -> OsPath
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameSlashes ModuleName
mod
    src_basename :: Maybe OsPath
src_basename = OsPath -> OsPath
OsPath.dropExtension (OsPath -> OsPath) -> Maybe OsPath -> Maybe OsPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModLocation -> Maybe OsPath
ml_hs_file_ospath ModLocation
location

-- -----------------------------------------------------------------------------
-- 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_obj_time <- FilePath -> IO (Maybe UTCTime)
modificationTimeIfExists FilePath
obj_fn
        case 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 (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Module -> NonEmpty LinkablePart -> Linkable
Linkable UTCTime
obj_time Module
mod (LinkablePart -> NonEmpty LinkablePart
forall a. a -> NonEmpty a
NE.singleton (FilePath -> LinkableObjectSort -> LinkablePart
DotO FilePath
obj_fn LinkableObjectSort
ModuleObject)))
  -- 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)