{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}

-- | A 'UnitEnv' provides the complete interface into everything that is loaded
-- into a GHC session, including the 'HomeUnitGraph' for mapping home units to their
-- 'HomePackageTable's (which store information about all home modules), and
-- the 'ExternalPackageState' which provides access to all external packages
-- loaded.
--
-- This module is meant to be imported as @UnitEnv@ when calling @insertHpt@:
--
-- @
-- import GHC.Unit.Env (UnitEnv, HomeUnitGraph, HomeUnitEnv)
-- import GHC.Unit.Env as UnitEnv
-- @
--
-- Here is an overview of how the UnitEnv, ModuleGraph, HUG, HPT, and EPS interact:
--
-- @
-- ┌────────────────┐┌────────────────────┐┌───────────┐
-- │HomePackageTable││ExternalPackageState││ModuleGraph│
-- └┬───────────────┘└┬───────────────────┘└┬──────────┘
-- ┌▽────────────┐    │                     │
-- │HomeUnitGraph│    │                     │
-- └┬────────────┘    │                     │
-- ┌▽─────────────────▽┐                    │
-- │UnitEnv            │                    │
-- └┬──────────────────┘                    │
-- ┌▽───────────────────────────────────────▽┐
-- │HscEnv                                   │
-- └─────────────────────────────────────────┘
-- @
--
-- The 'UnitEnv' references both the 'HomeUnitGraph' (with all the home unit
-- modules) and the 'ExternalPackageState' (information about all
-- non-home/external units). The 'HscEnv' references this 'UnitEnv' and the
-- 'ModuleGraph' (which describes the relationship between the modules being
-- compiled). The 'HomeUnitGraph' has one 'HomePackageTable' for every unit.
--
-- TODO: Arguably, the 'ModuleGraph' should be part of 'UnitEnv' rather than being in the 'HscEnv'.
module GHC.Unit.Env
    ( UnitEnv (..)
    , initUnitEnv
    , ueEPS -- Not really needed, get directly type families and rule base!
    , updateHug
    -- * Unit Env helper functions
    , ue_currentHomeUnitEnv
    , ue_hpt
    , ue_setActiveUnit
    , ue_currentUnit
    , ue_findHomeUnitEnv
    , ue_unitHomeUnit
    , ue_unitHomeUnit_maybe
    , ue_updateHomeUnitEnv
    , ue_all_home_unit_ids
    , ue_unsafeHomeUnit

    -- * HUG Re-export
    , HomeUnitGraph
    , HomeUnitEnv (..)

    -- * Invariants
    , assertUnitEnvInvariant
    -- * Preload units info
    , preloadUnitsInfo
    , preloadUnitsInfo'
    -- * Home Module functions
    , isUnitEnvInstalledModule

    --------------------------------------------------------------------------------
    -- WIP above
    --------------------------------------------------------------------------------

    -- * Operations on the UnitEnv
    , renameUnitId

    -- ** Modifying the current active home unit
    , insertHpt
    , ue_setFlags

    -- * Queries

    -- ** Queries on the current active home unit
    , ue_homeUnitState
    , ue_unit_dbs
    , ue_homeUnit
    , ue_unitFlags

    -- ** Reachability
    , ue_transitiveHomeDeps

    --------------------------------------------------------------------------------
    -- Harder queries for the whole UnitEnv
    --------------------------------------------------------------------------------

    -- ** Instances, rules, type fams, annotations, etc..
    --
    -- | The @hug@ prefix means the function returns only things found in home
    -- units.
    , hugCompleteSigs
    , hugAllInstances
    , hugAllAnns

    -- * Legacy API
    --
    -- | This API is deprecated!
    , ue_units
    )
where

import GHC.Prelude
import qualified Data.Set as Set

import GHC.Unit.External
import GHC.Unit.State
import GHC.Unit.Home
import GHC.Unit.Types
import GHC.Unit.Home.ModInfo
import GHC.Unit.Home.PackageTable
import GHC.Unit.Home.Graph (HomeUnitGraph, HomeUnitEnv)
import qualified GHC.Unit.Home.Graph as HUG

import GHC.Platform
import GHC.Settings
import GHC.Data.Maybe
import GHC.Utils.Misc (HasDebugCallStack)
import GHC.Driver.DynFlags
import GHC.Utils.Outputable
import GHC.Utils.Panic

