{-# 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_all_home_unit_ids
    , 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 Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import GHC.Utils.Misc (HasDebugCallStack)
import GHC.Driver.DynFlags
import GHC.Utils.Outputable
import GHC.Utils.Panic
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 (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
    }

-- | 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
(HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
ue_updateHPT_lazy

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

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

ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId]
ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId]
ue_transitiveHomeDeps UnitId
uid UnitEnv
unit_env = Set UnitId -> [UnitId]
forall a. Set a -> [a]
Set.toList (Set UnitId -> [UnitId] -> Set UnitId
loop Set UnitId
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 UnitId -> Set UnitId -> Bool
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
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
unit_env))
        in Set UnitId -> [UnitId] -> Set UnitId
loop (UnitId -> Set UnitId -> Set UnitId
forall a. Ord a => a -> Set a -> Set a
Set.insert UnitId
uid Set UnitId
acc) ([UnitId]
hue [UnitId] -> [UnitId] -> [UnitId]
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
UnitEnv -> UnitState
ue_units 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, Module) -> UnitId)
-> [(ModuleName, Module)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Unit -> UnitId
toUnitId (Unit -> UnitId)
-> ((ModuleName, Module) -> Unit) -> (ModuleName, Module) -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit)
-> ((ModuleName, Module) -> Module) -> (ModuleName, Module) -> Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, Module) -> Module
forall a b. (a, b) -> b
snd) (HomeUnit -> [(ModuleName, Module)]
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 []

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

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 -> String -> HomeUnit
forall a. HasCallStack => 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 = Maybe [UnitDatabase UnitId]
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 = 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


type HomeUnitGraph = UnitEnvGraph HomeUnitEnv

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

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

addHomeModInfoToHug :: HomeModInfo -> HomeUnitGraph -> HomeUnitGraph
addHomeModInfoToHug :: HomeModInfo -> HomeUnitGraph -> HomeUnitGraph
addHomeModInfoToHug HomeModInfo
hmi HomeUnitGraph
hug = (Maybe HomeUnitEnv -> Maybe HomeUnitEnv)
-> UnitId -> HomeUnitGraph -> HomeUnitGraph
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 = ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hmi)

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

    go :: Maybe HomeUnitEnv -> Maybe HomeUnitEnv
    go :: Maybe HomeUnitEnv -> Maybe HomeUnitEnv
go Maybe HomeUnitEnv
Nothing = String -> SDoc -> Maybe HomeUnitEnv
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"addHomeInfoToHug" (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
hmi_mod)
    go (Just HomeUnitEnv
hue) = HomeUnitEnv -> Maybe HomeUnitEnv
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 = hpt }


