{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
module GHC.Unit.Env
    ( UnitEnv (..)
    , initUnitEnv
    , ueEPS
    , unsafeGetHomeUnit
    , updateHug
    , updateHpt_lazy
    , updateHpt
    -- * Unit Env helper functions
    , ue_units
    , ue_currentHomeUnitEnv
    , ue_setUnits
    , ue_setUnitFlags
    , ue_unit_dbs
    , ue_setUnitDbs
    , ue_hpt
    , ue_homeUnit
    , ue_unsafeHomeUnit
    , ue_setFlags
    , ue_setActiveUnit
    , ue_currentUnit
    , ue_findHomeUnitEnv
    , ue_updateHomeUnitEnv
    , ue_unitHomeUnit
    , ue_unitFlags
    , ue_renameUnitId
    , ue_transitiveHomeDeps
    -- * HomeUnitEnv
    , HomeUnitGraph
    , HomeUnitEnv (..)
    , mkHomeUnitEnv
    , lookupHugByModule
    , hugElts
    , lookupHug
    , addHomeModInfoToHug
    -- * UnitEnvGraph
    , UnitEnvGraph (..)
    , UnitEnvGraphKey
    , unitEnv_insert
    , unitEnv_delete
    , unitEnv_adjust
    , unitEnv_new
    , unitEnv_singleton
    , unitEnv_map
    , unitEnv_member
    , unitEnv_lookup_maybe
    , unitEnv_lookup
    , unitEnv_keys
    , unitEnv_elts
    , unitEnv_hpts
    , unitEnv_foldWithKey
    , unitEnv_union
    , unitEnv_mapWithKey
    -- * Invariants
    , assertUnitEnvInvariant
    -- * Preload units info
    , preloadUnitsInfo
    , preloadUnitsInfo'
    -- * Home Module functions
    , isUnitEnvInstalledModule )
where

import GHC.Prelude

import GHC.Unit.External
import GHC.Unit.State
import GHC.Unit.Home
import GHC.Unit.Types
import GHC.Unit.Home.ModInfo

import GHC.Platform
import GHC.Settings
import GHC.Data.Maybe
import GHC.Utils.Panic.Plain
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import GHC.Utils.Misc (HasDebugCallStack)
import GHC.Driver.Session
import GHC.Utils.Outputable
import GHC.Utils.Panic (pprPanic)
import GHC.Unit.Module.ModIface
import GHC.Unit.Module
import qualified Data.Set as Set

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 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
  ExternalUnitCache
eps <- IO ExternalUnitCache
initExternalUnitCache
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UnitEnv
    { ue_eps :: ExternalUnitCache
ue_eps             = ExternalUnitCache
eps
    , ue_home_unit_graph :: HomeUnitGraph
ue_home_unit_graph = HomeUnitGraph
hug
    , ue_current_unit :: UnitId
ue_current_unit    = UnitId
cur_unit
    , ue_platform :: Platform
ue_platform        = Platform
platform
    , ue_namever :: GhcNameVersion
ue_namever         = GhcNameVersion
namever
    }

-- | Get home-unit
--
-- Unsafe because the home-unit may not be set
unsafeGetHomeUnit :: UnitEnv -> HomeUnit
unsafeGetHomeUnit :: UnitEnv -> HomeUnit
unsafeGetHomeUnit UnitEnv
ue = UnitEnv -> HomeUnit
ue_unsafeHomeUnit UnitEnv
ue

updateHpt_lazy :: (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
updateHpt_lazy :: (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
updateHpt_lazy = HasDebugCallStack =>
(HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
ue_updateHPT_lazy

updateHpt :: (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
updateHpt :: (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
updateHpt = HasDebugCallStack =>
(HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
ue_updateHPT

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

ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId]
ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId]
ue_transitiveHomeDeps UnitId
uid UnitEnv
unit_env = forall a. Set a -> [a]
Set.toList (Set UnitId -> [UnitId] -> Set UnitId
loop forall a. Set a
Set.empty [UnitId
uid])
  where
    loop :: Set UnitId -> [UnitId] -> Set UnitId
loop Set UnitId
acc [] = Set UnitId
acc
    loop Set UnitId
acc (UnitId
uid:[UnitId]
uids)
      | UnitId
uid forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
acc = Set UnitId -> [UnitId] -> Set UnitId
loop Set UnitId
acc [UnitId]
uids
      | Bool
otherwise =
        let hue :: [UnitId]
hue = UnitState -> [UnitId]
homeUnitDepends (HomeUnitEnv -> UnitState
homeUnitEnv_units (HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
unit_env))
        in Set UnitId -> [UnitId] -> Set UnitId
loop (forall a. Ord a => a -> Set a -> Set a
Set.insert UnitId
uid Set UnitId
acc) ([UnitId]
hue forall a. [a] -> [a] -> [a]
++ [UnitId]
uids)


-- -----------------------------------------------------------------------------
-- 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 = HasDebugCallStack => UnitEnv -> UnitState
ue_units UnitEnv
unit_env
    ids :: [UnitId]
ids      = [UnitId]
ids0 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
       | forall u. GenHomeUnit u -> Bool
isHomeUnitIndefinite HomeUnit
home_unit -> []
       | Bool
otherwise -> forall a b. (a -> b) -> [a] -> [b]
map (Unit -> UnitId
toUnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> unit
moduleUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (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 forall a b. [a] -> [b] -> [(a, b)]
`zip` forall a. a -> [a]
repeat forall a. Maybe a
Nothing)
    all_infos :: MaybeErr UnitErr [UnitInfo]
all_infos = forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => UnitState -> UnitId -> UnitInfo
unsafeLookupUnitId UnitState
unit_state) 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 []

-- -----------------------------------------------------------------------------

data HomeUnitEnv = HomeUnitEnv
  { HomeUnitEnv -> UnitState
homeUnitEnv_units     :: !UnitState
      -- ^ External units

  , HomeUnitEnv -> Maybe [UnitDatabase UnitId]
homeUnitEnv_unit_dbs :: !(Maybe [UnitDatabase UnitId])
      -- ^ Stack of unit databases for the target platform.
      --
      -- This field is populated with the result of `initUnits`.
      --
      -- 'Nothing' means the databases have never been read from disk.
      --
      -- Usually we don't reload the databases from disk if they are
      -- cached, even if the database flags changed!

  , HomeUnitEnv -> DynFlags
homeUnitEnv_dflags :: DynFlags
    -- ^ The dynamic flag settings
  , HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt :: HomePackageTable
    -- ^ The home package table describes already-compiled
    -- home-package modules, /excluding/ the module we
    -- are compiling right now.
    -- (In one-shot mode the current module is the only
    -- home-package module, so homeUnitEnv_hpt is empty.  All other
    -- modules count as \"external-package\" modules.
    -- However, even in GHCi mode, hi-boot interfaces are
    -- demand-loaded into the external-package table.)
    --
    -- 'homeUnitEnv_hpt' is not mutable because we only demand-load
    -- external packages; the home package is eagerly
    -- loaded, module by module, by the compilation manager.
    --
    -- The HPT may contain modules compiled earlier by @--make@
    -- but not actually below the current module in the dependency
    -- graph.
    --
    -- (This changes a previous invariant: changed Jan 05.)

  , HomeUnitEnv -> Maybe HomeUnit
homeUnitEnv_home_unit :: !(Maybe HomeUnit)
    -- ^ Home-unit
  }

instance Outputable HomeUnitEnv where
  ppr :: HomeUnitEnv -> SDoc
ppr HomeUnitEnv
hug = HomePackageTable -> SDoc
pprHPT (HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
hug)

homeUnitEnv_unsafeHomeUnit :: HomeUnitEnv -> HomeUnit
homeUnitEnv_unsafeHomeUnit :: HomeUnitEnv -> HomeUnit
homeUnitEnv_unsafeHomeUnit HomeUnitEnv
hue = case HomeUnitEnv -> Maybe HomeUnit
homeUnitEnv_home_unit HomeUnitEnv
hue of
  Maybe HomeUnit
Nothing -> forall a. String -> a
panic String
"homeUnitEnv_unsafeHomeUnit: No home unit"
  Just HomeUnit
h  -> HomeUnit
h

mkHomeUnitEnv :: DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv
mkHomeUnitEnv :: DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv
mkHomeUnitEnv DynFlags
dflags HomePackageTable
hpt Maybe HomeUnit
home_unit = HomeUnitEnv
  { homeUnitEnv_units :: UnitState
homeUnitEnv_units = UnitState
emptyUnitState
  , homeUnitEnv_unit_dbs :: Maybe [UnitDatabase UnitId]
homeUnitEnv_unit_dbs = forall a. Maybe a
Nothing
  , homeUnitEnv_dflags :: DynFlags
homeUnitEnv_dflags = DynFlags
dflags
  , homeUnitEnv_hpt :: HomePackageTable
homeUnitEnv_hpt = HomePackageTable
hpt
  , homeUnitEnv_home_unit :: Maybe HomeUnit
homeUnitEnv_home_unit = Maybe HomeUnit
home_unit
  }

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


type HomeUnitGraph = UnitEnvGraph HomeUnitEnv

lookupHugByModule :: Module -> HomeUnitGraph -> Maybe HomeModInfo
lookupHugByModule :: Module -> HomeUnitGraph -> Maybe HomeModInfo
lookupHugByModule Module
mod HomeUnitGraph
hug
  | Bool
otherwise = do
      HomeUnitEnv
env <- (forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe (Unit -> UnitId
toUnitId forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> unit
moduleUnit Module
mod) HomeUnitGraph
hug)
      HomePackageTable -> Module -> Maybe HomeModInfo
lookupHptByModule (HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
env) Module
mod

hugElts :: HomeUnitGraph -> [(UnitId, HomeUnitEnv)]
hugElts :: HomeUnitGraph -> [(UnitId, HomeUnitEnv)]
hugElts HomeUnitGraph
hug = forall v. UnitEnvGraph v -> [(UnitId, v)]
unitEnv_elts HomeUnitGraph
hug

addHomeModInfoToHug :: HomeModInfo -> HomeUnitGraph -> HomeUnitGraph
addHomeModInfoToHug :: HomeModInfo -> HomeUnitGraph -> HomeUnitGraph
addHomeModInfoToHug HomeModInfo
hmi HomeUnitGraph
hug = forall v.
(Maybe v -> Maybe v) -> UnitId -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_alter Maybe HomeUnitEnv -> Maybe HomeUnitEnv
go UnitId
hmi_unit HomeUnitGraph
hug
  where
    hmi_mod :: Module
    hmi_mod :: Module
hmi_mod = forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface
hm_iface HomeModInfo
hmi)

    hmi_unit :: UnitId
hmi_unit = Unit -> UnitId
toUnitId (forall unit. GenModule unit -> unit
moduleUnit Module
hmi_mod)
    _hmi_mn :: ModuleName
_hmi_mn   = forall unit. GenModule unit -> ModuleName
moduleName Module
hmi_mod

    go :: Maybe HomeUnitEnv -> Maybe HomeUnitEnv
    go :: Maybe HomeUnitEnv -> Maybe HomeUnitEnv
go Maybe HomeUnitEnv
Nothing = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"addHomeInfoToHug" (forall a. Outputable a => a -> SDoc
ppr Module
hmi_mod)
    go (Just HomeUnitEnv
hue) = forall a. a -> Maybe a
Just ((HomePackageTable -> HomePackageTable)
-> HomeUnitEnv -> HomeUnitEnv
updateHueHpt (HomeModInfo -> HomePackageTable -> HomePackageTable
addHomeModInfoToHpt HomeModInfo
hmi) HomeUnitEnv
hue)

updateHueHpt :: (HomePackageTable -> HomePackageTable) -> HomeUnitEnv -> HomeUnitEnv
updateHueHpt :: (HomePackageTable -> HomePackageTable)
-> HomeUnitEnv -> HomeUnitEnv
updateHueHpt HomePackageTable -> HomePackageTable
f HomeUnitEnv
hue =
  let !hpt :: HomePackageTable
hpt =  HomePackageTable -> HomePackageTable
f (HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
hue)
  in HomeUnitEnv
hue { homeUnitEnv_hpt :: HomePackageTable
homeUnitEnv_hpt = HomePackageTable
hpt }


lookupHug :: HomeUnitGraph -> UnitId -> ModuleName -> Maybe HomeModInfo
lookupHug :: HomeUnitGraph -> UnitId -> ModuleName -> Maybe HomeModInfo
lookupHug HomeUnitGraph
hug UnitId
uid ModuleName
mod = forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe UnitId
uid HomeUnitGraph
hug forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt ModuleName
mod forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt


instance Outputable (UnitEnvGraph HomeUnitEnv) where
  ppr :: HomeUnitGraph -> SDoc
ppr HomeUnitGraph
g = forall a. Outputable a => a -> SDoc
ppr [(UnitId
k, forall (t :: * -> *) a. Foldable t => t a -> Int
length (HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt  HomeUnitEnv
hue)) | (UnitId
k, HomeUnitEnv
hue) <- (forall v. UnitEnvGraph v -> [(UnitId, v)]
unitEnv_elts HomeUnitGraph
g)]


type UnitEnvGraphKey = UnitId

newtype UnitEnvGraph v = UnitEnvGraph
  { forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph :: Map UnitEnvGraphKey v
  } deriving (forall a b. a -> UnitEnvGraph b -> UnitEnvGraph a
forall a b. (a -> b) -> UnitEnvGraph a -> UnitEnvGraph b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> UnitEnvGraph b -> UnitEnvGraph a
$c<$ :: forall a b. a -> UnitEnvGraph b -> UnitEnvGraph a
fmap :: forall a b. (a -> b) -> UnitEnvGraph a -> UnitEnvGraph b
$cfmap :: forall a b. (a -> b) -> UnitEnvGraph a -> UnitEnvGraph b
Functor, forall a. Eq a => a -> UnitEnvGraph a -> Bool
forall a. Num a => UnitEnvGraph a -> a
forall a. Ord a => UnitEnvGraph a -> a
forall m. Monoid m => UnitEnvGraph m -> m
forall a. UnitEnvGraph a -> Bool
forall a. UnitEnvGraph a -> Int
forall a. UnitEnvGraph a -> [a]
forall a. (a -> a -> a) -> UnitEnvGraph a -> a
forall m a. Monoid m => (a -> m) -> UnitEnvGraph a -> m
forall b a. (b -> a -> b) -> b -> UnitEnvGraph a -> b
forall a b. (a -> b -> b) -> b -> UnitEnvGraph a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => UnitEnvGraph a -> a
$cproduct :: forall a. Num a => UnitEnvGraph a -> a
sum :: forall a. Num a => UnitEnvGraph a -> a
$csum :: forall a. Num a => UnitEnvGraph a -> a
minimum :: forall a. Ord a => UnitEnvGraph a -> a
$cminimum :: forall a. Ord a => UnitEnvGraph a -> a
maximum :: forall a. Ord a => UnitEnvGraph a -> a
$cmaximum :: forall a. Ord a => UnitEnvGraph a -> a
elem :: forall a. Eq a => a -> UnitEnvGraph a -> Bool
$celem :: forall a. Eq a => a -> UnitEnvGraph a -> Bool
length :: forall a. UnitEnvGraph a -> Int
$clength :: forall a. UnitEnvGraph a -> Int
null :: forall a. UnitEnvGraph a -> Bool
$cnull :: forall a. UnitEnvGraph a -> Bool
toList :: forall a. UnitEnvGraph a -> [a]
$ctoList :: forall a. UnitEnvGraph a -> [a]
foldl1 :: forall a. (a -> a -> a) -> UnitEnvGraph a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> UnitEnvGraph a -> a
foldr1 :: forall a. (a -> a -> a) -> UnitEnvGraph a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> UnitEnvGraph a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> UnitEnvGraph a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> UnitEnvGraph a -> b
foldl :: forall b a. (b -> a -> b) -> b -> UnitEnvGraph a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> UnitEnvGraph a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> UnitEnvGraph a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> UnitEnvGraph a -> b
foldr :: forall a b. (a -> b -> b) -> b -> UnitEnvGraph a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> UnitEnvGraph a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> UnitEnvGraph a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> UnitEnvGraph a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> UnitEnvGraph a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> UnitEnvGraph a -> m
fold :: forall m. Monoid m => UnitEnvGraph m -> m
$cfold :: forall m. Monoid m => UnitEnvGraph m -> m
Foldable, Functor UnitEnvGraph
Foldable UnitEnvGraph
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
UnitEnvGraph (m a) -> m (UnitEnvGraph a)
forall (f :: * -> *) a.
Applicative f =>
UnitEnvGraph (f a) -> f (UnitEnvGraph a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnitEnvGraph a -> m (UnitEnvGraph b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnitEnvGraph a -> f (UnitEnvGraph b)
sequence :: forall (m :: * -> *) a.
Monad m =>
UnitEnvGraph (m a) -> m (UnitEnvGraph a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
UnitEnvGraph (m a) -> m (UnitEnvGraph a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnitEnvGraph a -> m (UnitEnvGraph b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnitEnvGraph a -> m (UnitEnvGraph b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnitEnvGraph (f a) -> f (UnitEnvGraph a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnitEnvGraph (f a) -> f (UnitEnvGraph a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnitEnvGraph a -> f (UnitEnvGraph b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnitEnvGraph a -> f (UnitEnvGraph b)
Traversable)

unitEnv_insert :: UnitEnvGraphKey -> v -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_insert :: forall v. UnitId -> v -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_insert UnitId
unitId v
env UnitEnvGraph v
unitEnv = UnitEnvGraph v
unitEnv
  { unitEnv_graph :: Map UnitId v
unitEnv_graph = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert UnitId
unitId v
env (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
unitEnv)
  }

unitEnv_delete :: UnitEnvGraphKey -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_delete :: forall v. UnitId -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_delete UnitId
uid UnitEnvGraph v
unitEnv =
    UnitEnvGraph v
unitEnv
      { unitEnv_graph :: Map UnitId v
unitEnv_graph = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete UnitId
uid (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
unitEnv)
      }

unitEnv_adjust :: (v -> v) -> UnitEnvGraphKey -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_adjust :: forall v. (v -> v) -> UnitId -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_adjust v -> v
f UnitId
uid UnitEnvGraph v
unitEnv = UnitEnvGraph v
unitEnv
  { unitEnv_graph :: Map UnitId v
unitEnv_graph = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust v -> v
f UnitId
uid (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
unitEnv)
  }

unitEnv_alter :: (Maybe v -> Maybe v) -> UnitEnvGraphKey -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_alter :: forall v.
(Maybe v -> Maybe v) -> UnitId -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_alter Maybe v -> Maybe v
f UnitId
uid UnitEnvGraph v
unitEnv = UnitEnvGraph v
unitEnv
  { unitEnv_graph :: Map UnitId v
unitEnv_graph = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe v -> Maybe v
f UnitId
uid (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
unitEnv)
  }

unitEnv_mapWithKey :: (UnitEnvGraphKey -> v -> b) -> UnitEnvGraph v -> UnitEnvGraph b
unitEnv_mapWithKey :: forall v b. (UnitId -> v -> b) -> UnitEnvGraph v -> UnitEnvGraph b
unitEnv_mapWithKey UnitId -> v -> b
f (UnitEnvGraph Map UnitId v
u) = forall v. Map UnitId v -> UnitEnvGraph v
UnitEnvGraph forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey UnitId -> v -> b
f Map UnitId v
u

unitEnv_new :: Map UnitEnvGraphKey v -> UnitEnvGraph v
unitEnv_new :: forall v. Map UnitId v -> UnitEnvGraph v
unitEnv_new Map UnitId v
m =
  UnitEnvGraph
    { unitEnv_graph :: Map UnitId v
unitEnv_graph = Map UnitId v
m
    }

unitEnv_singleton :: UnitEnvGraphKey -> v -> UnitEnvGraph v
unitEnv_singleton :: forall v. UnitId -> v -> UnitEnvGraph v
unitEnv_singleton UnitId
active v
m = UnitEnvGraph
  { unitEnv_graph :: Map UnitId v
unitEnv_graph = forall k a. k -> a -> Map k a
Map.singleton UnitId
active v
m
  }

unitEnv_map :: (v -> v) -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_map :: forall v. (v -> v) -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_map v -> v
f UnitEnvGraph v
m = UnitEnvGraph v
m { unitEnv_graph :: Map UnitId v
unitEnv_graph = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map v -> v
f (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
m)}

unitEnv_member :: UnitEnvGraphKey -> UnitEnvGraph v -> Bool
unitEnv_member :: forall v. UnitId -> UnitEnvGraph v -> Bool
unitEnv_member UnitId
u UnitEnvGraph v
env = forall k a. Ord k => k -> Map k a -> Bool
Map.member UnitId
u (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
env)

unitEnv_lookup_maybe :: UnitEnvGraphKey -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe :: forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe UnitId
u UnitEnvGraph v
env = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
u (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
env)

unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v
unitEnv_lookup :: forall v. UnitId -> UnitEnvGraph v -> v
unitEnv_lookup UnitId
u UnitEnvGraph v
env = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe UnitId
u UnitEnvGraph v
env

unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey
unitEnv_keys :: forall v. UnitEnvGraph v -> Set UnitId
unitEnv_keys UnitEnvGraph v
env = forall k a. Map k a -> Set k
Map.keysSet (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
env)

unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)]
unitEnv_elts :: forall v. UnitEnvGraph v -> [(UnitId, v)]
unitEnv_elts UnitEnvGraph v
env = forall k a. Map k a -> [(k, a)]
Map.toList (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph UnitEnvGraph v
env)

unitEnv_hpts :: UnitEnvGraph HomeUnitEnv -> [HomePackageTable]
unitEnv_hpts :: HomeUnitGraph -> [HomePackageTable]
unitEnv_hpts HomeUnitGraph
env = forall a b. (a -> b) -> [a] -> [b]
map HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt (forall k a. Map k a -> [a]
Map.elems (forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph HomeUnitGraph
env))

unitEnv_foldWithKey :: (b -> UnitEnvGraphKey -> a -> b) -> b -> UnitEnvGraph a -> b
unitEnv_foldWithKey :: forall b a. (b -> UnitId -> a -> b) -> b -> UnitEnvGraph a -> b
unitEnv_foldWithKey b -> UnitId -> a -> b
f b
z (UnitEnvGraph Map UnitId a
g)= forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' b -> UnitId -> a -> b
f b
z Map UnitId a
g

unitEnv_union :: (a -> a -> a) -> UnitEnvGraph a -> UnitEnvGraph a -> UnitEnvGraph a
unitEnv_union :: forall a.
(a -> a -> a) -> UnitEnvGraph a -> UnitEnvGraph a -> UnitEnvGraph a
unitEnv_union a -> a -> a
f (UnitEnvGraph Map UnitId a
env1) (UnitEnvGraph Map UnitId a
env2) = forall v. Map UnitId v -> UnitEnvGraph v
UnitEnvGraph (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
f Map UnitId a
env1 Map UnitId a
env2)

-- -------------------------------------------------------
-- Query and modify UnitState in HomeUnitEnv
-- -------------------------------------------------------

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

ue_setUnits :: UnitState -> UnitEnv -> UnitEnv
ue_setUnits :: UnitState -> UnitEnv -> UnitEnv
ue_setUnits UnitState
units UnitEnv
ue = (HomeUnitEnv -> HomeUnitEnv) -> UnitId -> UnitEnv -> UnitEnv
ue_updateHomeUnitEnv HomeUnitEnv -> HomeUnitEnv
f (UnitEnv -> UnitId
ue_currentUnit UnitEnv
ue) UnitEnv
ue
  where
    f :: HomeUnitEnv -> HomeUnitEnv
f HomeUnitEnv
hue = HomeUnitEnv
hue { homeUnitEnv_units :: UnitState
homeUnitEnv_units = UnitState
units  }

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

ue_setUnitDbs :: Maybe [UnitDatabase UnitId] -> UnitEnv -> UnitEnv
ue_setUnitDbs :: Maybe [UnitDatabase UnitId] -> UnitEnv -> UnitEnv
ue_setUnitDbs Maybe [UnitDatabase UnitId]
unit_dbs UnitEnv
ue = (HomeUnitEnv -> HomeUnitEnv) -> UnitId -> UnitEnv -> UnitEnv
ue_updateHomeUnitEnv HomeUnitEnv -> HomeUnitEnv
f (UnitEnv -> UnitId
ue_currentUnit UnitEnv
ue) UnitEnv
ue
  where
    f :: HomeUnitEnv -> HomeUnitEnv
f HomeUnitEnv
hue = HomeUnitEnv
hue { homeUnitEnv_unit_dbs :: Maybe [UnitDatabase UnitId]
homeUnitEnv_unit_dbs = Maybe [UnitDatabase UnitId]
unit_dbs  }

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

ue_hpt :: HasDebugCallStack => UnitEnv -> HomePackageTable
ue_hpt :: HasDebugCallStack => UnitEnv -> HomePackageTable
ue_hpt = HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnitEnv -> HomeUnitEnv
ue_currentHomeUnitEnv

ue_updateHPT_lazy :: HasDebugCallStack => (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
ue_updateHPT_lazy :: HasDebugCallStack =>
(HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
ue_updateHPT_lazy HomePackageTable -> HomePackageTable
f UnitEnv
e = HasDebugCallStack =>
(HomePackageTable -> HomePackageTable)
-> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitHPT_lazy HomePackageTable -> HomePackageTable
f (UnitEnv -> UnitId
ue_currentUnit UnitEnv
e) UnitEnv
e

ue_updateHPT :: HasDebugCallStack => (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
ue_updateHPT :: HasDebugCallStack =>
(HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
ue_updateHPT HomePackageTable -> HomePackageTable
f UnitEnv
e = HasDebugCallStack =>
(HomePackageTable -> HomePackageTable)
-> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitHPT HomePackageTable -> HomePackageTable
f (UnitEnv -> UnitId
ue_currentUnit UnitEnv
e) 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
ue_updateUnitHUG HomeUnitGraph -> HomeUnitGraph
f UnitEnv
e

ue_updateUnitHPT_lazy :: HasDebugCallStack => (HomePackageTable -> HomePackageTable) -> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitHPT_lazy :: HasDebugCallStack =>
(HomePackageTable -> HomePackageTable)
-> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitHPT_lazy HomePackageTable -> HomePackageTable
f UnitId
uid UnitEnv
ue_env = (HomeUnitEnv -> HomeUnitEnv) -> UnitId -> UnitEnv -> UnitEnv
ue_updateHomeUnitEnv HomeUnitEnv -> HomeUnitEnv
update UnitId
uid UnitEnv
ue_env
  where
    update :: HomeUnitEnv -> HomeUnitEnv
update HomeUnitEnv
unitEnv = HomeUnitEnv
unitEnv { homeUnitEnv_hpt :: HomePackageTable
homeUnitEnv_hpt = HomePackageTable -> HomePackageTable
f forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
unitEnv }

ue_updateUnitHPT :: HasDebugCallStack => (HomePackageTable -> HomePackageTable) -> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitHPT :: HasDebugCallStack =>
(HomePackageTable -> HomePackageTable)
-> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitHPT HomePackageTable -> HomePackageTable
f UnitId
uid UnitEnv
ue_env = (HomeUnitEnv -> HomeUnitEnv) -> UnitId -> UnitEnv -> UnitEnv
ue_updateHomeUnitEnv HomeUnitEnv -> HomeUnitEnv
update UnitId
uid UnitEnv
ue_env
  where
    update :: HomeUnitEnv -> HomeUnitEnv
update HomeUnitEnv
unitEnv =
      let !res :: HomePackageTable
res = HomePackageTable -> HomePackageTable
f forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
unitEnv
      in HomeUnitEnv
unitEnv { homeUnitEnv_hpt :: HomePackageTable
homeUnitEnv_hpt = HomePackageTable
res }

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 :: HomeUnitGraph
ue_home_unit_graph = HomeUnitGraph -> HomeUnitGraph
f (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
ue_env)}

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

ue_setFlags :: HasDebugCallStack => DynFlags -> UnitEnv -> UnitEnv
ue_setFlags :: HasDebugCallStack => DynFlags -> UnitEnv -> UnitEnv
ue_setFlags DynFlags
dflags UnitEnv
ue_env = HasDebugCallStack => UnitId -> DynFlags -> UnitEnv -> UnitEnv
ue_setUnitFlags (UnitEnv -> UnitId
ue_currentUnit UnitEnv
ue_env) DynFlags
dflags UnitEnv
ue_env

ue_setUnitFlags :: HasDebugCallStack => UnitId -> DynFlags -> UnitEnv -> UnitEnv
ue_setUnitFlags :: HasDebugCallStack => UnitId -> DynFlags -> UnitEnv -> UnitEnv
ue_setUnitFlags UnitId
uid DynFlags
dflags UnitEnv
e =
  HasDebugCallStack =>
(DynFlags -> DynFlags) -> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitFlags (forall a b. a -> b -> a
const DynFlags
dflags) UnitId
uid UnitEnv
e

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

ue_updateUnitFlags :: HasDebugCallStack => (DynFlags -> DynFlags) -> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitFlags :: HasDebugCallStack =>
(DynFlags -> DynFlags) -> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitFlags DynFlags -> DynFlags
f UnitId
uid UnitEnv
e = (HomeUnitEnv -> HomeUnitEnv) -> UnitId -> UnitEnv -> UnitEnv
ue_updateHomeUnitEnv HomeUnitEnv -> HomeUnitEnv
update UnitId
uid UnitEnv
e
  where
    update :: HomeUnitEnv -> HomeUnitEnv
update HomeUnitEnv
hue = HomeUnitEnv
hue { homeUnitEnv_dflags :: DynFlags
homeUnitEnv_dflags = DynFlags -> DynFlags
f forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> DynFlags
homeUnitEnv_dflags HomeUnitEnv
hue }

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

ue_homeUnit :: UnitEnv -> Maybe HomeUnit
ue_homeUnit :: UnitEnv -> Maybe HomeUnit
ue_homeUnit = HomeUnitEnv -> Maybe HomeUnit
homeUnitEnv_home_unit forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => 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 -> forall a. String -> a
panic String
"unsafeGetHomeUnit: No home unit"
  Just HomeUnit
h  -> HomeUnit
h

ue_unitHomeUnit_maybe :: UnitId -> UnitEnv -> Maybe HomeUnit
ue_unitHomeUnit_maybe :: UnitId -> UnitEnv -> Maybe HomeUnit
ue_unitHomeUnit_maybe UnitId
uid UnitEnv
ue_env =
  HomeUnitEnv -> HomeUnit
homeUnitEnv_unsafeHomeUnit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnitId -> UnitEnv -> Maybe HomeUnitEnv
ue_findHomeUnitEnv_maybe UnitId
uid UnitEnv
ue_env)

ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit
ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit
ue_unitHomeUnit UnitId
uid UnitEnv
ue_env = HomeUnitEnv -> HomeUnit
homeUnitEnv_unsafeHomeUnit forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid 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 -> UnitEnv -> Maybe HomeUnitEnv
ue_findHomeUnitEnv_maybe (UnitEnv -> UnitId
ue_currentUnit UnitEnv
e) UnitEnv
e of
    Just HomeUnitEnv
unitEnv -> HomeUnitEnv
unitEnv
    Maybe HomeUnitEnv
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"packageNotFound" forall a b. (a -> b) -> a -> b
$
      (forall a. Outputable a => a -> SDoc
ppr forall a b. (a -> b) -> a -> b
$ UnitEnv -> UnitId
ue_currentUnit UnitEnv
e) SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr (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
assertUnitEnvInvariant forall a b. (a -> b) -> a -> b
$ UnitEnv
ue_env
  { ue_current_unit :: UnitId
ue_current_unit = UnitId
u
  }

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

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

ue_findHomeUnitEnv_maybe :: UnitId -> UnitEnv -> Maybe HomeUnitEnv
ue_findHomeUnitEnv_maybe :: UnitId -> UnitEnv -> Maybe HomeUnitEnv
ue_findHomeUnitEnv_maybe UnitId
uid UnitEnv
e =
  forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe UnitId
uid (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e)

ue_findHomeUnitEnv :: HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv :: HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
e = case forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe UnitId
uid (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e) of
  Maybe HomeUnitEnv
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unit unknown to the internal unit environment"
              forall a b. (a -> b) -> a -> b
$  String -> SDoc
text String
"unit (" SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr UnitId
uid SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
")"
              SDoc -> SDoc -> SDoc
$$ UnitEnv -> SDoc
pprUnitEnvGraph UnitEnv
e
  Just HomeUnitEnv
hue -> HomeUnitEnv
hue

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 :: HomeUnitGraph
ue_home_unit_graph = forall v. (v -> v) -> UnitId -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_adjust HomeUnitEnv -> HomeUnitEnv
f UnitId
uid forall a b. (a -> b) -> a -> b
$ UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
e
  }


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

      newInternalUnitEnv :: HomeUnitEnv
newInternalUnitEnv = HomeUnitEnv
oldEnv
        { homeUnitEnv_dflags :: DynFlags
homeUnitEnv_dflags = (HomeUnitEnv -> DynFlags
homeUnitEnv_dflags HomeUnitEnv
oldEnv)
            { homeUnitId_ :: UnitId
homeUnitId_ = UnitId
newUnit
            }
        }
    in
    UnitEnv
unitEnv
      { ue_current_unit :: UnitId
ue_current_unit = UnitId
activeUnit
      , ue_home_unit_graph :: HomeUnitGraph
ue_home_unit_graph =
          forall v. UnitId -> v -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_insert UnitId
newUnit HomeUnitEnv
newInternalUnitEnv
          forall a b. (a -> b) -> a -> b
$ forall v. UnitId -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_delete UnitId
oldUnit
          forall a b. (a -> b) -> a -> b
$ UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
unitEnv
          }

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

assertUnitEnvInvariant :: HasDebugCallStack => UnitEnv -> UnitEnv
assertUnitEnvInvariant :: HasDebugCallStack => UnitEnv -> UnitEnv
assertUnitEnvInvariant UnitEnv
u =
  if UnitEnv -> UnitId
ue_current_unit UnitEnv
u forall v. UnitId -> UnitEnvGraph v -> Bool
`unitEnv_member` UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
u
    then UnitEnv
u
    else forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"invariant" (forall a. Outputable a => a -> SDoc
ppr (UnitEnv -> UnitId
ue_current_unit UnitEnv
u) SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
u))

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

pprUnitEnvGraph :: UnitEnv -> SDoc
pprUnitEnvGraph :: UnitEnv -> SDoc
pprUnitEnvGraph UnitEnv
env = String -> SDoc
text String
"pprInternalUnitMap"
  SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (HomeUnitGraph -> SDoc
pprHomeUnitGraph forall a b. (a -> b) -> a -> b
$ UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
env)

pprHomeUnitGraph :: HomeUnitGraph -> SDoc
pprHomeUnitGraph :: HomeUnitGraph -> SDoc
pprHomeUnitGraph HomeUnitGraph
unitEnv = [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (\(UnitId
k, HomeUnitEnv
v) -> UnitId -> HomeUnitEnv -> SDoc
pprHomeUnitEnv UnitId
k HomeUnitEnv
v) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.assocs forall a b. (a -> b) -> a -> b
$ forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph HomeUnitGraph
unitEnv)

pprHomeUnitEnv :: UnitId -> HomeUnitEnv -> SDoc
pprHomeUnitEnv :: UnitId -> HomeUnitEnv -> SDoc
pprHomeUnitEnv UnitId
uid HomeUnitEnv
env =
  forall a. Outputable a => a -> SDoc
ppr UnitId
uid SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"(flags:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (DynFlags -> UnitId
homeUnitId_ forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> DynFlags
homeUnitEnv_dflags HomeUnitEnv
env) SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"," SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall u. GenHomeUnit u -> UnitId
homeUnitId forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> Maybe HomeUnit
homeUnitEnv_home_unit HomeUnitEnv
env) SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
")" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"->"
  SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
4 (HomePackageTable -> SDoc
pprHPT forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
env)

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

-}