{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}

{-
(c) The University of Glasgow, 2004-2006


Module
~~~~~~~~~~
Simply the name of a module, represented as a FastString.
These are Uniquable, hence we can build Maps with Modules as
the keys.
-}

module GHC.Unit.Module
    ( module GHC.Unit.Types

      -- * The ModuleName type
    , module Language.Haskell.Syntax.Module.Name

      -- * The ModLocation type
    , module GHC.Unit.Module.Location

      -- * ModuleEnv
    , module GHC.Unit.Module.Env

      -- * Generalization
    , getModuleInstantiation
    , getUnitInstantiations
    , uninstantiateInstantiatedUnit
    , uninstantiateInstantiatedModule

      -- * The Module type
    , mkHoleModule
    , isHoleModule
    , stableModuleCmp
    , moduleStableString
    , moduleIsDefinite
    , HasModule(..)
    , ContainsModule(..)
    , installedModuleEq
    ) where

import GHC.Prelude

import GHC.Types.Unique.DSet
import GHC.Unit.Types
import GHC.Unit.Module.Location
import GHC.Unit.Module.Env

import Language.Haskell.Syntax.Module.Name

import Data.Semigroup

-- | A 'Module' is definite if it has no free holes.
moduleIsDefinite :: Module -> Bool
moduleIsDefinite :: Module -> Bool
moduleIsDefinite = UniqDSet ModuleName -> Bool
forall a. UniqDSet a -> Bool
isEmptyUniqDSet (UniqDSet ModuleName -> Bool)
-> (Module -> UniqDSet ModuleName) -> Module -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UniqDSet ModuleName
forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles

-- | Get a string representation of a 'Module' that's unique and stable
-- across recompilations.
-- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"
moduleStableString :: Module -> String
moduleStableString :: Module -> String
moduleStableString Module{ModuleName
Unit
moduleUnit :: Unit
moduleName :: ModuleName
moduleUnit :: forall unit. GenModule unit -> unit
moduleName :: forall unit. GenModule unit -> ModuleName
..} =
  String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Unit -> String
forall u. IsUnitId u => u -> String
unitString Unit
moduleUnit String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
moduleNameString ModuleName
moduleName


-- | This gives a stable ordering, as opposed to the Ord instance which
-- gives an ordering based on the 'Unique's of the components, which may
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp (Module Unit
p1 ModuleName
n1) (Module Unit
p2 ModuleName
n2) = Unit -> Unit -> Ordering
stableUnitCmp Unit
p1 Unit
p2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> ModuleName -> ModuleName -> Ordering
stableModuleNameCmp ModuleName
n1 ModuleName
n2

class ContainsModule t where
    extractModule :: t -> Module

class HasModule m where
    getModule :: m Module


-- | Test if a 'Module' corresponds to a given 'InstalledModule',
-- modulo instantiation.
installedModuleEq :: InstalledModule -> Module -> Bool
installedModuleEq :: InstalledModule -> Module -> Bool
installedModuleEq InstalledModule
imod Module
mod =
    (InstalledModule, Maybe InstantiatedModule) -> InstalledModule
forall a b. (a, b) -> a
fst (Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
mod) InstalledModule -> InstalledModule -> Bool
forall a. Eq a => a -> a -> Bool
== InstalledModule
imod


{-
************************************************************************
*                                                                      *
                        Hole substitutions
*                                                                      *
************************************************************************
-}

-- | Given a possibly on-the-fly instantiated module, split it into
-- a 'Module' that we definitely can find on-disk, as well as an
-- instantiation if we need to instantiate it on the fly.  If the
-- instantiation is @Nothing@ no on-the-fly renaming is needed.
getModuleInstantiation :: Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation :: Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
m =
    let (UnitId
uid, Maybe InstantiatedUnit
mb_iuid) = Unit -> (UnitId, Maybe InstantiatedUnit)
getUnitInstantiations (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m)
    in (UnitId -> ModuleName -> InstalledModule
forall unit. unit -> ModuleName -> GenModule unit
Module UnitId
uid (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m),
        (InstantiatedUnit -> InstantiatedModule)
-> Maybe InstantiatedUnit -> Maybe InstantiatedModule
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\InstantiatedUnit
iuid -> InstantiatedUnit -> ModuleName -> InstantiatedModule
forall unit. unit -> ModuleName -> GenModule unit
Module InstantiatedUnit
iuid (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m)) Maybe InstantiatedUnit
mb_iuid)

-- | Return the unit-id this unit is an instance of and the module instantiations (if any).
getUnitInstantiations :: Unit -> (UnitId, Maybe InstantiatedUnit)
getUnitInstantiations :: Unit -> (UnitId, Maybe InstantiatedUnit)
getUnitInstantiations (VirtUnit InstantiatedUnit
iuid)           = (InstantiatedUnit -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
iuid, InstantiatedUnit -> Maybe InstantiatedUnit
forall a. a -> Maybe a
Just InstantiatedUnit
iuid)
getUnitInstantiations (RealUnit (Definite UnitId
uid)) = (UnitId
uid, Maybe InstantiatedUnit
forall a. Maybe a
Nothing)
getUnitInstantiations (HoleUnit {})             = String -> (UnitId, Maybe InstantiatedUnit)
forall a. HasCallStack => String -> a
error String
"Hole unit"

-- | Remove instantiations of the given instantiated unit
uninstantiateInstantiatedUnit :: InstantiatedUnit -> InstantiatedUnit
uninstantiateInstantiatedUnit :: InstantiatedUnit -> InstantiatedUnit
uninstantiateInstantiatedUnit InstantiatedUnit
u =
    UnitId -> GenInstantiations UnitId -> InstantiatedUnit
forall u.
IsUnitId u =>
u -> GenInstantiations u -> GenInstantiatedUnit u
mkInstantiatedUnit (InstantiatedUnit -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
u)
                       (((ModuleName, Module) -> (ModuleName, Module))
-> GenInstantiations UnitId -> GenInstantiations UnitId
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
m,Module
_) -> (ModuleName
m, ModuleName -> Module
forall u. ModuleName -> GenModule (GenUnit u)
mkHoleModule ModuleName
m))
                         (InstantiatedUnit -> GenInstantiations UnitId
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts InstantiatedUnit
u))

-- | Remove instantiations of the given module instantiated unit
uninstantiateInstantiatedModule :: InstantiatedModule -> InstantiatedModule
uninstantiateInstantiatedModule :: InstantiatedModule -> InstantiatedModule
uninstantiateInstantiatedModule (Module InstantiatedUnit
uid ModuleName
n) = InstantiatedUnit -> ModuleName -> InstantiatedModule
forall unit. unit -> ModuleName -> GenModule unit
Module (InstantiatedUnit -> InstantiatedUnit
uninstantiateInstantiatedUnit InstantiatedUnit
uid) ModuleName
n

-- | Test if a Module is not instantiated
isHoleModule :: GenModule (GenUnit u) -> Bool
isHoleModule :: forall u. GenModule (GenUnit u) -> Bool
isHoleModule (Module GenUnit u
HoleUnit ModuleName
_) = Bool
True
isHoleModule GenModule (GenUnit u)
_                   = Bool
False

-- | Create a hole Module
mkHoleModule :: ModuleName -> GenModule (GenUnit u)
mkHoleModule :: forall u. ModuleName -> GenModule (GenUnit u)
mkHoleModule = GenUnit u -> ModuleName -> GenModule (GenUnit u)
forall unit. unit -> ModuleName -> GenModule unit
Module GenUnit u
forall uid. GenUnit uid
HoleUnit