-- | The home unit is the unit (i.e. compiled package) that contains the module
-- we are compiling/typechecking.
module GHC.Unit.Home
   ( GenHomeUnit (..)
   , HomeUnit
   , homeUnitId
   , homeUnitInstantiations
   , homeUnitInstanceOf
   , homeUnitInstanceOfMaybe
   , homeUnitAsUnit
   , homeUnitMap
   -- * Predicates
   , isHomeUnitIndefinite
   , isHomeUnitDefinite
   , isHomeUnitInstantiating
   , isHomeUnit
   , isHomeUnitId
   , isHomeUnitInstanceOf
   , isHomeModule
   , isHomeInstalledModule
   , notHomeModule
   , notHomeModuleMaybe
   , notHomeInstalledModule
   , notHomeInstalledModuleMaybe
   -- * Helpers
   , mkHomeModule
   , mkHomeInstalledModule
   , homeModuleInstantiation
   , homeModuleNameInstantiation
   )
where

import GHC.Prelude
import GHC.Unit.Types
import GHC.Unit.Module.Name
import Data.Maybe

-- | Information about the home unit (i.e., the until that will contain the
-- modules we are compiling)
--
-- The unit identifier of the instantiating units is left open to allow
-- switching from UnitKey (what is provided by the user) to UnitId (internal
-- unit identifier) with `homeUnitMap`.
--
-- TODO: this isn't implemented yet. UnitKeys are still converted too early into
-- UnitIds in GHC.Unit.State.readUnitDataBase
data GenHomeUnit u
   = DefiniteHomeUnit UnitId (Maybe (u, GenInstantiations u))
      -- ^ Definite home unit (i.e. that we can compile).
      --
      -- Nothing:        not an instantiated unit
      -- Just (i,insts): made definite by instantiating "i" with "insts"

   | IndefiniteHomeUnit UnitId (GenInstantiations u)
      -- ^ Indefinite home unit (i.e. that we can only typecheck)
      --
      -- All the holes are instantiated with fake modules from the Hole unit.
      -- See Note [Representation of module/name variables] in "GHC.Unit"

type HomeUnit = GenHomeUnit UnitId

-- | Return home unit id
homeUnitId :: GenHomeUnit u -> UnitId
homeUnitId :: forall u. GenHomeUnit u -> UnitId
homeUnitId (DefiniteHomeUnit UnitId
u Maybe (u, GenInstantiations u)
_)   = UnitId
u
homeUnitId (IndefiniteHomeUnit UnitId
u GenInstantiations u
_) = UnitId
u

-- | Return home unit instantiations
homeUnitInstantiations :: GenHomeUnit u -> GenInstantiations u
homeUnitInstantiations :: forall u. GenHomeUnit u -> GenInstantiations u
homeUnitInstantiations (DefiniteHomeUnit   UnitId
_ Maybe (u, GenInstantiations u)
Nothing)       = []
homeUnitInstantiations (DefiniteHomeUnit   UnitId
_ (Just (u
_,GenInstantiations u
is))) = GenInstantiations u
is
homeUnitInstantiations (IndefiniteHomeUnit UnitId
_ GenInstantiations u
is)            = GenInstantiations u
is

-- | Return the unit id of the unit that is instantiated by the home unit.
--
-- E.g. if home unit = q[A=p:B,...] we return q.
--
-- If the home unit is not an instance of another unit, we return its own unit
-- id (it is an instance of itself if you will).
homeUnitInstanceOf :: HomeUnit -> UnitId
homeUnitInstanceOf :: HomeUnit -> UnitId
homeUnitInstanceOf HomeUnit
h = forall a. a -> Maybe a -> a
fromMaybe (forall u. GenHomeUnit u -> UnitId
homeUnitId HomeUnit
h) (forall u. GenHomeUnit u -> Maybe u
homeUnitInstanceOfMaybe HomeUnit
h)

-- | Return the unit id of the unit that is instantiated by the home unit.
--
-- E.g. if home unit = q[A=p:B,...] we return (Just q).
--
-- If the home unit is not an instance of another unit, we return Nothing.
homeUnitInstanceOfMaybe :: GenHomeUnit u -> Maybe u
homeUnitInstanceOfMaybe :: forall u. GenHomeUnit u -> Maybe u
homeUnitInstanceOfMaybe (DefiniteHomeUnit   UnitId
_ (Just (u
u,GenInstantiations u
_))) = forall a. a -> Maybe a
Just u
u
homeUnitInstanceOfMaybe GenHomeUnit u
_                                   = forall a. Maybe a
Nothing