import GHC.Types.Annotations
import GHC.Types.CompleteMatch
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv

--------------------------------------------------------------------------------
-- The hard queries
--------------------------------------------------------------------------------

-- | Find all the instance declarations (of classes and families) from
-- the Home Package Table filtered by the provided predicate function.
hugAllInstances :: UnitEnv -> IO (InstEnv, [FamInst])
hugAllInstances :: UnitEnv -> IO (InstEnv, [FamInst])
hugAllInstances = HomeUnitGraph -> IO (InstEnv, [FamInst])
HUG.allInstances (HomeUnitGraph -> IO (InstEnv, [FamInst]))
-> (UnitEnv -> HomeUnitGraph) -> UnitEnv -> IO (InstEnv, [FamInst])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitEnv -> HomeUnitGraph
ue_home_unit_graph

-- | Find all the annotations in all home units
hugAllAnns :: UnitEnv -> IO AnnEnv
hugAllAnns :: UnitEnv -> IO AnnEnv
hugAllAnns = HomeUnitGraph -> IO AnnEnv
HUG.allAnns (HomeUnitGraph -> IO AnnEnv)
-> (UnitEnv -> HomeUnitGraph) -> UnitEnv -> IO AnnEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitEnv -> HomeUnitGraph
ue_home_unit_graph

-- | Get all 'CompleteMatches' (arising from COMPLETE pragmas) present across
-- all home units.
hugCompleteSigs :: UnitEnv -> IO CompleteMatches
hugCompleteSigs :: UnitEnv -> IO CompleteMatches
hugCompleteSigs = HomeUnitGraph -> IO CompleteMatches
HUG.allCompleteSigs (HomeUnitGraph -> IO CompleteMatches)
-> (UnitEnv -> HomeUnitGraph) -> UnitEnv -> IO CompleteMatches
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitEnv -> HomeUnitGraph
ue_home_unit_graph

--------------------------------------------------------------------------------
-- UnitEnv
--------------------------------------------------------------------------------