lookupHug :: HomeUnitGraph -> UnitId -> ModuleName -> Maybe HomeModInfo
lookupHug :: HomeUnitGraph -> UnitId -> ModuleName -> Maybe HomeModInfo
lookupHug HomeUnitGraph
hug UnitId
uid ModuleName
mod = UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe UnitId
uid HomeUnitGraph
hug Maybe HomeUnitEnv
-> (HomeUnitEnv -> Maybe HomeModInfo) -> Maybe HomeModInfo
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HomePackageTable -> ModuleName -> Maybe HomeModInfo)
-> ModuleName -> HomePackageTable -> Maybe HomeModInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt ModuleName
mod (HomePackageTable -> Maybe HomeModInfo)
-> (HomeUnitEnv -> HomePackageTable)
-> HomeUnitEnv
-> Maybe HomeModInfo
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 = [(UnitId, Int)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(UnitId
k, HomePackageTable -> Int
forall a. UniqDFM ModuleName a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt  HomeUnitEnv
hue)) | (UnitId
k, HomeUnitEnv
hue) <- (HomeUnitGraph -> [(UnitId, HomeUnitEnv)]
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 -> b) -> UnitEnvGraph a -> UnitEnvGraph b)
-> (forall a b. a -> UnitEnvGraph b -> UnitEnvGraph a)
-> Functor UnitEnvGraph
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
$cfmap :: forall a b. (a -> b) -> UnitEnvGraph a -> UnitEnvGraph b
fmap :: forall a b. (a -> b) -> UnitEnvGraph a -> UnitEnvGraph b
$c<$ :: forall a b. a -> UnitEnvGraph b -> UnitEnvGraph a
<$ :: forall a b. a -> UnitEnvGraph b -> UnitEnvGraph a
Functor, (forall m. Monoid m => UnitEnvGraph m -> m)
-> (forall m a. Monoid m => (a -> m) -> UnitEnvGraph a -> m)
-> (forall m a. Monoid m => (a -> m) -> UnitEnvGraph a -> m)
-> (forall a b. (a -> b -> b) -> b -> UnitEnvGraph a -> b)
-> (forall a b. (a -> b -> b) -> b -> UnitEnvGraph a -> b)
-> (forall b a. (b -> a -> b) -> b -> UnitEnvGraph a -> b)
-> (forall b a. (b -> a -> b) -> b -> UnitEnvGraph a -> b)
-> (forall a. (a -> a -> a) -> UnitEnvGraph a -> a)
-> (forall a. (a -> a -> a) -> UnitEnvGraph a -> a)
-> (forall a. UnitEnvGraph a -> [a])
-> (forall a. UnitEnvGraph a -> Bool)
-> (forall a. UnitEnvGraph a -> Int)
-> (forall a. Eq a => a -> UnitEnvGraph a -> Bool)
-> (forall a. Ord a => UnitEnvGraph a -> a)
-> (forall a. Ord a => UnitEnvGraph a -> a)
-> (forall a. Num a => UnitEnvGraph a -> a)
-> (forall a. Num a => UnitEnvGraph a -> a)
-> Foldable UnitEnvGraph
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
$cfold :: forall m. Monoid m => UnitEnvGraph m -> m
fold :: forall m. Monoid m => UnitEnvGraph m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> UnitEnvGraph a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> UnitEnvGraph a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> UnitEnvGraph a -> a
foldr1 :: forall a. (a -> a -> a) -> UnitEnvGraph a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> UnitEnvGraph a -> a
foldl1 :: forall a. (a -> a -> a) -> UnitEnvGraph a -> a
$ctoList :: forall a. UnitEnvGraph a -> [a]
toList :: forall a. UnitEnvGraph a -> [a]
$cnull :: forall a. UnitEnvGraph a -> Bool
null :: forall a. UnitEnvGraph a -> Bool
$clength :: forall a. UnitEnvGraph a -> Int
length :: forall a. UnitEnvGraph a -> Int
$celem :: forall a. Eq a => a -> UnitEnvGraph a -> Bool
elem :: forall a. Eq a => a -> UnitEnvGraph a -> Bool
$cmaximum :: forall a. Ord a => UnitEnvGraph a -> a
maximum :: forall a. Ord a => UnitEnvGraph a -> a
$cminimum :: forall a. Ord a => UnitEnvGraph a -> a
minimum :: forall a. Ord a => UnitEnvGraph a -> a
$csum :: forall a. Num a => UnitEnvGraph a -> a
sum :: forall a. Num a => UnitEnvGraph a -> a
$cproduct :: forall a. Num a => UnitEnvGraph a -> a
product :: forall a. Num a => UnitEnvGraph a -> a
Foldable, Functor UnitEnvGraph
Foldable UnitEnvGraph
(Functor UnitEnvGraph, Foldable UnitEnvGraph) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> UnitEnvGraph a -> f (UnitEnvGraph b))
-> (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 (m :: * -> *) a.
    Monad m =>
    UnitEnvGraph (m a) -> m (UnitEnvGraph a))
