module GHC.Unit.External.ModuleOrigin (
  ModuleOrigin(..),
  fromExposedModules,
  fromReexportedModules,
  fromFlag,
  originVisible,
  originEmpty,
) where

import Data.Semigroup qualified as Semigroup
import GHC.Prelude
import GHC.Unit.External.Validate
import GHC.Unit.Info
import GHC.Utils.Outputable
import GHC.Utils.Panic

-- | Given a module name, there may be multiple ways it came into scope,
-- possibly simultaneously.  This data type tracks all the possible ways
-- it could have come into scope.  Warning: don't use the record functions,
-- they're partial!
data ModuleOrigin =
    -- | Module is hidden, and thus never will be available for import.
    -- (But maybe the user didn't realize), so we'll still keep track
    -- of these modules.)
    ModHidden

    -- | Module is unavailable because the unit is unusable.
  | ModUnusable !UnusableUnit

    -- | Module is public, and could have come from some places.
  | ModOrigin {
        -- | @Just False@ means that this module is in
        -- someone's @exported-modules@ list, but that package is hidden;
        -- @Just True@ means that it is available; @Nothing@ means neither
        -- applies.
        ModuleOrigin -> Maybe Bool
fromOrigUnit :: Maybe Bool
        -- | Is the module available from a reexport of an exposed package?
        -- There could be multiple.
      , ModuleOrigin -> [UnitInfo]
fromExposedReexport :: [UnitInfo]
        -- | Is the module available from a reexport of a hidden package?
      , ModuleOrigin -> [UnitInfo]
fromHiddenReexport :: [UnitInfo]
        -- | Did the module export come from a package flag? (ToDo: track
        -- more information.
      , ModuleOrigin -> Bool
fromPackageFlag :: Bool
      }

instance Outputable ModuleOrigin where
    ppr :: ModuleOrigin -> SDoc
ppr ModuleOrigin
ModHidden = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"hidden module"
    ppr (ModUnusable UnusableUnit
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unusable module"
    ppr (ModOrigin Maybe Bool
e [UnitInfo]
res [UnitInfo]
rhs Bool
f) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma (
        (case Maybe Bool
e of
            Maybe Bool
Nothing -> []
            Just Bool
False -> [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"hidden package"]
            Just Bool
True -> [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exposed package"]) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
        (if [UnitInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitInfo]
res
            then []
            else [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"reexport by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((UnitInfo -> SDoc) -> [UnitInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Unit -> SDoc) -> (UnitInfo -> Unit) -> UnitInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> Unit
mkUnit) [UnitInfo]
res)]) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
        (if [UnitInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitInfo]
rhs
            then []
            else [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"hidden reexport by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((UnitInfo -> SDoc) -> [UnitInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Unit -> SDoc) -> (UnitInfo -> Unit) -> UnitInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> Unit
mkUnit) [UnitInfo]
rhs)]) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
        (if Bool
f then [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"package flag"] else [])
        ))

-- | Smart constructor for a module which is in @exposed-modules@.  Takes
-- as an argument whether or not the defining package is exposed.
fromExposedModules :: Bool -> ModuleOrigin
fromExposedModules :: Bool -> ModuleOrigin
fromExposedModules Bool
e = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
e) [] [] Bool
False

-- | Smart constructor for a module which is in @reexported-modules@.  Takes
-- as an argument whether or not the reexporting package is exposed, and
-- also its 'UnitInfo'.
fromReexportedModules :: Bool -> UnitInfo -> ModuleOrigin
fromReexportedModules :: Bool -> UnitInfo -> ModuleOrigin
fromReexportedModules Bool
True UnitInfo
pkg = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [UnitInfo
pkg] [] Bool
False
fromReexportedModules Bool
False UnitInfo
pkg = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [] [UnitInfo
pkg] Bool
False

-- | Smart constructor for a module which was bound by a package flag.
fromFlag :: ModuleOrigin
fromFlag :: ModuleOrigin
fromFlag = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [] [] Bool
True

instance Semigroup ModuleOrigin where
    x :: ModuleOrigin
x@(ModOrigin Maybe Bool
e [UnitInfo]
res [UnitInfo]
rhs Bool
f) <> :: ModuleOrigin -> ModuleOrigin -> ModuleOrigin
<> y :: ModuleOrigin
y@(ModOrigin Maybe Bool
e' [UnitInfo]
res' [UnitInfo]
rhs' Bool
f') =
        Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin (Maybe Bool -> Maybe Bool -> Maybe Bool
g Maybe Bool
e Maybe Bool
e') ([UnitInfo]
res [UnitInfo] -> [UnitInfo] -> [UnitInfo]
forall a. [a] -> [a] -> [a]
++ [UnitInfo]
res') ([UnitInfo]
rhs [UnitInfo] -> [UnitInfo] -> [UnitInfo]
forall a. [a] -> [a] -> [a]
++ [UnitInfo]
rhs') (Bool
f Bool -> Bool -> Bool
|| Bool
f')
      where g :: Maybe Bool -> Maybe Bool -> Maybe Bool
g (Just Bool
b) (Just Bool
b')
                | Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b'   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
                | Bool
otherwise = String -> SDoc -> Maybe Bool
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"ModOrigin: package both exposed/hidden" (SDoc -> Maybe Bool) -> SDoc -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"x: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
x SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"y: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
y
            g Maybe Bool
Nothing Maybe Bool
x = Maybe Bool
x
            g Maybe Bool
x Maybe Bool
Nothing = Maybe Bool
x

    ModuleOrigin
x <> ModuleOrigin
y = String -> SDoc -> ModuleOrigin
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"ModOrigin: module origin mismatch" (SDoc -> ModuleOrigin) -> SDoc -> ModuleOrigin
forall a b. (a -> b) -> a -> b
$
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"x: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
x SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"y: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleOrigin
y

instance Monoid ModuleOrigin where
    mempty :: ModuleOrigin
mempty = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [] [] Bool
False
    mappend :: ModuleOrigin -> ModuleOrigin -> ModuleOrigin
mappend = ModuleOrigin -> ModuleOrigin -> ModuleOrigin
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)

-- | Is the name from the import actually visible? (i.e. does it cause
-- ambiguity, or is it only relevant when we're making suggestions?)
originVisible :: ModuleOrigin -> Bool
originVisible :: ModuleOrigin -> Bool
originVisible ModuleOrigin
ModHidden = Bool
False
originVisible (ModUnusable UnusableUnit
_) = Bool
False
originVisible (ModOrigin Maybe Bool
b [UnitInfo]
res [UnitInfo]
_ Bool
f) = Maybe Bool
b Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Bool -> Bool -> Bool
|| Bool -> Bool
not ([UnitInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitInfo]
res) Bool -> Bool -> Bool
|| Bool
f

-- | Are there actually no providers for this module?  This will never occur
-- except when we're filtering based on package imports.
originEmpty :: ModuleOrigin -> Bool
originEmpty :: ModuleOrigin -> Bool
originEmpty (ModOrigin Maybe Bool
Nothing [] [] Bool
False) = Bool
True
originEmpty ModuleOrigin
_ = Bool
False