data UnitEnv = UnitEnv
    { UnitEnv -> ExternalUnitCache
ue_eps :: {-# UNPACK #-} !ExternalUnitCache
        -- ^ Information about the currently loaded external packages.
        -- This is mutable because packages will be demand-loaded during
        -- a compilation run as required.

    , UnitEnv -> UnitId
ue_current_unit    :: UnitId

    , UnitEnv -> HomeUnitGraph
ue_home_unit_graph :: !HomeUnitGraph
        -- See Note [Multiple Home Units]

    , UnitEnv -> Platform
ue_platform  :: !Platform
        -- ^ Platform

    , UnitEnv -> GhcNameVersion
ue_namever   :: !GhcNameVersion
        -- ^ GHC name/version (used for dynamic library suffix)
    }

ueEPS :: UnitEnv -> IO ExternalPackageState
ueEPS :: UnitEnv -> IO ExternalPackageState
ueEPS = ExternalUnitCache -> IO ExternalPackageState
eucEPS (ExternalUnitCache -> IO ExternalPackageState)
-> (UnitEnv -> ExternalUnitCache)
-> UnitEnv
-> IO ExternalPackageState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitEnv -> ExternalUnitCache
ue_eps

initUnitEnv :: UnitId -> HomeUnitGraph -> GhcNameVersion -> Platform -> IO UnitEnv
initUnitEnv :: UnitId -> HomeUnitGraph -> GhcNameVersion -> Platform -> IO UnitEnv
initUnitEnv UnitId
cur_unit HomeUnitGraph
hug GhcNameVersion
namever Platform
platform = do
  eps <- IO ExternalUnitCache
initExternalUnitCache
  return $ UnitEnv
    { ue_eps             = eps
    , ue_home_unit_graph = hug
    , ue_current_unit    = cur_unit
    , ue_platform        = platform
    , ue_namever         = namever
    }

updateHug :: (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
updateHug :: (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
updateHug = HasDebugCallStack =>
(HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
(HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
ue_updateHUG

-- -----------------------------------------------------------------------------
-- Extracting information from the packages in scope
-- -----------------------------------------------------------------------------

-- Many of these functions take a list of packages: in those cases,
-- the list is expected to contain the "dependent packages",
-- i.e. those packages that were found to be depended on by the
-- current module/program.  These can be auto or non-auto packages, it
-- doesn't really matter.  The list is always combined with the list
-- of preload (command-line) packages to determine which packages to
-- use.

-- | Lookup 'UnitInfo' for every preload unit from the UnitState, for every unit
-- used to instantiate the home unit, and for every unit explicitly passed in
-- the given list of UnitId.
preloadUnitsInfo' :: UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' :: UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
ids0 = MaybeErr UnitErr [UnitInfo]
all_infos
  where
    unit_state :: UnitState
unit_state = HomeUnitEnv -> UnitState
HUG.homeUnitEnv_units (HasDebugCallStack => UnitEnv -> HomeUnitEnv
UnitEnv -> HomeUnitEnv
ue_currentHomeUnitEnv UnitEnv
unit_env)
    ids :: [UnitId]
ids      = [UnitId]
ids0 [UnitId] -> [UnitId] -> [UnitId]
forall a. [a] -> [a] -> [a]
++ [UnitId]
inst_ids
    inst_ids :: [UnitId]
inst_ids = case UnitEnv -> Maybe HomeUnit
ue_homeUnit UnitEnv
unit_env of
      Maybe HomeUnit
Nothing -> []
      Just HomeUnit
home_unit
       -- An indefinite package will have insts to HOLE,
       -- which is not a real package. Don't look it up.
       -- Fixes #14525
       | HomeUnit -> Bool
forall u. GenHomeUnit u -> Bool
isHomeUnitIndefinite HomeUnit
home_unit -> []
       | Bool
otherwise -> ((ModuleName, GenModule Unit) -> UnitId)
-> [(ModuleName, GenModule Unit)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Unit -> UnitId
toUnitId (Unit -> UnitId)
-> ((ModuleName, GenModule Unit) -> Unit)
-> (ModuleName, GenModule Unit)
-> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenModule Unit -> Unit
forall unit. GenModule unit -> unit
moduleUnit (GenModule Unit -> Unit)
-> ((ModuleName, GenModule Unit) -> GenModule Unit)
-> (ModuleName, GenModule Unit)
-> Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, GenModule Unit) -> GenModule Unit
forall a b. (a, b) -> b
snd) (HomeUnit -> [(ModuleName, GenModule Unit)]
forall u. GenHomeUnit u -> GenInstantiations u
homeUnitInstantiations HomeUnit
home_unit)
    pkg_map :: UnitInfoMap
pkg_map = UnitState -> UnitInfoMap
unitInfoMap UnitState
unit_state
    preload :: [UnitId]
preload = UnitState -> [UnitId]
preloadUnits UnitState
unit_state

    all_pkgs :: MaybeErr UnitErr [UnitId]
all_pkgs  = UnitInfoMap
-> [UnitId]
-> [(UnitId, Maybe UnitId)]
-> MaybeErr UnitErr [UnitId]
closeUnitDeps' UnitInfoMap
pkg_map [UnitId]
preload ([UnitId]
ids [UnitId] -> [Maybe UnitId] -> [(UnitId, Maybe UnitId)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Maybe UnitId -> [Maybe UnitId]
forall a. a -> [a]
repeat Maybe UnitId
forall a. Maybe a
Nothing)
    all_infos :: MaybeErr UnitErr [UnitInfo]
all_infos = (UnitId -> UnitInfo) -> [UnitId] -> [UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => UnitState -> UnitId -> UnitInfo
UnitState -> UnitId -> UnitInfo
unsafeLookupUnitId UnitState
unit_state) ([UnitId] -> [UnitInfo])
-> MaybeErr UnitErr [UnitId] -> MaybeErr UnitErr [UnitInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeErr UnitErr [UnitId]
all_pkgs


-- | Lookup 'UnitInfo' for every preload unit from the UnitState and for every
-- unit used to instantiate the home unit.
preloadUnitsInfo :: UnitEnv -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo :: UnitEnv -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo UnitEnv
unit_env = UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env []

-- -- | Test if the module comes from the home unit
isUnitEnvInstalledModule :: UnitEnv -> InstalledModule -> Bool
isUnitEnvInstalledModule :: UnitEnv -> InstalledModule -> Bool
isUnitEnvInstalledModule UnitEnv
ue InstalledModule
m = Bool -> (HomeUnit -> Bool) -> Maybe HomeUnit -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (HomeUnit -> InstalledModule -> Bool
forall u. GenHomeUnit u -> InstalledModule -> Bool
`isHomeInstalledModule` InstalledModule
m) Maybe HomeUnit
hu
  where
    hu :: Maybe HomeUnit
hu = UnitId -> UnitEnv -> Maybe HomeUnit
ue_unitHomeUnit_maybe (InstalledModule -> UnitId
forall unit. GenModule unit -> unit
moduleUnit InstalledModule
m) UnitEnv
ue

-- -------------------------------------------------------
-- Operations on arbitrary elements of the home unit graph
-- -------------------------------------------------------

ue_findHomeUnitEnv :: HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv :: HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
e = case UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
HUG.lookupHugUnit UnitId
uid (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e) of
  Maybe HomeUnitEnv
Nothing -> String -> SDoc -> HomeUnitEnv
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unit unknown to the internal unit environment"
              (SDoc -> HomeUnitEnv) -> SDoc -> HomeUnitEnv
forall a b. (a -> b) -> a -> b
$  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unit (" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
")"
              SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Set UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HomeUnitGraph -> Set UnitId
HUG.allUnits (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e))
  Just HomeUnitEnv
hue -> HomeUnitEnv
hue

-- -------------------------------------------------------
-- Query and modify UnitState of active unit in HomeUnitEnv
-- -------------------------------------------------------

ue_homeUnitState :: HasDebugCallStack => UnitEnv -> UnitState
ue_homeUnitState :: HasDebugCallStack => UnitEnv -> UnitState
ue_homeUnitState = HomeUnitEnv -> UnitState
HUG.homeUnitEnv_units (HomeUnitEnv -> UnitState)
-> (UnitEnv -> HomeUnitEnv) -> UnitEnv -> UnitState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnitEnv -> HomeUnitEnv
UnitEnv -> HomeUnitEnv
ue_currentHomeUnitEnv

ue_unit_dbs :: UnitEnv ->  Maybe [UnitDatabase UnitId]
ue_unit_dbs :: UnitEnv -> Maybe [UnitDatabase UnitId]
ue_unit_dbs = HomeUnitEnv -> Maybe [UnitDatabase UnitId]
HUG.homeUnitEnv_unit_dbs (HomeUnitEnv -> Maybe [UnitDatabase UnitId])
-> (UnitEnv -> HomeUnitEnv)
-> UnitEnv
-> Maybe [UnitDatabase UnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnitEnv -> HomeUnitEnv
UnitEnv -> HomeUnitEnv
ue_currentHomeUnitEnv

-- -------------------------------------------------------
-- Query and modify Home Package Table in HomeUnitEnv
-- -------------------------------------------------------

-- | Get the /current home unit/'s package table
ue_hpt :: HasDebugCallStack => UnitEnv -> HomePackageTable
ue_hpt :: HasDebugCallStack => UnitEnv -> HomePackageTable
ue_hpt = HomeUnitEnv -> HomePackageTable
HUG.homeUnitEnv_hpt (HomeUnitEnv -> HomePackageTable)
-> (UnitEnv -> HomeUnitEnv) -> UnitEnv -> HomePackageTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnitEnv -> HomeUnitEnv
UnitEnv -> HomeUnitEnv
ue_currentHomeUnitEnv

-- | Inserts a 'HomeModInfo' at the given 'ModuleName' on the
-- 'HomePackageTable' of the /current unit/ being compiled.
insertHpt :: HasDebugCallStack => HomeModInfo -> UnitEnv -> IO ()
insertHpt :: HasDebugCallStack => HomeModInfo -> UnitEnv -> IO ()
insertHpt HomeModInfo
hmi UnitEnv
e = do
  HomeModInfo -> HomeUnitGraph -> IO ()
HUG.addHomeModInfoToHug HomeModInfo
hmi (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e)

ue_updateHUG :: HasDebugCallStack => (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
ue_updateHUG :: HasDebugCallStack =>
(HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
ue_updateHUG HomeUnitGraph -> HomeUnitGraph
f UnitEnv
e = HasDebugCallStack =>
(HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
(HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
ue_updateUnitHUG HomeUnitGraph -> HomeUnitGraph
f UnitEnv
e

ue_updateUnitHUG :: HasDebugCallStack => (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
ue_updateUnitHUG :: HasDebugCallStack =>
(HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv
ue_updateUnitHUG HomeUnitGraph -> HomeUnitGraph
f UnitEnv
ue_env = UnitEnv
ue_env { ue_home_unit_graph = f (ue_home_unit_graph ue_env)}

-- -------------------------------------------------------
-- Query and modify DynFlags in HomeUnitEnv
-- -------------------------------------------------------

ue_unitFlags :: HasDebugCallStack => UnitId -> UnitEnv -> DynFlags
ue_unitFlags :: HasDebugCallStack => UnitId -> UnitEnv -> DynFlags
ue_unitFlags UnitId
uid UnitEnv
ue_env = HomeUnitEnv -> DynFlags
HUG.homeUnitEnv_dflags (HomeUnitEnv -> DynFlags) -> HomeUnitEnv -> DynFlags
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
ue_env

-- | Sets the 'DynFlags' of the /current unit/ being compiled to the given ones
ue_setFlags :: HasDebugCallStack => DynFlags -> UnitEnv -> UnitEnv
ue_setFlags :: HasDebugCallStack => DynFlags -> UnitEnv -> UnitEnv
ue_setFlags DynFlags
dflags UnitEnv
env =
  UnitEnv
env
    { ue_home_unit_graph = HUG.updateUnitFlags
                            (ue_currentUnit env)
                            (const dflags)
                            (ue_home_unit_graph env)
    }

-- -------------------------------------------------------
-- Query and modify home units in HomeUnitEnv
-- -------------------------------------------------------

ue_homeUnit :: UnitEnv -> Maybe HomeUnit
ue_homeUnit :: UnitEnv -> Maybe HomeUnit
ue_homeUnit = HomeUnitEnv -> Maybe HomeUnit
HUG.homeUnitEnv_home_unit (HomeUnitEnv -> Maybe HomeUnit)
-> (UnitEnv -> HomeUnitEnv) -> UnitEnv -> Maybe HomeUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnitEnv -> HomeUnitEnv
UnitEnv -> HomeUnitEnv
ue_currentHomeUnitEnv

ue_unsafeHomeUnit :: UnitEnv -> HomeUnit
ue_unsafeHomeUnit :: UnitEnv -> HomeUnit
ue_unsafeHomeUnit UnitEnv
ue = case UnitEnv -> Maybe HomeUnit
ue_homeUnit UnitEnv
ue of
  Maybe HomeUnit
Nothing -> String -> HomeUnit
forall a. HasCallStack => String -> a
panic String
"ue_unsafeHomeUnit: No home unit"
  Just HomeUnit
h  -> HomeUnit
h

ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit
ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit
ue_unitHomeUnit UnitId
uid = String -> Maybe HomeUnit -> HomeUnit
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"ue_unitHomeUnit" (Maybe HomeUnit -> HomeUnit)
-> (UnitEnv -> Maybe HomeUnit) -> UnitEnv -> HomeUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> UnitEnv -> Maybe HomeUnit
ue_unitHomeUnit_maybe UnitId
uid

ue_unitHomeUnit_maybe :: UnitId -> UnitEnv -> Maybe HomeUnit
ue_unitHomeUnit_maybe :: UnitId -> UnitEnv -> Maybe HomeUnit
ue_unitHomeUnit_maybe UnitId
uid UnitEnv
ue_env =
  HomeUnitEnv -> Maybe HomeUnit
HUG.homeUnitEnv_home_unit (HomeUnitEnv -> Maybe HomeUnit)
-> Maybe HomeUnitEnv -> Maybe HomeUnit
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
HUG.lookupHugUnit UnitId
uid (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
ue_env)

-- -------------------------------------------------------
-- Query and modify the currently active unit
-- -------------------------------------------------------

ue_currentHomeUnitEnv :: HasDebugCallStack => UnitEnv -> HomeUnitEnv
ue_currentHomeUnitEnv :: HasDebugCallStack => UnitEnv -> HomeUnitEnv
ue_currentHomeUnitEnv UnitEnv
e =
  case UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
HUG.lookupHugUnit (UnitEnv -> UnitId
ue_currentUnit UnitEnv
e) (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e) of
    Just HomeUnitEnv
unitEnv -> HomeUnitEnv
unitEnv
    Maybe HomeUnitEnv
Nothing -> String -> SDoc -> HomeUnitEnv
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"packageNotFound" (SDoc -> HomeUnitEnv) -> SDoc -> HomeUnitEnv
forall a b. (a -> b) -> a -> b
$
      (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitId -> SDoc) -> UnitId -> SDoc
forall a b. (a -> b) -> a -> b
$ UnitEnv -> UnitId
ue_currentUnit UnitEnv
e) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Set UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HomeUnitGraph -> Set UnitId
HUG.allUnits (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e))

ue_setActiveUnit :: UnitId -> UnitEnv -> UnitEnv
ue_setActiveUnit :: UnitId -> UnitEnv -> UnitEnv
ue_setActiveUnit UnitId
u UnitEnv
ue_env = HasDebugCallStack => UnitEnv -> UnitEnv
UnitEnv -> UnitEnv
assertUnitEnvInvariant (UnitEnv -> UnitEnv) -> UnitEnv -> UnitEnv
forall a b. (a -> b) -> a -> b
$ UnitEnv
ue_env
  { ue_current_unit = u
  }

ue_currentUnit :: UnitEnv -> UnitId
ue_currentUnit :: UnitEnv -> UnitId
ue_currentUnit = UnitEnv -> UnitId
ue_current_unit


ue_updateHomeUnitEnv :: (HomeUnitEnv -> HomeUnitEnv) -> UnitId -> UnitEnv -> UnitEnv
ue_updateHomeUnitEnv :: (HomeUnitEnv -> HomeUnitEnv) -> UnitId -> UnitEnv -> UnitEnv
ue_updateHomeUnitEnv HomeUnitEnv -> HomeUnitEnv
f UnitId
uid UnitEnv
e = UnitEnv
e
  { ue_home_unit_graph = HUG.unitEnv_adjust f uid $ ue_home_unit_graph e
  }

ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId
ue_all_home_unit_ids :: UnitEnv -> Set UnitId
ue_all_home_unit_ids = HomeUnitGraph -> Set UnitId
HUG.allUnits (HomeUnitGraph -> Set UnitId)
-> (UnitEnv -> HomeUnitGraph) -> UnitEnv -> Set UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitEnv -> HomeUnitGraph
ue_home_unit_graph

-- | Rename a unit id in the internal unit env.
--
-- @'renameUnitId' oldUnit newUnit UnitEnv@, it is assumed that the 'oldUnit' exists in the home units map,
-- otherwise we panic.
-- The 'DynFlags' associated with the home unit will have its field 'homeUnitId' set to 'newUnit'.
renameUnitId :: HasDebugCallStack => UnitId -> UnitId -> UnitEnv -> UnitEnv
renameUnitId :: HasDebugCallStack => UnitId -> UnitId -> UnitEnv -> UnitEnv
renameUnitId UnitId
oldUnit UnitId
newUnit UnitEnv
unitEnv =
  case UnitId -> UnitId -> HomeUnitGraph -> Maybe HomeUnitGraph
HUG.renameUnitId UnitId
oldUnit UnitId
newUnit (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
unitEnv) of
    Maybe HomeUnitGraph
Nothing ->
      String -> SDoc -> UnitEnv
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Tried to rename unit, but it didn't exist"
                (SDoc -> UnitEnv) -> SDoc -> UnitEnv
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Rename old unit \"" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
oldUnit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\" to \""SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
newUnit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\""
                SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (Set UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Set UnitId -> SDoc) -> Set UnitId -> SDoc
forall a b. (a -> b) -> a -> b
$ HomeUnitGraph -> Set UnitId
HUG.allUnits (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
unitEnv))
    Just HomeUnitGraph
newHug ->
      let
        activeUnit :: UnitId
        !activeUnit :: UnitId
activeUnit = if UnitEnv -> UnitId
ue_currentUnit UnitEnv
unitEnv UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
oldUnit
                  then UnitId
newUnit
                  else UnitEnv -> UnitId
ue_currentUnit UnitEnv
unitEnv

      in
      UnitEnv
unitEnv
        { ue_current_unit = activeUnit
        , ue_home_unit_graph =
            HUG.updateUnitFlags
              newUnit
              (\DynFlags
df -> DynFlags
df{ homeUnitId_ = newUnit })
              newHug
        }

-- ---------------------------------------------
-- Transitive closure
-- ---------------------------------------------

ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId]
ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId]
ue_transitiveHomeDeps UnitId
uid UnitEnv
e =
  case UnitId -> HomeUnitGraph -> Maybe [UnitId]
HUG.transitiveHomeDeps UnitId
uid (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e) of
    Maybe [UnitId]
Nothing -> String -> SDoc -> [UnitId]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unit unknown to the internal unit environment"
                (SDoc -> [UnitId]) -> SDoc -> [UnitId]
forall a b. (a -> b) -> a -> b
$  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unit (" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
")"
                SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Set UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HomeUnitGraph -> Set UnitId
HUG.allUnits (HomeUnitGraph -> Set UnitId) -> HomeUnitGraph -> Set UnitId
forall a b. (a -> b) -> a -> b
$ UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e)
    Just [UnitId]
deps -> [UnitId]
deps

-- ---------------------------------------------
-- Asserts to enforce invariants for the UnitEnv
-- ---------------------------------------------

-- FIXME: Shouldn't this be a proper assertion only used in debug mode?
assertUnitEnvInvariant :: HasDebugCallStack => UnitEnv -> UnitEnv
assertUnitEnvInvariant :: HasDebugCallStack => UnitEnv -> UnitEnv
assertUnitEnvInvariant UnitEnv
u =
  case UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
HUG.lookupHugUnit (UnitEnv -> UnitId
ue_current_unit UnitEnv
u) (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
u) of
    Just HomeUnitEnv
_ -> UnitEnv
u
    Maybe HomeUnitEnv
Nothing ->
      String -> SDoc -> UnitEnv
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"invariant" (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitEnv -> UnitId
ue_current_unit UnitEnv
u) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Set UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HomeUnitGraph -> Set UnitId
HUG.allUnits (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
u)))

-- -----------------------------------------------------------------------------
-- Pretty output functions
-- -----------------------------------------------------------------------------

-- pprUnitEnvGraph :: UnitEnv -> IO SDoc
-- pprUnitEnvGraph env = do
--   hugDoc <- HUG.pprHomeUnitGraph $ ue_home_unit_graph env
--   return $ text "pprInternalUnitMap" $$ nest 2 hugDoc

{-
Note [Multiple Home Units]
~~~~~~~~~~~~~~~~~~~~~~~~~~
The basic idea of multiple home units is quite simple. Instead of allowing one
home unit, you can multiple home units

The flow:

1. Dependencies between units are specified between each other in the normal manner,
   a unit is identified by the -this-unit-id flag and dependencies specified by
   the normal -package-id flag.
2. Downsweep is augmented to know to know how to look for dependencies in any home unit.
3. The rest of the compiler is modified appropriately to offset paths to the right places.
4. --make mode can parallelise between home units and multiple units are allowed to produce linkables.

Closure Property
----------------

You must perform a clean cut of the dependency graph.

> Any dependency which is not a home unit must not (transitively) depend on a home unit.

For example, if you have three packages p, q and r, then if p depends on q which
depends on r then it is illegal to load both p and r as home units but not q,
because q is a dependency of the home unit p which depends on another home unit r.

Offsetting Paths
----------------

The main complication to the implementation is to do with offsetting paths appropriately.
For a long time it has been assumed that GHC will execute in the top-directory for a unit,
normally where the .cabal file is and all paths are interpreted relative to there.
When you have multiple home units then it doesn't make sense to pick one of these
units to choose as the base-unit, and you can't robustly change directories when
using parallelism.

Therefore there is an option `-working-directory`, which tells GHC where the relative
paths for each unit should be interpreted relative to. For example, if you specify
`-working-dir a -ib`, then GHC will offset the relative path `b`, by `a`, and look for
source files in `a/b`. The same thing happens for any path passed on the command line.

A non-exhaustive list is

* -i
* -I
* -odir/-hidir/-outputdir/-stubdir/-hiedir
* Target files passed on the command line

There is also a template-haskell function, makeRelativeToProject, which uses the `-working-directory` option
in order to allow users to offset their own relative paths.

-}

--------------------------------------------------------------------------------
-- * Legacy API
--------------------------------------------------------------------------------

{-# DEPRECATED ue_units "Renamed to ue_homeUnitState because of confusion between units(tate) and unit(s) plural" #-}
ue_units :: HasDebugCallStack => UnitEnv -> UnitState
ue_units :: HasDebugCallStack => UnitEnv -> UnitState
ue_units = HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_homeUnitState