module GHC.Unit.Finder.Types
( FinderCache (..)
, FinderCacheState
, FileCacheState
, FindResult (..)
, InstalledFindResult (..)
, FinderOpts(..)
)
where
import GHC.Prelude
import GHC.Unit
import GHC.Data.OsPath
import qualified Data.Map as M
import GHC.Fingerprint
import GHC.Platform.Ways
import GHC.Unit.Env
import GHC.Data.FastString
import qualified Data.Set as Set
type FinderCacheState = InstalledModuleEnv InstalledFindResult
type FileCacheState = M.Map FilePath Fingerprint
data FinderCache = FinderCache { FinderCache -> UnitEnv -> IO ()
flushFinderCaches :: UnitEnv -> IO ()
, FinderCache
-> InstalledModuleWithIsBoot -> InstalledFindResult -> IO ()
addToFinderCache :: InstalledModuleWithIsBoot -> InstalledFindResult -> IO ()
, FinderCache
-> InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult)
lookupFinderCache :: InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult)
, FinderCache -> FilePath -> IO Fingerprint
lookupFileCache :: FilePath -> IO Fingerprint
}
data InstalledFindResult
= InstalledFound ModLocation InstalledModule
| InstalledNoPackage UnitId
| InstalledNotFound [OsPath] (Maybe UnitId)
data FindResult
= Found ModLocation Module
| NoPackage Unit
| FoundMultiple [(Module, ModuleOrigin)]
| NotFound
{ FindResult -> [FilePath]
fr_paths :: [FilePath]
, FindResult -> Maybe Unit
fr_pkg :: Maybe Unit
, FindResult -> [Unit]
fr_mods_hidden :: [Unit]
, FindResult -> [Unit]
fr_pkgs_hidden :: [Unit]
, FindResult -> [UnusableUnit]
fr_unusables :: [UnusableUnit]
, FindResult -> [ModuleSuggestion]
fr_suggestions :: [ModuleSuggestion]
}
data FinderOpts = FinderOpts
{ FinderOpts -> [OsPath]
finder_importPaths :: [OsPath]
, FinderOpts -> Bool
finder_lookupHomeInterfaces :: Bool
, FinderOpts -> Bool
finder_bypassHiFileCheck :: Bool
, FinderOpts -> Ways
finder_ways :: Ways
, FinderOpts -> Bool
finder_enableSuggestions :: Bool
, FinderOpts -> Maybe OsPath
finder_workingDirectory :: Maybe OsPath
, FinderOpts -> Maybe FastString
finder_thisPackageName :: Maybe FastString
, FinderOpts -> Set ModuleName
finder_hiddenModules :: Set.Set ModuleName
, FinderOpts -> Map ModuleName ModuleName
finder_reexportedModules :: M.Map ModuleName ModuleName
, FinderOpts -> Maybe OsPath
finder_hieDir :: Maybe OsPath
, FinderOpts -> OsPath
finder_hieSuf :: OsString
, FinderOpts -> Maybe OsPath
finder_hiDir :: Maybe OsPath
, FinderOpts -> OsPath
finder_hiSuf :: OsString
, FinderOpts -> OsPath
finder_dynHiSuf :: OsString
, FinderOpts -> Maybe OsPath
finder_objectDir :: Maybe OsPath
, FinderOpts -> OsPath
finder_objectSuf :: OsString
, FinderOpts -> OsPath
finder_dynObjectSuf :: OsString
, FinderOpts -> Maybe OsPath
finder_stubDir :: Maybe OsPath
}