-- | Return the home unit as a normal unit.
--
-- We infer from the home unit itself the kind of unit we create:
--    1. If the home unit is definite, we must be compiling so we return a real
--    unit. The definite home unit may be the result of a unit instantiation,
--    say `p = q[A=r:X]`. In this case we could have returned a virtual unit
--    `q[A=r:X]` but it's not what the clients of this function expect,
--    especially because `p` is lost when we do this. The unit id of a virtual
--    unit is made up internally so `unitId(q[A=r:X])` is not equal to `p`.
--
--    2. If the home unit is indefinite we can only create a virtual unit from
--    it. It's ok because we must be only typechecking the home unit so we won't
--    produce any code object that rely on the unit id of this virtual unit.
homeUnitAsUnit :: HomeUnit -> Unit
homeUnitAsUnit :: HomeUnit -> Unit
homeUnitAsUnit (DefiniteHomeUnit UnitId
u Maybe (UnitId, GenInstantiations UnitId)
_)    = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
u)
homeUnitAsUnit (IndefiniteHomeUnit UnitId
u GenInstantiations UnitId
is) = forall u.
IsUnitId u =>
Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
mkVirtUnit (forall unit. unit -> Indefinite unit
Indefinite UnitId
u) GenInstantiations UnitId
is

-- | Map over the unit identifier for instantiating units
homeUnitMap :: IsUnitId v => (u -> v) -> GenHomeUnit u -> GenHomeUnit v
homeUnitMap :: forall v u.
IsUnitId v =>
(u -> v) -> GenHomeUnit u -> GenHomeUnit v
homeUnitMap u -> v
_ (DefiniteHomeUnit UnitId
u Maybe (u, GenInstantiations u)
Nothing)       = forall u. UnitId -> Maybe (u, GenInstantiations u) -> GenHomeUnit u
DefiniteHomeUnit UnitId
u forall a. Maybe a
Nothing
homeUnitMap u -> v
f (DefiniteHomeUnit UnitId
u (Just (u
i,GenInstantiations u
is))) = forall u. UnitId -> Maybe (u, GenInstantiations u) -> GenHomeUnit u
DefiniteHomeUnit UnitId
u (forall a. a -> Maybe a
Just (u -> v
f u
i, forall v u.
IsUnitId v =>
(u -> v) -> GenInstantiations u -> GenInstantiations v
mapInstantiations u -> v
f GenInstantiations u
is))
homeUnitMap u -> v
f (IndefiniteHomeUnit UnitId
u GenInstantiations u
is)          = forall u. UnitId -> GenInstantiations u -> GenHomeUnit u
IndefiniteHomeUnit UnitId
u (forall v u.
IsUnitId v =>
(u -> v) -> GenInstantiations u -> GenInstantiations v
mapInstantiations u -> v
f GenInstantiations u
is)

----------------------------
-- Predicates
----------------------------

-- | Test if we are type-checking an indefinite unit
--
-- (if it is not, we should never use on-the-fly renaming)
isHomeUnitIndefinite :: GenHomeUnit u -> Bool
isHomeUnitIndefinite :: forall u. GenHomeUnit u -> Bool
isHomeUnitIndefinite (DefiniteHomeUnit {})   = Bool
False
isHomeUnitIndefinite (IndefiniteHomeUnit {}) = Bool
True

-- | Test if we are compiling a definite unit
--
-- (if it is, we should never use on-the-fly renaming)
isHomeUnitDefinite :: GenHomeUnit u -> Bool
isHomeUnitDefinite :: forall u. GenHomeUnit u -> Bool
isHomeUnitDefinite (DefiniteHomeUnit {})   = Bool
True
isHomeUnitDefinite (IndefiniteHomeUnit {}) = Bool
False

-- | Test if we are compiling by instantiating a definite unit
isHomeUnitInstantiating :: GenHomeUnit u -> Bool
isHomeUnitInstantiating :: forall u. GenHomeUnit u -> Bool
isHomeUnitInstantiating GenHomeUnit u
u =
   forall u. GenHomeUnit u -> Bool
isHomeUnitDefinite GenHomeUnit u
u Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall u. GenHomeUnit u -> GenInstantiations u
homeUnitInstantiations GenHomeUnit u
u))

-- | Test if the unit is the home unit
isHomeUnit :: HomeUnit -> Unit -> Bool
isHomeUnit :: HomeUnit -> Unit -> Bool
isHomeUnit HomeUnit
hu Unit
u = Unit
u forall a. Eq a => a -> a -> Bool
== HomeUnit -> Unit
homeUnitAsUnit HomeUnit
hu

-- | Test if the unit-id is the home unit-id
isHomeUnitId :: GenHomeUnit u -> UnitId -> Bool
isHomeUnitId :: forall u. GenHomeUnit u -> UnitId -> Bool
isHomeUnitId GenHomeUnit u
hu UnitId
uid = UnitId
uid forall a. Eq a => a -> a -> Bool
== forall u. GenHomeUnit u -> UnitId
homeUnitId GenHomeUnit u
hu

-- | Test if the home unit is an instance of the given unit-id
isHomeUnitInstanceOf :: HomeUnit -> UnitId -> Bool
isHomeUnitInstanceOf :: HomeUnit -> UnitId -> Bool
isHomeUnitInstanceOf HomeUnit
hu UnitId
u = HomeUnit -> UnitId
homeUnitInstanceOf HomeUnit
hu forall a. Eq a => a -> a -> Bool
== UnitId
u

