module GHC.Unit.External.Visibility (
  VisibilityMap,
  UnitVisibility(..),
) where

import GHC.Prelude

import GHC.Data.FastString
import GHC.Driver.DynFlags
import GHC.Types.Unique.Map
import GHC.Unit.Module
import GHC.Utils.Outputable as Outputable

import Control.Applicative
import Data.Monoid (First (..))
import Data.Semigroup qualified as Semigroup
import Data.Set (Set)
import Data.Set qualified as Set

-- | 'UniqFM' map from 'Unit' to a 'UnitVisibility'.
type VisibilityMap = UniqMap Unit UnitVisibility

-- | 'UnitVisibility' records the various aspects of visibility of a particular
-- 'Unit'.
data UnitVisibility = UnitVisibility
    { UnitVisibility -> Bool
uv_expose_all :: Bool
      --  ^ Should all modules in exposed-modules should be dumped into scope?
    , UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings :: [(ModuleName, ModuleName)]
      -- ^ Any custom renamings that should bring extra 'ModuleName's into
      -- scope.
    , UnitVisibility -> First FastString
uv_package_name :: First FastString
      -- ^ The package name associated with the 'Unit'.  This is used
      -- to implement legacy behavior where @-package foo-0.1@ implicitly
      -- hides any packages named @foo@
    , UnitVisibility -> UniqMap ModuleName (Set InstantiatedModule)
uv_requirements :: UniqMap ModuleName (Set InstantiatedModule)
      -- ^ The signatures which are contributed to the requirements context
      -- from this unit ID.
    , UnitVisibility -> Maybe PackageArg
uv_explicit :: Maybe PackageArg
      -- ^ Whether or not this unit was explicitly brought into scope,
      -- as opposed to implicitly via the 'exposed' fields in the
      -- package database (when @-hide-all-packages@ is not passed.)
    }

instance Outputable UnitVisibility where
    ppr :: UnitVisibility -> SDoc
ppr (UnitVisibility {
        uv_expose_all :: UnitVisibility -> Bool
uv_expose_all = Bool
b,
        uv_renamings :: UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings = [(ModuleName, ModuleName)]
rns,
        uv_package_name :: UnitVisibility -> First FastString
uv_package_name = First Maybe FastString
mb_pn,
        uv_requirements :: UnitVisibility -> UniqMap ModuleName (Set InstantiatedModule)
uv_requirements = UniqMap ModuleName (Set InstantiatedModule)
reqs,
        uv_explicit :: UnitVisibility -> Maybe PackageArg
uv_explicit = Maybe PackageArg
explicit
    }) = (Bool, [(ModuleName, ModuleName)], Maybe FastString,
 UniqMap ModuleName (Set InstantiatedModule), Maybe PackageArg)
-> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool
b, [(ModuleName, ModuleName)]
rns, Maybe FastString
mb_pn, UniqMap ModuleName (Set InstantiatedModule)
reqs, Maybe PackageArg
explicit)

instance Semigroup UnitVisibility where
    UnitVisibility
uv1 <> :: UnitVisibility -> UnitVisibility -> UnitVisibility
<> UnitVisibility
uv2
        = UnitVisibility
          { uv_expose_all :: Bool
uv_expose_all = UnitVisibility -> Bool
uv_expose_all UnitVisibility
uv1 Bool -> Bool -> Bool
|| UnitVisibility -> Bool
uv_expose_all UnitVisibility
uv2
          , uv_renamings :: [(ModuleName, ModuleName)]
uv_renamings = UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings UnitVisibility
uv1 [(ModuleName, ModuleName)]
-> [(ModuleName, ModuleName)] -> [(ModuleName, ModuleName)]
forall a. [a] -> [a] -> [a]
++ UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings UnitVisibility
uv2
          , uv_package_name :: First FastString
uv_package_name = First FastString -> First FastString -> First FastString
forall a. Monoid a => a -> a -> a
mappend (UnitVisibility -> First FastString
uv_package_name UnitVisibility
uv1) (UnitVisibility -> First FastString
uv_package_name UnitVisibility
uv2)
          , uv_requirements :: UniqMap ModuleName (Set InstantiatedModule)
uv_requirements = (Set InstantiatedModule
 -> Set InstantiatedModule -> Set InstantiatedModule)
-> UniqMap ModuleName (Set InstantiatedModule)
-> UniqMap ModuleName (Set InstantiatedModule)
-> UniqMap ModuleName (Set InstantiatedModule)
forall a k.
(a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
plusUniqMap_C Set InstantiatedModule
-> Set InstantiatedModule -> Set InstantiatedModule
forall a. Ord a => Set a -> Set a -> Set a
Set.union (UnitVisibility -> UniqMap ModuleName (Set InstantiatedModule)
uv_requirements UnitVisibility
uv2) (UnitVisibility -> UniqMap ModuleName (Set InstantiatedModule)
uv_requirements UnitVisibility
uv1)
          , uv_explicit :: Maybe PackageArg
uv_explicit = UnitVisibility -> Maybe PackageArg
uv_explicit UnitVisibility
uv1 Maybe PackageArg -> Maybe PackageArg -> Maybe PackageArg
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UnitVisibility -> Maybe PackageArg
uv_explicit UnitVisibility
uv2
          }

instance Monoid UnitVisibility where
    mempty :: UnitVisibility
mempty = UnitVisibility
             { uv_expose_all :: Bool
uv_expose_all = Bool
False
             , uv_renamings :: [(ModuleName, ModuleName)]
uv_renamings = []
             , uv_package_name :: First FastString
uv_package_name = Maybe FastString -> First FastString
forall a. Maybe a -> First a
First Maybe FastString
forall a. Maybe a
Nothing
             , uv_requirements :: UniqMap ModuleName (Set InstantiatedModule)
uv_requirements = UniqMap ModuleName (Set InstantiatedModule)
forall k a. UniqMap k a
emptyUniqMap
             , uv_explicit :: Maybe PackageArg
uv_explicit = Maybe PackageArg
forall a. Maybe a
Nothing
             }
    mappend :: UnitVisibility -> UnitVisibility -> UnitVisibility
mappend = UnitVisibility -> UnitVisibility -> UnitVisibility
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)