-> Traversable 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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnitEnvGraph a -> f (UnitEnvGraph b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnitEnvGraph a -> f (UnitEnvGraph b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnitEnvGraph (f a) -> f (UnitEnvGraph a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnitEnvGraph (f a) -> f (UnitEnvGraph a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnitEnvGraph a -> m (UnitEnvGraph b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnitEnvGraph a -> m (UnitEnvGraph b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
UnitEnvGraph (m a) -> m (UnitEnvGraph a)
sequence :: forall (m :: * -> *) a.
Monad m =>
UnitEnvGraph (m a) -> m (UnitEnvGraph a)
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.insert unitId env (unitEnv_graph 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.delete uid (unitEnv_graph 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.adjust f uid (unitEnv_graph 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.alter f uid (unitEnv_graph 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) = Map UnitId b -> UnitEnvGraph b
forall v. Map UnitId v -> UnitEnvGraph v
UnitEnvGraph (Map UnitId b -> UnitEnvGraph b) -> Map UnitId b -> UnitEnvGraph b
forall a b. (a -> b) -> a -> b
$ (UnitId -> v -> b) -> Map UnitId v -> Map UnitId 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 = UnitId -> v -> Map UnitId v
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.map f (unitEnv_graph m)}

unitEnv_member :: UnitEnvGraphKey -> UnitEnvGraph v -> Bool
unitEnv_member :: forall v. UnitId -> UnitEnvGraph v -> Bool
unitEnv_member UnitId
u UnitEnvGraph v
env = UnitId -> Map UnitId v -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member UnitId
u (UnitEnvGraph v -> Map UnitId v
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 = UnitId -> Map UnitId v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
u (UnitEnvGraph v -> Map UnitId v
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 = Maybe v -> v
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe v -> v) -> Maybe v -> v
forall a b. (a -> b) -> a -> b
$ UnitId -> UnitEnvGraph v -> Maybe v
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 = Map UnitId v -> Set UnitId
forall k a. Map k a -> Set k
Map.keysSet (UnitEnvGraph v -> Map UnitId v
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 = Map UnitId v -> [(UnitId, v)]
forall k a. Map k a -> [(k, a)]
Map.toList (UnitEnvGraph v -> Map UnitId v
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 = (HomeUnitEnv -> HomePackageTable)
-> [HomeUnitEnv] -> [HomePackageTable]
forall a b. (a -> b) -> [a] -> [b]
map HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt (Map UnitId HomeUnitEnv -> [HomeUnitEnv]
forall k a. Map k a -> [a]
Map.elems (HomeUnitGraph -> Map UnitId HomeUnitEnv
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)= (b -> UnitId -> a -> b) -> b -> Map UnitId a -> b
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) = Map UnitId a -> UnitEnvGraph a
forall v. Map UnitId v -> UnitEnvGraph v
UnitEnvGraph ((a -> a -> a) -> Map UnitId a -> Map UnitId a -> Map UnitId a
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 (HomeUnitEnv -> UnitState)
-> (UnitEnv -> HomeUnitEnv) -> UnitEnv -> UnitState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnitEnv -> HomeUnitEnv
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 = 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 (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

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 = 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 (HomeUnitEnv -> HomePackageTable)
-> (UnitEnv -> HomeUnitEnv) -> UnitEnv -> HomePackageTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnitEnv -> HomeUnitEnv
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
(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
(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
(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 = f $ homeUnitEnv_hpt 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 (HomePackageTable -> HomePackageTable)
-> HomePackageTable -> HomePackageTable
forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
unitEnv
      in HomeUnitEnv
unitEnv { homeUnitEnv_hpt = 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 = f (ue_home_unit_graph 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
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
(DynFlags -> DynFlags) -> UnitId -> UnitEnv -> UnitEnv
ue_updateUnitFlags (DynFlags -> DynFlags -> DynFlags
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 (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

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 = f $ homeUnitEnv_dflags 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 (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
"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 (HomeUnitEnv -> HomeUnit) -> Maybe HomeUnitEnv -> Maybe HomeUnit
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 (HomeUnitEnv -> HomeUnit) -> HomeUnitEnv -> HomeUnit
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv
UnitId -> UnitEnv -> HomeUnitEnv
ue_findHomeUnitEnv UnitId
uid UnitEnv
ue_env

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
forall v. UnitEnvGraph v -> Set UnitId
unitEnv_keys (HomeUnitGraph -> Set UnitId)
-> (UnitEnv -> HomeUnitGraph) -> UnitEnv -> Set UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitEnv -> HomeUnitGraph
ue_home_unit_graph
-- -------------------------------------------------------
-- 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 -> 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
$$ HomeUnitGraph -> 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
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


-- -------------------------------------------------------
-- 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 =
  UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
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 UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv
forall v. UnitId -> UnitEnvGraph v -> Maybe v
unitEnv_lookup_maybe 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
$$ 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 = unitEnv_adjust f uid $ ue_home_unit_graph 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 ->
    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 (UnitEnv -> SDoc
pprUnitEnvGraph UnitEnv
unitEnv)
  Just HomeUnitEnv
oldEnv ->
    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

      newInternalUnitEnv :: HomeUnitEnv
newInternalUnitEnv = HomeUnitEnv
oldEnv
        { homeUnitEnv_dflags = (homeUnitEnv_dflags oldEnv)
            { homeUnitId_ = newUnit
            }
        }
    in
    UnitEnv
unitEnv
      { ue_current_unit = activeUnit
      , ue_home_unit_graph =
          unitEnv_insert newUnit newInternalUnitEnv
          $ unitEnv_delete oldUnit
          $ ue_home_unit_graph 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 UnitId -> HomeUnitGraph -> Bool
forall v. UnitId -> UnitEnvGraph v -> Bool
`unitEnv_member` UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
u
    then UnitEnv
u
    else 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
$$ HomeUnitGraph -> 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
forall doc. IsLine doc => String -> doc
text String
"pprInternalUnitMap"
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (HomeUnitGraph -> SDoc
pprHomeUnitGraph (HomeUnitGraph -> SDoc) -> HomeUnitGraph -> SDoc
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
forall doc. IsDoc doc => [doc] -> doc
vcat (((UnitId, HomeUnitEnv) -> SDoc)
-> [(UnitId, HomeUnitEnv)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnitId
k, HomeUnitEnv
v) -> UnitId -> HomeUnitEnv -> SDoc
pprHomeUnitEnv UnitId
k HomeUnitEnv
v) ([(UnitId, HomeUnitEnv)] -> [SDoc])
-> [(UnitId, HomeUnitEnv)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ Map UnitId HomeUnitEnv -> [(UnitId, HomeUnitEnv)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map UnitId HomeUnitEnv -> [(UnitId, HomeUnitEnv)])
-> Map UnitId HomeUnitEnv -> [(UnitId, HomeUnitEnv)]
forall a b. (a -> b) -> a -> b
$ HomeUnitGraph -> Map UnitId HomeUnitEnv
forall v. UnitEnvGraph v -> Map UnitId v
unitEnv_graph HomeUnitGraph
unitEnv)

pprHomeUnitEnv :: UnitId -> HomeUnitEnv -> SDoc
pprHomeUnitEnv :: UnitId -> HomeUnitEnv -> SDoc
pprHomeUnitEnv UnitId
uid HomeUnitEnv
env =
  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
"(flags:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DynFlags -> UnitId
homeUnitId_ (DynFlags -> UnitId) -> DynFlags -> UnitId
forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> DynFlags
homeUnitEnv_dflags HomeUnitEnv
env) 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. IsLine doc => doc -> doc -> doc
<+> Maybe UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((HomeUnit -> UnitId) -> Maybe HomeUnit -> Maybe UnitId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId (Maybe HomeUnit -> Maybe UnitId) -> Maybe HomeUnit -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ HomeUnitEnv -> Maybe HomeUnit
homeUnitEnv_home_unit HomeUnitEnv
env) 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. 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
4 (HomePackageTable -> SDoc
pprHPT (HomePackageTable -> SDoc) -> HomePackageTable -> SDoc
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.

-}