-- | Test if the module comes from the home unit
isHomeModule :: HomeUnit -> Module -> Bool
isHomeModule :: HomeUnit -> Module -> Bool
isHomeModule HomeUnit
hu Module
m = HomeUnit -> Unit -> Bool
isHomeUnit HomeUnit
hu (forall unit. GenModule unit -> unit
moduleUnit Module
m)

-- | Test if the module comes from the home unit
isHomeInstalledModule :: GenHomeUnit u -> InstalledModule -> Bool
isHomeInstalledModule :: forall u. GenHomeUnit u -> InstalledModule -> Bool
isHomeInstalledModule GenHomeUnit u
hu InstalledModule
m = forall u. GenHomeUnit u -> UnitId -> Bool
isHomeUnitId GenHomeUnit u
hu (forall unit. GenModule unit -> unit
moduleUnit InstalledModule
m)


-- | Test if a module doesn't come from the given home unit
notHomeInstalledModule :: GenHomeUnit u -> InstalledModule -> Bool
notHomeInstalledModule :: forall u. GenHomeUnit u -> InstalledModule -> Bool
notHomeInstalledModule GenHomeUnit u
hu InstalledModule
m = Bool -> Bool
not (forall u. GenHomeUnit u -> InstalledModule -> Bool
isHomeInstalledModule GenHomeUnit u
hu InstalledModule
m)

-- | Test if a module doesn't come from the given home unit
notHomeInstalledModuleMaybe :: Maybe (GenHomeUnit u) -> InstalledModule -> Bool
notHomeInstalledModuleMaybe :: forall u. Maybe (GenHomeUnit u) -> InstalledModule -> Bool
notHomeInstalledModuleMaybe Maybe (GenHomeUnit u)
mh InstalledModule
m = forall a. a -> Maybe a -> a
fromMaybe Bool
True forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall u. GenHomeUnit u -> InstalledModule -> Bool
`notHomeInstalledModule` InstalledModule
m) Maybe (GenHomeUnit u)
mh


-- | Test if a module doesn't come from the given home unit
notHomeModule :: HomeUnit -> Module -> Bool
notHomeModule :: HomeUnit -> Module -> Bool
notHomeModule HomeUnit
hu Module
m = Bool -> Bool
not (HomeUnit -> Module -> Bool
isHomeModule HomeUnit
hu Module
m)

-- | Test if a module doesn't come from the given home unit
notHomeModuleMaybe :: Maybe HomeUnit -> Module -> Bool
notHomeModuleMaybe :: Maybe HomeUnit -> Module -> Bool
notHomeModuleMaybe Maybe HomeUnit
mh Module
m = forall a. a -> Maybe a -> a
fromMaybe Bool
True forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HomeUnit -> Module -> Bool
`notHomeModule` Module
m) Maybe HomeUnit
mh

----------------------------
-- helpers
----------------------------

-- | Make a module in home unit
mkHomeModule :: HomeUnit -> ModuleName -> Module
mkHomeModule :: HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
hu = forall u. u -> ModuleName -> GenModule u
mkModule (HomeUnit -> Unit
homeUnitAsUnit HomeUnit
hu)

-- | Make a module in home unit
mkHomeInstalledModule :: GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule :: forall u. GenHomeUnit u -> ModuleName -> InstalledModule
mkHomeInstalledModule GenHomeUnit u
hu = forall u. u -> ModuleName -> GenModule u
mkModule (forall u. GenHomeUnit u -> UnitId
homeUnitId GenHomeUnit u
hu)

-- | Return the module that is used to instantiate the given home module name.
-- If the ModuleName doesn't refer to a signature, return the actual home
-- module.
--
-- E.g., the instantiating module of @A@ in @p[A=q[]:B]@ is @q[]:B@.
--       the instantiating module of @A@ in @p@ is @p:A@.
homeModuleNameInstantiation :: HomeUnit -> ModuleName -> Module
homeModuleNameInstantiation :: HomeUnit -> ModuleName -> Module
homeModuleNameInstantiation HomeUnit
hu ModuleName
mod_name =
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ModuleName
mod_name (forall u. GenHomeUnit u -> GenInstantiations u
homeUnitInstantiations HomeUnit
hu) of
        Maybe Module
Nothing  -> HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
hu ModuleName
mod_name
        Just Module
mod -> Module
mod

-- | Return the module that is used to instantiate the given home module.
--
-- If the given module isn't a module hole, return the actual home module.
--
-- E.g., the instantiating module of @p:A@ in @p[A=q[]:B]@ is @q[]:B@.
--       the instantiating module of @r:A@ in @p[A=q[]:B]@ is @r:A@.
--       the instantiating module of @p:A@ in @p@ is @p:A@.
--       the instantiating module of @r:A@ in @p@ is @r:A@.
homeModuleInstantiation :: HomeUnit -> Module -> Module
homeModuleInstantiation :: HomeUnit -> Module -> Module
homeModuleInstantiation HomeUnit
hu Module
mod
   | HomeUnit -> Module -> Bool
isHomeModule HomeUnit
hu Module
mod = HomeUnit -> ModuleName -> Module
homeModuleNameInstantiation HomeUnit
hu (forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
   | Bool
otherwise           = Module
mod