{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
module GHC.Unit.Finder (
FindResult(..),
InstalledFindResult(..),
FinderCache,
flushFinderCaches,
findImportedModule,
findPluginModule,
findExactModule,
findHomeModule,
findExposedPackageModule,
mkHomeModLocation,
mkHomeModLocation2,
mkHiOnlyModLocation,
mkHiPath,
mkObjPath,
addHomeModuleToFinder,
uncacheModule,
mkStubPaths,
findObjectLinkableMaybe,
findObjectLinkable,
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Platform.Ways
import GHC.Builtin.Names ( gHC_PRIM )
import GHC.Unit.Types
import GHC.Unit.Module
import GHC.Unit.Home
import GHC.Unit.State
import GHC.Unit.Finder.Types
import GHC.Data.FastString
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 Data.IORef ( IORef, readIORef, atomicModifyIORef' )
import System.Directory
import System.FilePath
import Control.Monad
import Data.Time
type FileExt = String
type BaseName = String
flushFinderCaches :: HscEnv -> IO ()
flushFinderCaches :: HscEnv -> IO ()
flushFinderCaches HscEnv
hsc_env =
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FinderCache
fc_ref forall a b. (a -> b) -> a -> b
$ \FinderCache
fm -> (forall a.
(InstalledModule -> a -> Bool)
-> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv InstalledModule -> InstalledFindResult -> Bool
is_ext FinderCache
fm, ())
where
fc_ref :: IORef FinderCache
fc_ref = HscEnv -> IORef FinderCache
hsc_FC HscEnv
hsc_env
home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
is_ext :: InstalledModule -> InstalledFindResult -> Bool
is_ext InstalledModule
mod InstalledFindResult
_ = Bool -> Bool
not (forall u. GenHomeUnit u -> InstalledModule -> Bool
isHomeInstalledModule HomeUnit
home_unit InstalledModule
mod)
addToFinderCache :: IORef FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache :: IORef FinderCache
-> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache IORef FinderCache
ref InstalledModule
key InstalledFindResult
val =
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FinderCache
ref forall a b. (a -> b) -> a -> b
$ \FinderCache
c -> (forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv FinderCache
c InstalledModule
key InstalledFindResult
val, ())
removeFromFinderCache :: IORef FinderCache -> InstalledModule -> IO ()
removeFromFinderCache :: IORef FinderCache -> InstalledModule -> IO ()
removeFromFinderCache IORef FinderCache
ref InstalledModule
key =
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FinderCache
ref forall a b. (a -> b) -> a -> b
$ \FinderCache
c -> (forall a.
InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
delInstalledModuleEnv FinderCache
c InstalledModule
key, ())
lookupFinderCache :: IORef FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache :: IORef FinderCache
-> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache IORef FinderCache
ref InstalledModule
key = do
FinderCache
c <- forall a. IORef a -> IO a
readIORef IORef FinderCache
ref
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv FinderCache
c InstalledModule
key
findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule HscEnv
hsc_env ModuleName
mod_name Maybe FastString
mb_pkg =
case Maybe FastString
mb_pkg of
Maybe FastString
Nothing -> IO FindResult
unqual_import
Just FastString
pkg | FastString
pkg forall a. Eq a => a -> a -> Bool
== FilePath -> FastString
fsLit FilePath
"this" -> IO FindResult
home_import
| Bool
otherwise -> IO FindResult
pkg_import
where
home_import :: IO FindResult
home_import = HscEnv -> ModuleName -> IO FindResult
findHomeModule HscEnv
hsc_env ModuleName
mod_name
pkg_import :: IO FindResult
pkg_import = HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findExposedPackageModule HscEnv
hsc_env ModuleName
mod_name Maybe FastString
mb_pkg
unqual_import :: IO FindResult
unqual_import = IO FindResult
home_import
forall (m :: * -> *).
Monad m =>
m FindResult -> m FindResult -> m FindResult
`orIfNotFound`
HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findExposedPackageModule HscEnv
hsc_env ModuleName
mod_name forall a. Maybe a
Nothing
findPluginModule :: HscEnv -> ModuleName -> IO FindResult
findPluginModule :: HscEnv -> ModuleName -> IO FindResult
findPluginModule HscEnv
hsc_env ModuleName
mod_name =
HscEnv -> ModuleName -> IO FindResult
findHomeModule HscEnv
hsc_env ModuleName
mod_name
forall (m :: * -> *).
Monad m =>
m FindResult -> m FindResult -> m FindResult
`orIfNotFound`
HscEnv -> ModuleName -> IO FindResult
findExposedPluginPackageModule HscEnv
hsc_env ModuleName
mod_name
findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findExactModule HscEnv
hsc_env InstalledModule
mod =
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
in if forall u. GenHomeUnit u -> InstalledModule -> Bool
isHomeInstalledModule HomeUnit
home_unit InstalledModule
mod
then HscEnv -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule HscEnv
hsc_env (forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)
else HscEnv -> InstalledModule -> IO InstalledFindResult
findPackageModule HscEnv
hsc_env InstalledModule
mod
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 }
-> forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound { fr_paths :: [FilePath]
fr_paths = [FilePath]
paths1 forall a. [a] -> [a] -> [a]
++ [FilePath]
paths2
, fr_pkg :: Maybe Unit
fr_pkg = Maybe Unit
mb_pkg2
, fr_mods_hidden :: [Unit]
fr_mods_hidden = [Unit]
mh1 forall a. [a] -> [a] -> [a]
++ [Unit]
mh2
, fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = [Unit]
ph1 forall a. [a] -> [a] -> [a]
++ [Unit]
ph2
, fr_unusables :: [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
u1 forall a. [a] -> [a] -> [a]
++ [(Unit, UnusableUnitReason)]
u2
, fr_suggestions :: [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
s1 forall a. [a] -> [a] -> [a]
++ [ModuleSuggestion]
s2 })
FindResult
_other -> forall (m :: * -> *) a. Monad m => a -> m a
return FindResult
res2
FindResult
_other -> forall (m :: * -> *) a. Monad m => a -> m a
return FindResult
res
homeSearchCache :: HscEnv -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
homeSearchCache :: HscEnv
-> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
homeSearchCache HscEnv
hsc_env ModuleName
mod_name IO InstalledFindResult
do_this = do
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
mod :: InstalledModule
mod = forall u. GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule HomeUnit
home_unit ModuleName
mod_name
HscEnv
-> InstalledModule
-> IO InstalledFindResult
-> IO InstalledFindResult
modLocationCache HscEnv
hsc_env InstalledModule
mod IO InstalledFindResult
do_this
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
-> IO FindResult
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findExposedPackageModule HscEnv
hsc_env ModuleName
mod_name Maybe FastString
mb_pkg
= HscEnv -> LookupResult -> IO FindResult
findLookupResult HscEnv
hsc_env
forall a b. (a -> b) -> a -> b
$ UnitState -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions
(HscEnv -> UnitState
hsc_units HscEnv
hsc_env) ModuleName
mod_name Maybe FastString
mb_pkg
findExposedPluginPackageModule :: HscEnv -> ModuleName
-> IO FindResult
findExposedPluginPackageModule :: HscEnv -> ModuleName -> IO FindResult
findExposedPluginPackageModule HscEnv
hsc_env ModuleName
mod_name
= HscEnv -> LookupResult -> IO FindResult
findLookupResult HscEnv
hsc_env
forall a b. (a -> b) -> a -> b
$ UnitState -> ModuleName -> Maybe FastString -> LookupResult
lookupPluginModuleWithSuggestions
(HscEnv -> UnitState
hsc_units HscEnv
hsc_env) ModuleName
mod_name forall a. Maybe a
Nothing
findLookupResult :: HscEnv -> LookupResult -> IO FindResult
findLookupResult :: HscEnv -> LookupResult -> IO FindResult
findLookupResult HscEnv
hsc_env LookupResult
r = case LookupResult
r of
LookupFound Module
m (UnitInfo, ModuleOrigin)
pkg_conf -> do
let im :: InstalledModule
im = forall a b. (a, b) -> a
fst (Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
m)
InstalledFindResult
r' <- HscEnv -> InstalledModule -> UnitInfo -> IO InstalledFindResult
findPackageModule_ HscEnv
hsc_env InstalledModule
im (forall a b. (a, b) -> a
fst (UnitInfo, ModuleOrigin)
pkg_conf)
case InstalledFindResult
r' of
InstalledFound ModLocation
loc InstalledModule
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> Module -> FindResult
Found ModLocation
loc Module
m)
InstalledNoPackage UnitId
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Unit -> FindResult
NoPackage (forall unit. GenModule unit -> unit
moduleUnit Module
m))
InstalledNotFound [FilePath]
fp Maybe UnitId
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound{ fr_paths :: [FilePath]
fr_paths = [FilePath]
fp, fr_pkg :: Maybe Unit
fr_pkg = forall a. a -> Maybe a
Just (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 ->
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 ->
forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound{ fr_paths :: [FilePath]
fr_paths = [], fr_pkg :: Maybe Unit
fr_pkg = forall a. Maybe a
Nothing
, fr_pkgs_hidden :: [Unit]
fr_pkgs_hidden = forall a b. (a -> b) -> [a] -> [b]
map (forall unit. GenModule unit -> unit
moduleUnitforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [(Module, ModuleOrigin)]
pkg_hiddens
, fr_mods_hidden :: [Unit]
fr_mods_hidden = forall a b. (a -> b) -> [a] -> [b]
map (forall unit. GenModule unit -> unit
moduleUnitforall b c a. (b -> c) -> (a -> b) -> a -> c
.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' = forall a b. (a -> b) -> [a] -> [b]
map 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) = (forall unit. GenModule unit -> unit
moduleUnit GenModule a
m, UnusableUnitReason
r)
get_unusable (GenModule a
_, ModuleOrigin
r) =
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"findLookupResult: unexpected origin" (forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
r)
in forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound{ fr_paths :: [FilePath]
fr_paths = [], fr_pkg :: Maybe Unit
fr_pkg = 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'
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HelpfulErrors (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) = [ModuleSuggestion]
suggest
| Bool
otherwise = []
forall (m :: * -> *) a. Monad m => a -> m a
return (NotFound{ fr_paths :: [FilePath]
fr_paths = [], fr_pkg :: Maybe Unit
fr_pkg = 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 :: HscEnv -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
modLocationCache :: HscEnv
-> InstalledModule
-> IO InstalledFindResult
-> IO InstalledFindResult
modLocationCache HscEnv
hsc_env InstalledModule
mod IO InstalledFindResult
do_this = do
Maybe InstalledFindResult
m <- IORef FinderCache
-> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache (HscEnv -> IORef FinderCache
hsc_FC HscEnv
hsc_env) InstalledModule
mod
case Maybe InstalledFindResult
m of
Just InstalledFindResult
result -> forall (m :: * -> *) a. Monad m => a -> m a
return InstalledFindResult
result
Maybe InstalledFindResult
Nothing -> do
InstalledFindResult
result <- IO InstalledFindResult
do_this
IORef FinderCache
-> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache (HscEnv -> IORef FinderCache
hsc_FC HscEnv
hsc_env) InstalledModule
mod InstalledFindResult
result
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledFindResult
result
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder HscEnv
hsc_env ModuleName
mod_name ModLocation
loc = do
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
mod :: InstalledModule
mod = forall u. GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule HomeUnit
home_unit ModuleName
mod_name
IORef FinderCache
-> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache (HscEnv -> IORef FinderCache
hsc_FC HscEnv
hsc_env) InstalledModule
mod (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound ModLocation
loc InstalledModule
mod)
forall (m :: * -> *) a. Monad m => a -> m a
return (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit ModuleName
mod_name)
uncacheModule :: HscEnv -> ModuleName -> IO ()
uncacheModule :: HscEnv -> ModuleName -> IO ()
uncacheModule HscEnv
hsc_env ModuleName
mod_name = do
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
mod :: InstalledModule
mod = forall u. GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule HomeUnit
home_unit ModuleName
mod_name
IORef FinderCache -> InstalledModule -> IO ()
removeFromFinderCache (HscEnv -> IORef FinderCache
hsc_FC HscEnv
hsc_env) InstalledModule
mod
findHomeModule :: HscEnv -> ModuleName -> IO FindResult
findHomeModule :: HscEnv -> ModuleName -> IO FindResult
findHomeModule HscEnv
hsc_env ModuleName
mod_name = do
InstalledFindResult
r <- HscEnv -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule HscEnv
hsc_env ModuleName
mod_name
forall (m :: * -> *) a. Monad m => a -> m a
return 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
InstalledNotFound [FilePath]
fps Maybe UnitId
_ -> NotFound {
fr_paths :: [FilePath]
fr_paths = [FilePath]
fps,
fr_pkg :: Maybe Unit
fr_pkg = 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 = []
}
where
home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
uid :: Unit
uid = HomeUnit -> Unit
homeUnitAsUnit HomeUnit
home_unit
findInstalledHomeModule :: HscEnv -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule :: HscEnv -> ModuleName -> IO InstalledFindResult
findInstalledHomeModule HscEnv
hsc_env ModuleName
mod_name =
HscEnv
-> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
homeSearchCache HscEnv
hsc_env ModuleName
mod_name forall a b. (a -> b) -> a -> b
$
let
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
home_path :: [FilePath]
home_path = DynFlags -> [FilePath]
importPaths DynFlags
dflags
hisuf :: FilePath
hisuf = DynFlags -> FilePath
hiSuf DynFlags
dflags
mod :: InstalledModule
mod = forall u. GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule HomeUnit
home_unit ModuleName
mod_name
source_exts :: [(FilePath, FilePath -> FilePath -> IO ModLocation)]
source_exts =
[ (FilePath
"hs", DynFlags
-> ModuleName -> FilePath -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocationSearched DynFlags
dflags ModuleName
mod_name FilePath
"hs")
, (FilePath
"lhs", DynFlags
-> ModuleName -> FilePath -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocationSearched DynFlags
dflags ModuleName
mod_name FilePath
"lhs")
, (FilePath
"hsig", DynFlags
-> ModuleName -> FilePath -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocationSearched DynFlags
dflags ModuleName
mod_name FilePath
"hsig")
, (FilePath
"lhsig", DynFlags
-> ModuleName -> FilePath -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocationSearched DynFlags
dflags ModuleName
mod_name FilePath
"lhsig")
]
hi_exts :: [(FilePath, FilePath -> FilePath -> IO ModLocation)]
hi_exts = [ (FilePath
hisuf, DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
mkHomeModHiOnlyLocation DynFlags
dflags ModuleName
mod_name)
, (FilePath -> FilePath
addBootSuffix FilePath
hisuf, DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
mkHomeModHiOnlyLocation DynFlags
dflags ModuleName
mod_name)
]
exts :: [(FilePath, FilePath -> FilePath -> IO ModLocation)]
exts | GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
dflags) = [(FilePath, FilePath -> FilePath -> IO ModLocation)]
hi_exts
| Bool
otherwise = [(FilePath, FilePath -> FilePath -> IO ModLocation)]
source_exts
in
if InstalledModule
mod InstalledModule -> Module -> Bool
`installedModuleEq` Module
gHC_PRIM
then forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound (forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.Prim ModLocation") InstalledModule
mod)
else [FilePath]
-> InstalledModule
-> [(FilePath, FilePath -> FilePath -> IO ModLocation)]
-> IO InstalledFindResult
searchPathExts [FilePath]
home_path InstalledModule
mod [(FilePath, FilePath -> FilePath -> IO ModLocation)]
exts
findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findPackageModule HscEnv
hsc_env InstalledModule
mod = do
let pkg_id :: UnitId
pkg_id = forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod
case UnitState -> UnitId -> Maybe UnitInfo
lookupUnitId (HscEnv -> UnitState
hsc_units HscEnv
hsc_env) UnitId
pkg_id of
Maybe UnitInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId -> InstalledFindResult
InstalledNoPackage UnitId
pkg_id)
Just UnitInfo
u -> HscEnv -> InstalledModule -> UnitInfo -> IO InstalledFindResult
findPackageModule_ HscEnv
hsc_env InstalledModule
mod UnitInfo
u
findPackageModule_ :: HscEnv -> InstalledModule -> UnitInfo -> IO InstalledFindResult
findPackageModule_ :: HscEnv -> InstalledModule -> UnitInfo -> IO InstalledFindResult
findPackageModule_ HscEnv
hsc_env InstalledModule
mod UnitInfo
pkg_conf =
ASSERT2( moduleUnit mod == unitId pkg_conf, ppr (moduleUnit mod) <+> ppr (unitId pkg_conf) )
HscEnv
-> InstalledModule
-> IO InstalledFindResult
-> IO InstalledFindResult
modLocationCache HscEnv
hsc_env InstalledModule
mod forall a b. (a -> b) -> a -> b
$
if InstalledModule
mod InstalledModule -> Module -> Bool
`installedModuleEq` Module
gHC_PRIM
then forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound (forall a. HasCallStack => FilePath -> a
error FilePath
"GHC.Prim ModLocation") InstalledModule
mod)
else
let
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
tag :: FilePath
tag = Ways -> FilePath
waysBuildTag (DynFlags -> Ways
ways DynFlags
dflags)
package_hisuf :: FilePath
package_hisuf | forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
tag = FilePath
"hi"
| Bool
otherwise = FilePath
tag forall a. [a] -> [a] -> [a]
++ FilePath
"_hi"
mk_hi_loc :: FilePath -> FilePath -> IO ModLocation
mk_hi_loc = DynFlags -> FilePath -> FilePath -> FilePath -> IO ModLocation
mkHiOnlyModLocation DynFlags
dflags FilePath
package_hisuf
import_dirs :: [FilePath]
import_dirs = forall a b. (a -> b) -> [a] -> [b]
map ShortText -> FilePath
ST.unpack forall a b. (a -> b) -> a -> b
$ forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitImportDirs UnitInfo
pkg_conf
in
case [FilePath]
import_dirs of
[FilePath
one] | GhcMode
MkDepend <- DynFlags -> GhcMode
ghcMode DynFlags
dflags -> do
let basename :: FilePath
basename = ModuleName -> FilePath
moduleNameSlashes (forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)
ModLocation
loc <- FilePath -> FilePath -> IO ModLocation
mk_hi_loc FilePath
one FilePath
basename
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound ModLocation
loc InstalledModule
mod)
[FilePath]
_otherwise ->
[FilePath]
-> InstalledModule
-> [(FilePath, FilePath -> FilePath -> IO ModLocation)]
-> IO InstalledFindResult
searchPathExts [FilePath]
import_dirs InstalledModule
mod [(FilePath
package_hisuf, FilePath -> FilePath -> IO ModLocation
mk_hi_loc)]
searchPathExts :: [FilePath]
-> InstalledModule
-> [ (
FileExt,
FilePath -> BaseName -> IO ModLocation
)
]
-> IO InstalledFindResult
searchPathExts :: [FilePath]
-> InstalledModule
-> [(FilePath, FilePath -> FilePath -> IO ModLocation)]
-> IO InstalledFindResult
searchPathExts [FilePath]
paths InstalledModule
mod [(FilePath, FilePath -> FilePath -> IO ModLocation)]
exts = [(FilePath, IO ModLocation)] -> IO InstalledFindResult
search [(FilePath, IO ModLocation)]
to_search
where
basename :: FilePath
basename = ModuleName -> FilePath
moduleNameSlashes (forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)
to_search :: [(FilePath, IO ModLocation)]
to_search :: [(FilePath, IO ModLocation)]
to_search = [ (FilePath
file, FilePath -> FilePath -> IO ModLocation
fn FilePath
path FilePath
basename)
| FilePath
path <- [FilePath]
paths,
(FilePath
ext,FilePath -> FilePath -> IO ModLocation
fn) <- [(FilePath, FilePath -> FilePath -> IO ModLocation)]
exts,
let base :: FilePath
base | FilePath
path 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, IO ModLocation)] -> IO InstalledFindResult
search [] = forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> Maybe UnitId -> InstalledFindResult
InstalledNotFound (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(FilePath, IO ModLocation)]
to_search) (forall a. a -> Maybe a
Just (forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod)))
search ((FilePath
file, IO ModLocation
mk_result) : [(FilePath, IO ModLocation)]
rest) = do
Bool
b <- FilePath -> IO Bool
doesFileExist FilePath
file
if Bool
b
then do { ModLocation
loc <- IO ModLocation
mk_result; forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation -> InstalledModule -> InstalledFindResult
InstalledFound ModLocation
loc InstalledModule
mod) }
else [(FilePath, IO ModLocation)] -> IO InstalledFindResult
search [(FilePath, IO ModLocation)]
rest
mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
-> FilePath -> BaseName -> IO ModLocation
mkHomeModLocationSearched :: DynFlags
-> ModuleName -> FilePath -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocationSearched DynFlags
dflags ModuleName
mod FilePath
suff FilePath
path FilePath
basename =
DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocation2 DynFlags
dflags ModuleName
mod (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
basename) FilePath
suff
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
mkHomeModLocation DynFlags
dflags ModuleName
mod FilePath
src_filename = do
let (FilePath
basename,FilePath
extension) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
src_filename
DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocation2 DynFlags
dflags ModuleName
mod FilePath
basename FilePath
extension
mkHomeModLocation2 :: DynFlags
-> ModuleName
-> FilePath
-> String
-> IO ModLocation
mkHomeModLocation2 :: DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocation2 DynFlags
dflags ModuleName
mod FilePath
src_basename FilePath
ext = do
let mod_basename :: FilePath
mod_basename = ModuleName -> FilePath
moduleNameSlashes ModuleName
mod
obj_fn :: FilePath
obj_fn = DynFlags -> FilePath -> FilePath -> FilePath
mkObjPath DynFlags
dflags FilePath
src_basename FilePath
mod_basename
hi_fn :: FilePath
hi_fn = DynFlags -> FilePath -> FilePath -> FilePath
mkHiPath DynFlags
dflags FilePath
src_basename FilePath
mod_basename
hie_fn :: FilePath
hie_fn = DynFlags -> FilePath -> FilePath -> FilePath
mkHiePath DynFlags
dflags FilePath
src_basename FilePath
mod_basename
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLocation{ ml_hs_file :: Maybe FilePath
ml_hs_file = 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_obj_file :: FilePath
ml_obj_file = FilePath
obj_fn,
ml_hie_file :: FilePath
ml_hie_file = FilePath
hie_fn })
mkHomeModHiOnlyLocation :: DynFlags
-> ModuleName
-> FilePath
-> BaseName
-> IO ModLocation
mkHomeModHiOnlyLocation :: DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
mkHomeModHiOnlyLocation DynFlags
dflags ModuleName
mod FilePath
path FilePath
basename = do
ModLocation
loc <- DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
mkHomeModLocation2 DynFlags
dflags ModuleName
mod (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
basename) FilePath
""
forall (m :: * -> *) a. Monad m => a -> m a
return ModLocation
loc { ml_hs_file :: Maybe FilePath
ml_hs_file = forall a. Maybe a
Nothing }
mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
-> IO ModLocation
mkHiOnlyModLocation :: DynFlags -> FilePath -> FilePath -> FilePath -> IO ModLocation
mkHiOnlyModLocation DynFlags
dflags FilePath
hisuf FilePath
path FilePath
basename
= do let full_basename :: FilePath
full_basename = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
basename
obj_fn :: FilePath
obj_fn = DynFlags -> FilePath -> FilePath -> FilePath
mkObjPath DynFlags
dflags FilePath
full_basename FilePath
basename
hie_fn :: FilePath
hie_fn = DynFlags -> FilePath -> FilePath -> FilePath
mkHiePath DynFlags
dflags FilePath
full_basename FilePath
basename
forall (m :: * -> *) a. Monad m => a -> m a
return ModLocation{ ml_hs_file :: Maybe FilePath
ml_hs_file = forall a. Maybe a
Nothing,
ml_hi_file :: FilePath
ml_hi_file = FilePath
full_basename FilePath -> FilePath -> FilePath
<.> FilePath
hisuf,
ml_obj_file :: FilePath
ml_obj_file = FilePath
obj_fn,
ml_hie_file :: FilePath
ml_hie_file = FilePath
hie_fn
}
mkObjPath
:: DynFlags
-> FilePath
-> String
-> FilePath
mkObjPath :: DynFlags -> FilePath -> FilePath -> FilePath
mkObjPath DynFlags
dflags FilePath
basename FilePath
mod_basename = FilePath
obj_basename FilePath -> FilePath -> FilePath
<.> FilePath
osuf
where
odir :: Maybe FilePath
odir = DynFlags -> Maybe FilePath
objectDir DynFlags
dflags
osuf :: FilePath
osuf = DynFlags -> FilePath
objectSuf DynFlags
dflags
obj_basename :: FilePath
obj_basename | Just FilePath
dir <- Maybe FilePath
odir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
| Bool
otherwise = FilePath
basename
mkHiPath
:: DynFlags
-> FilePath
-> String
-> FilePath
mkHiPath :: DynFlags -> FilePath -> FilePath -> FilePath
mkHiPath DynFlags
dflags FilePath
basename FilePath
mod_basename = FilePath
hi_basename FilePath -> FilePath -> FilePath
<.> FilePath
hisuf
where
hidir :: Maybe FilePath
hidir = DynFlags -> Maybe FilePath
hiDir DynFlags
dflags
hisuf :: FilePath
hisuf = DynFlags -> FilePath
hiSuf DynFlags
dflags
hi_basename :: FilePath
hi_basename | Just FilePath
dir <- Maybe FilePath
hidir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
| Bool
otherwise = FilePath
basename
mkHiePath
:: DynFlags
-> FilePath
-> String
-> FilePath
mkHiePath :: DynFlags -> FilePath -> FilePath -> FilePath
mkHiePath DynFlags
dflags FilePath
basename FilePath
mod_basename = FilePath
hie_basename FilePath -> FilePath -> FilePath
<.> FilePath
hiesuf
where
hiedir :: Maybe FilePath
hiedir = DynFlags -> Maybe FilePath
hieDir DynFlags
dflags
hiesuf :: FilePath
hiesuf = DynFlags -> FilePath
hieSuf DynFlags
dflags
hie_basename :: FilePath
hie_basename | Just FilePath
dir <- Maybe FilePath
hiedir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
mod_basename
| Bool
otherwise = FilePath
basename
mkStubPaths
:: DynFlags
-> ModuleName
-> ModLocation
-> FilePath
mkStubPaths :: DynFlags -> ModuleName -> ModLocation -> FilePath
mkStubPaths DynFlags
dflags ModuleName
mod ModLocation
location
= let
stubdir :: Maybe FilePath
stubdir = DynFlags -> Maybe FilePath
stubDir DynFlags
dflags
mod_basename :: FilePath
mod_basename = ModuleName -> FilePath
moduleNameSlashes ModuleName
mod
src_basename :: FilePath
src_basename = FilePath -> FilePath
dropExtension forall a b. (a -> b) -> a -> b
$ 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 forall a. [a] -> [a] -> [a]
++ FilePath
"_stub"
in
FilePath
stub_basename FilePath -> FilePath -> FilePath
<.> FilePath
"h"
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just UTCTime
obj_time -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just (Module -> FilePath -> UTCTime -> IO Linkable
findObjectLinkable Module
mod FilePath
obj_fn UTCTime
obj_time)
findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
findObjectLinkable Module
mod FilePath
obj_fn UTCTime
obj_time = 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])