{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
module GHC.Unit.Env
( UnitEnv (..)
, initUnitEnv
, ueEPS
, unsafeGetHomeUnit
, updateHug
, updateHpt_lazy
, updateHpt
, 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
, HomeUnitGraph
, HomeUnitEnv (..)
, mkHomeUnitEnv
, lookupHugByModule
, hugElts
, lookupHug
, addHomeModInfoToHug
, 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
, assertUnitEnvInvariant
, preloadUnitsInfo
, preloadUnitsInfo'
, 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.DynFlags
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
, UnitEnv -> UnitId
ue_current_unit :: UnitId
, UnitEnv -> HomeUnitGraph
ue_home_unit_graph :: !HomeUnitGraph
, UnitEnv -> Platform
ue_platform :: !Platform
, UnitEnv -> GhcNameVersion
ue_namever :: !GhcNameVersion
}
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
ExternalUnitCache
eps <- IO ExternalUnitCache
initExternalUnitCache
UnitEnv -> IO UnitEnv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitEnv -> IO UnitEnv) -> UnitEnv -> IO UnitEnv
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
}
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)
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
| 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
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
, HomeUnitEnv -> Maybe [UnitDatabase UnitId]
homeUnitEnv_unit_dbs :: !(Maybe [UnitDatabase UnitId])
, HomeUnitEnv -> DynFlags
homeUnitEnv_dflags :: DynFlags
, HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt :: HomePackageTable
, HomeUnitEnv -> Maybe HomeUnit
homeUnitEnv_home_unit :: !(Maybe HomeUnit)
}
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
}
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
HomeUnitEnv
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)
HomePackageTable -> Module -> Maybe HomeModInfo
lookupHptByModule (HomeUnitEnv -> HomePackageTable
homeUnitEnv_hpt HomeUnitEnv
env) Module
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)
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 }
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)}
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 }
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
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
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
}
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
}
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))
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)