module Language.PureScript.Sugar.Names.Exports
  ( findExportable
  , resolveExports
  ) where

import Prelude

import Control.Monad
import Control.Monad.Writer.Class (MonadWriter(..))
import Control.Monad.Error.Class (MonadError(..))

import Data.Function (on)
import Data.Foldable (traverse_)
import Data.List (intersect, groupBy, sortOn)
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Map as M

import Language.PureScript.AST
import Language.PureScript.Crash
import Language.PureScript.Errors
import Language.PureScript.Names
import Language.PureScript.Sugar.Names.Env
import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs)

-- |
-- Finds all exportable members of a module, disregarding any explicit exports.
--
findExportable :: forall m. (MonadError MultipleErrors m) => Module -> m Exports
findExportable :: forall (m :: * -> *).
MonadError MultipleErrors m =>
Module -> m Exports
findExportable (Module SourceSpan
_ [Comment]
_ ModuleName
mn [Declaration]
ds Maybe [DeclarationRef]
_) =
  forall e (m :: * -> *) a. MonadError e m => (e -> e) -> m a -> m a
rethrow (ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (ModuleName -> ErrorMessageHint
ErrorInModule ModuleName
mn)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Exports -> Declaration -> m Exports
updateExports' Exports
nullExports [Declaration]
ds
  where
  updateExports' :: Exports -> Declaration -> m Exports
  updateExports' :: Exports -> Declaration -> m Exports
updateExports' Exports
exps Declaration
decl = forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> m a -> m a
rethrowWithPosition (Declaration -> SourceSpan
declSourceSpan Declaration
decl) forall a b. (a -> b) -> a -> b
$ Exports -> Declaration -> m Exports
updateExports Exports
exps Declaration
decl

  source :: ExportSource
source =
    ExportSource
    { exportSourceDefinedIn :: ModuleName
exportSourceDefinedIn = ModuleName
mn
    , exportSourceImportedFrom :: Maybe ModuleName
exportSourceImportedFrom = forall a. Maybe a
Nothing
    }

  updateExports :: Exports -> Declaration -> m Exports
  updateExports :: Exports -> Declaration -> m Exports
updateExports Exports
exps (TypeClassDeclaration (SourceSpan
ss, [Comment]
_) ProperName 'ClassName
tcn [(Text, Maybe SourceType)]
_ [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
ds') = do
    Exports
exps' <- forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> m a -> m a
rethrowWithPosition SourceSpan
ss forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> ExportMode
-> Exports
-> ProperName 'ClassName
-> ExportSource
-> m Exports
exportTypeClass SourceSpan
ss ExportMode
Internal Exports
exps ProperName 'ClassName
tcn ExportSource
source
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Exports -> Declaration -> m Exports
go Exports
exps' [Declaration]
ds'
    where
    go :: Exports -> Declaration -> m Exports
go Exports
exps'' (TypeDeclaration (TypeDeclarationData (SourceSpan
ss', [Comment]
_) Ident
name SourceType
_)) = forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan -> Exports -> Ident -> ExportSource -> m Exports
exportValue SourceSpan
ss' Exports
exps'' Ident
name ExportSource
source
    go Exports
_ Declaration
_ = forall a. HasCallStack => String -> a
internalError String
"Invalid declaration in TypeClassDeclaration"
  updateExports Exports
exps (DataDeclaration (SourceSpan
ss, [Comment]
_) DataDeclType
_ ProperName 'TypeName
tn [(Text, Maybe SourceType)]
_ [DataConstructorDeclaration]
dcs) =
    forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> ExportMode
-> Exports
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ExportSource
-> m Exports
exportType SourceSpan
ss ExportMode
Internal Exports
exps ProperName 'TypeName
tn (forall a b. (a -> b) -> [a] -> [b]
map DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorName [DataConstructorDeclaration]
dcs) ExportSource
source
  updateExports Exports
exps (TypeSynonymDeclaration (SourceSpan
ss, [Comment]
_) ProperName 'TypeName
tn [(Text, Maybe SourceType)]
_ SourceType
_) =
    forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> ExportMode
-> Exports
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ExportSource
-> m Exports
exportType SourceSpan
ss ExportMode
Internal Exports
exps ProperName 'TypeName
tn [] ExportSource
source
  updateExports Exports
exps (ExternDataDeclaration (SourceSpan
ss, [Comment]
_) ProperName 'TypeName
tn SourceType
_) =
    forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> ExportMode
-> Exports
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ExportSource
-> m Exports
exportType SourceSpan
ss ExportMode
Internal Exports
exps ProperName 'TypeName
tn [] ExportSource
source
  updateExports Exports
exps (ValueDeclaration ValueDeclarationData [GuardedExpr]
vd) =
    forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan -> Exports -> Ident -> ExportSource -> m Exports
exportValue (forall a b. (a, b) -> a
fst (forall a. ValueDeclarationData a -> (SourceSpan, [Comment])
valdeclSourceAnn ValueDeclarationData [GuardedExpr]
vd)) Exports
exps (forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData [GuardedExpr]
vd) ExportSource
source
  updateExports Exports
exps (ValueFixityDeclaration (SourceSpan
ss, [Comment]
_) Fixity
_ Qualified (Either Ident (ProperName 'ConstructorName))
_ OpName 'ValueOpName
op) =
    forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> Exports -> OpName 'ValueOpName -> ExportSource -> m Exports
exportValueOp SourceSpan
ss Exports
exps OpName 'ValueOpName
op ExportSource
source
  updateExports Exports
exps (TypeFixityDeclaration (SourceSpan
ss, [Comment]
_) Fixity
_ Qualified (ProperName 'TypeName)
_ OpName 'TypeOpName
op) =
    forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> Exports -> OpName 'TypeOpName -> ExportSource -> m Exports
exportTypeOp SourceSpan
ss Exports
exps OpName 'TypeOpName
op ExportSource
source
  updateExports Exports
exps (ExternDeclaration (SourceSpan
ss, [Comment]
_) Ident
name SourceType
_) =
    forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan -> Exports -> Ident -> ExportSource -> m Exports
exportValue SourceSpan
ss Exports
exps Ident
name ExportSource
source
  updateExports Exports
exps Declaration
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Exports
exps

-- |
-- Resolves the exports for a module, filtering out members that have not been
-- exported and elaborating re-exports of other modules.
--
resolveExports
  :: forall m
   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)
  => Env
  -> SourceSpan
  -> ModuleName
  -> Imports
  -> Exports
  -> [DeclarationRef]
  -> m Exports
resolveExports :: forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
Env
-> SourceSpan
-> ModuleName
-> Imports
-> Exports
-> [DeclarationRef]
-> m Exports
resolveExports Env
env SourceSpan
ss ModuleName
mn Imports
imps Exports
exps [DeclarationRef]
refs =
  forall e (m :: * -> *) a.
(MonadError e m, MonadWriter e m) =>
(e -> e) -> m a -> m a
warnAndRethrow (ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (ModuleName -> ErrorMessageHint
ErrorInModule ModuleName
mn)) forall a b. (a -> b) -> a -> b
$ do
    Exports
filtered <- forall (m :: * -> *).
MonadError MultipleErrors m =>
ModuleName -> Exports -> [DeclarationRef] -> m Exports
filterModule ModuleName
mn Exports
exps [DeclarationRef]
refs
    Exports
exps' <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Exports -> DeclarationRef -> m Exports
elaborateModuleExports Exports
filtered [DeclarationRef]
refs
    forall (m :: * -> *).
MonadWriter MultipleErrors m =>
SourceSpan
-> (Name -> SimpleErrorMessage) -> [DeclarationRef] -> m ()
warnDuplicateRefs SourceSpan
ss Name -> SimpleErrorMessage
DuplicateExportRef [DeclarationRef]
refs
    forall (m :: * -> *) a. Monad m => a -> m a
return Exports
exps'

  where

  -- Takes the current module's imports, the accumulated list of exports, and a
  -- `DeclarationRef` for an explicit export. When the ref refers to another
  -- module, export anything from the imports that matches for that module.
  elaborateModuleExports :: Exports -> DeclarationRef -> m Exports
  elaborateModuleExports :: Exports -> DeclarationRef -> m Exports
elaborateModuleExports Exports
result (ModuleRef SourceSpan
_ ModuleName
name) | ModuleName
name forall a. Eq a => a -> a -> Bool
== ModuleName
mn = do
    let types' :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
types' = Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
result forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps
    let typeOps' :: Map (OpName 'TypeOpName) ExportSource
typeOps' = Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps Exports
result forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps Exports
exps
    let classes' :: Map (ProperName 'ClassName) ExportSource
classes' = Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses Exports
result forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses Exports
exps
    let values' :: Map Ident ExportSource
values' = Exports -> Map Ident ExportSource
exportedValues Exports
result forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Exports -> Map Ident ExportSource
exportedValues Exports
exps
    let valueOps' :: Map (OpName 'ValueOpName) ExportSource
valueOps' = Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps Exports
result forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps Exports
exps
    forall (m :: * -> *) a. Monad m => a -> m a
return Exports
result
      { exportedTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exportedTypes = Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
types'
      , exportedTypeOps :: Map (OpName 'TypeOpName) ExportSource
exportedTypeOps = Map (OpName 'TypeOpName) ExportSource
typeOps'
      , exportedTypeClasses :: Map (ProperName 'ClassName) ExportSource
exportedTypeClasses = Map (ProperName 'ClassName) ExportSource
classes'
      , exportedValues :: Map Ident ExportSource
exportedValues = Map Ident ExportSource
values'
      , exportedValueOps :: Map (OpName 'ValueOpName) ExportSource
exportedValueOps = Map (OpName 'ValueOpName) ExportSource
valueOps'
      }
  elaborateModuleExports Exports
result (ModuleRef SourceSpan
ss' ModuleName
name) = do
    let isPseudo :: Bool
isPseudo = ModuleName -> Bool
isPseudoModule ModuleName
name
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isPseudo Bool -> Bool -> Bool
&& Bool -> Bool
not (ModuleName -> Bool
isImportedModule ModuleName
name))
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SimpleErrorMessage
UnknownExport forall a b. (a -> b) -> a -> b
$ ModuleName -> Name
ModName ModuleName
name
    [Qualified (ProperName 'TypeName)]
reTypes <- forall a.
SourceSpan
-> Bool
-> ModuleName
-> (a -> Name)
-> Map (Qualified a) [ImportRecord a]
-> m [Qualified a]
extract SourceSpan
ss' Bool
isPseudo ModuleName
name ProperName 'TypeName -> Name
TyName (Imports -> ImportMap (ProperName 'TypeName)
importedTypes Imports
imps)
    [Qualified (OpName 'TypeOpName)]
reTypeOps <- forall a.
SourceSpan
-> Bool
-> ModuleName
-> (a -> Name)
-> Map (Qualified a) [ImportRecord a]
-> m [Qualified a]
extract SourceSpan
ss' Bool
isPseudo ModuleName
name OpName 'TypeOpName -> Name
TyOpName (Imports -> ImportMap (OpName 'TypeOpName)
importedTypeOps Imports
imps)
    [Qualified (ProperName 'ConstructorName)]
reDctors <- forall a.
SourceSpan
-> Bool
-> ModuleName
-> (a -> Name)
-> Map (Qualified a) [ImportRecord a]
-> m [Qualified a]
extract SourceSpan
ss' Bool
isPseudo ModuleName
name ProperName 'ConstructorName -> Name
DctorName (Imports -> ImportMap (ProperName 'ConstructorName)
importedDataConstructors Imports
imps)
    [Qualified (ProperName 'ClassName)]
reClasses <- forall a.
SourceSpan
-> Bool
-> ModuleName
-> (a -> Name)
-> Map (Qualified a) [ImportRecord a]
-> m [Qualified a]
extract SourceSpan
ss' Bool
isPseudo ModuleName
name ProperName 'ClassName -> Name
TyClassName (Imports -> ImportMap (ProperName 'ClassName)
importedTypeClasses Imports
imps)
    [Qualified Ident]
reValues <- forall a.
SourceSpan
-> Bool
-> ModuleName
-> (a -> Name)
-> Map (Qualified a) [ImportRecord a]
-> m [Qualified a]
extract SourceSpan
ss' Bool
isPseudo ModuleName
name Ident -> Name
IdentName (Imports -> ImportMap Ident
importedValues Imports
imps)
    [Qualified (OpName 'ValueOpName)]
reValueOps <- forall a.
SourceSpan
-> Bool
-> ModuleName
-> (a -> Name)
-> Map (Qualified a) [ImportRecord a]
-> m [Qualified a]
extract SourceSpan
ss' Bool
isPseudo ModuleName
name OpName 'ValueOpName -> Name
ValOpName (Imports -> ImportMap (OpName 'ValueOpName)
importedValueOps Imports
imps)
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Exports
exps' ((ProperName 'TypeName
tctor, [ProperName 'ConstructorName]
dctors), ExportSource
src) -> forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> ExportMode
-> Exports
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ExportSource
-> m Exports
exportType SourceSpan
ss' ExportMode
ReExport Exports
exps' ProperName 'TypeName
tctor [ProperName 'ConstructorName]
dctors ExportSource
src) Exports
result ([Qualified (ProperName 'TypeName)]
-> [Qualified (ProperName 'ConstructorName)]
-> [((ProperName 'TypeName, [ProperName 'ConstructorName]),
     ExportSource)]
resolveTypeExports [Qualified (ProperName 'TypeName)]
reTypes [Qualified (ProperName 'ConstructorName)]
reDctors)
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> Exports -> OpName 'TypeOpName -> ExportSource -> m Exports
exportTypeOp SourceSpan
ss')) (forall a b. (a -> b) -> [a] -> [b]
map Qualified (OpName 'TypeOpName)
-> (OpName 'TypeOpName, ExportSource)
resolveTypeOp [Qualified (OpName 'TypeOpName)]
reTypeOps)
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> ExportMode
-> Exports
-> ProperName 'ClassName
-> ExportSource
-> m Exports
exportTypeClass SourceSpan
ss' ExportMode
ReExport)) (forall a b. (a -> b) -> [a] -> [b]
map Qualified (ProperName 'ClassName)
-> (ProperName 'ClassName, ExportSource)
resolveClass [Qualified (ProperName 'ClassName)]
reClasses)
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan -> Exports -> Ident -> ExportSource -> m Exports
exportValue SourceSpan
ss')) (forall a b. (a -> b) -> [a] -> [b]
map Qualified Ident -> (Ident, ExportSource)
resolveValue [Qualified Ident]
reValues)
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> Exports -> OpName 'ValueOpName -> ExportSource -> m Exports
exportValueOp SourceSpan
ss')) (forall a b. (a -> b) -> [a] -> [b]
map Qualified (OpName 'ValueOpName)
-> (OpName 'ValueOpName, ExportSource)
resolveValueOp [Qualified (OpName 'ValueOpName)]
reValueOps)
  elaborateModuleExports Exports
result DeclarationRef
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Exports
result

  -- Extracts a list of values for a module based on a lookup table. If the
  -- boolean is true the values are filtered by the qualification
  extract
    :: SourceSpan
    -> Bool
    -> ModuleName
    -> (a -> Name)
    -> M.Map (Qualified a) [ImportRecord a]
    -> m [Qualified a]
  extract :: forall a.
SourceSpan
-> Bool
-> ModuleName
-> (a -> Name)
-> Map (Qualified a) [ImportRecord a]
-> m [Qualified a]
extract SourceSpan
ss' Bool
useQual ModuleName
name a -> Name
toName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (forall a. ImportRecord a -> Qualified a
importName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Qualified a, [ImportRecord a])]
-> m [(Qualified a, [ImportRecord a])]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
    where
    go :: [(Qualified a, [ImportRecord a])]
-> m [(Qualified a, [ImportRecord a])]
go = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall a b. (a -> b) -> a -> b
$ \(Qualified a
name', [ImportRecord a]
options) -> do
      let isMatch :: Bool
isMatch = if Bool
useQual then forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
name Qualified a
name' else forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Qualified a -> ImportRecord a -> Bool
checkUnqual Qualified a
name') [ImportRecord a]
options
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isMatch Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [ImportRecord a]
options forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
SourceSpan
-> ModuleName
-> (a -> Name)
-> [ImportRecord a]
-> m (ModuleName, ModuleName)
checkImportConflicts SourceSpan
ss' ModuleName
mn a -> Name
toName [ImportRecord a]
options
      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
isMatch
    checkUnqual :: Qualified a -> ImportRecord a -> Bool
checkUnqual Qualified a
name' ImportRecord a
ir = forall a. Qualified a -> Bool
isUnqualified Qualified a
name' Bool -> Bool -> Bool
&& forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
name (forall a. ImportRecord a -> Qualified a
importName ImportRecord a
ir)

  -- Check whether a module name refers to a "pseudo module" that came into
  -- existence in an import scope due to importing one or more modules as
  -- qualified.
  isPseudoModule :: ModuleName -> Bool
  isPseudoModule :: ModuleName -> Bool
isPseudoModule = (forall a b. Map (Qualified a) b -> [Qualified a])
-> ModuleName -> Bool
testQuals forall k a. Map k a -> [k]
M.keys
    where
    -- Test for the presence of a `ModuleName` in a set of imports, using a
    -- function to either extract the keys or values. We test the keys to see if a
    -- value being re-exported belongs to a qualified module, and we test the
    -- values if that fails to see whether the value has been imported at all.
    testQuals :: (forall a b. M.Map (Qualified a) b -> [Qualified a]) -> ModuleName -> Bool
    testQuals :: (forall a b. Map (Qualified a) b -> [Qualified a])
-> ModuleName -> Bool
testQuals forall a b. Map (Qualified a) b -> [Qualified a]
f ModuleName
mn' = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn') (forall a b. Map (Qualified a) b -> [Qualified a]
f (Imports -> ImportMap (ProperName 'TypeName)
importedTypes Imports
imps))
                   Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn') (forall a b. Map (Qualified a) b -> [Qualified a]
f (Imports -> ImportMap (OpName 'TypeOpName)
importedTypeOps Imports
imps))
                   Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn') (forall a b. Map (Qualified a) b -> [Qualified a]
f (Imports -> ImportMap (ProperName 'ConstructorName)
importedDataConstructors Imports
imps))
                   Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn') (forall a b. Map (Qualified a) b -> [Qualified a]
f (Imports -> ImportMap (ProperName 'ClassName)
importedTypeClasses Imports
imps))
                   Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn') (forall a b. Map (Qualified a) b -> [Qualified a]
f (Imports -> ImportMap Ident
importedValues Imports
imps))
                   Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn') (forall a b. Map (Qualified a) b -> [Qualified a]
f (Imports -> ImportMap (OpName 'ValueOpName)
importedValueOps Imports
imps))
                   Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn') (forall a b. Map (Qualified a) b -> [Qualified a]
f (Imports -> ImportMap (ProperName 'TypeName)
importedKinds Imports
imps))

  -- Check whether a module name refers to a module that has been imported
  -- without qualification into an import scope.
  isImportedModule :: ModuleName -> Bool
  isImportedModule :: ModuleName -> Bool
isImportedModule = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Imports -> Set ModuleName
importedModules Imports
imps)

  -- Constructs a list of types with their data constructors and the original
  -- module they were defined in from a list of type and data constructor names.
  resolveTypeExports
    :: [Qualified (ProperName 'TypeName)]
    -> [Qualified (ProperName 'ConstructorName)]
    -> [((ProperName 'TypeName, [ProperName 'ConstructorName]), ExportSource)]
  resolveTypeExports :: [Qualified (ProperName 'TypeName)]
-> [Qualified (ProperName 'ConstructorName)]
-> [((ProperName 'TypeName, [ProperName 'ConstructorName]),
     ExportSource)]
resolveTypeExports [Qualified (ProperName 'TypeName)]
tctors [Qualified (ProperName 'ConstructorName)]
dctors = forall a b. (a -> b) -> [a] -> [b]
map Qualified (ProperName 'TypeName)
-> ((ProperName 'TypeName, [ProperName 'ConstructorName]),
    ExportSource)
go [Qualified (ProperName 'TypeName)]
tctors
    where
    go
      :: Qualified (ProperName 'TypeName)
      -> ((ProperName 'TypeName, [ProperName 'ConstructorName]), ExportSource)
    go :: Qualified (ProperName 'TypeName)
-> ((ProperName 'TypeName, [ProperName 'ConstructorName]),
    ExportSource)
go (Qualified (ByModuleName ModuleName
mn'') ProperName 'TypeName
name) =
      forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Missing value in resolveTypeExports") forall a b. (a -> b) -> a -> b
$ do
        Exports
exps' <- forall a b. (a, b, Exports) -> Exports
envModuleExports forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleName
mn'' forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Env
env
        ([ProperName 'ConstructorName]
dctors', ExportSource
src) <- ProperName 'TypeName
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps'
        let relevantDctors :: [ProperName 'ConstructorName]
relevantDctors = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor (forall a. a -> Maybe a
Just ModuleName
mn'')) [Qualified (ProperName 'ConstructorName)]
dctors
        forall (m :: * -> *) a. Monad m => a -> m a
return
          ( (ProperName 'TypeName
name, [ProperName 'ConstructorName]
relevantDctors forall a. Eq a => [a] -> [a] -> [a]
`intersect` [ProperName 'ConstructorName]
dctors')
          , ExportSource
src { exportSourceImportedFrom :: Maybe ModuleName
exportSourceImportedFrom = forall a. a -> Maybe a
Just ModuleName
mn'' }
          )
    go (Qualified QualifiedBy
_ ProperName 'TypeName
_) = forall a. HasCallStack => String -> a
internalError String
"Unqualified value in resolveTypeExports"

  -- Looks up an imported type operator and re-qualifies it with the original
  -- module it came from.
  resolveTypeOp :: Qualified (OpName 'TypeOpName) -> (OpName 'TypeOpName, ExportSource)
  resolveTypeOp :: Qualified (OpName 'TypeOpName)
-> (OpName 'TypeOpName, ExportSource)
resolveTypeOp Qualified (OpName 'TypeOpName)
op
    = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Missing value in resolveValue")
    forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
(Exports -> Map a ExportSource)
-> Qualified a -> Maybe (a, ExportSource)
resolve Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps Qualified (OpName 'TypeOpName)
op

  -- Looks up an imported class and re-qualifies it with the original module it
  -- came from.
  resolveClass :: Qualified (ProperName 'ClassName) -> (ProperName 'ClassName, ExportSource)
  resolveClass :: Qualified (ProperName 'ClassName)
-> (ProperName 'ClassName, ExportSource)
resolveClass Qualified (ProperName 'ClassName)
className
    = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Missing value in resolveClass")
    forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
(Exports -> Map a ExportSource)
-> Qualified a -> Maybe (a, ExportSource)
resolve Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses Qualified (ProperName 'ClassName)
className

  -- Looks up an imported value and re-qualifies it with the original module it
  -- came from.
  resolveValue :: Qualified Ident -> (Ident, ExportSource)
  resolveValue :: Qualified Ident -> (Ident, ExportSource)
resolveValue Qualified Ident
ident
    = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Missing value in resolveValue")
    forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
(Exports -> Map a ExportSource)
-> Qualified a -> Maybe (a, ExportSource)
resolve Exports -> Map Ident ExportSource
exportedValues Qualified Ident
ident

  -- Looks up an imported operator and re-qualifies it with the original
  -- module it came from.
  resolveValueOp :: Qualified (OpName 'ValueOpName) -> (OpName 'ValueOpName, ExportSource)
  resolveValueOp :: Qualified (OpName 'ValueOpName)
-> (OpName 'ValueOpName, ExportSource)
resolveValueOp Qualified (OpName 'ValueOpName)
op
    = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Missing value in resolveValueOp")
    forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
(Exports -> Map a ExportSource)
-> Qualified a -> Maybe (a, ExportSource)
resolve Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps Qualified (OpName 'ValueOpName)
op

  resolve
    :: Ord a
    => (Exports -> M.Map a ExportSource)
    -> Qualified a
    -> Maybe (a, ExportSource)
  resolve :: forall a.
Ord a =>
(Exports -> Map a ExportSource)
-> Qualified a -> Maybe (a, ExportSource)
resolve Exports -> Map a ExportSource
f (Qualified (ByModuleName ModuleName
mn'') a
a) = do
    Exports
exps' <- forall a b. (a, b, Exports) -> Exports
envModuleExports forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleName
mn'' forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Env
env
    ExportSource
src <- a
a forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Exports -> Map a ExportSource
f Exports
exps'
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, ExportSource
src { exportSourceImportedFrom :: Maybe ModuleName
exportSourceImportedFrom = forall a. a -> Maybe a
Just ModuleName
mn'' })
  resolve Exports -> Map a ExportSource
_ Qualified a
_ = forall a. HasCallStack => String -> a
internalError String
"Unqualified value in resolve"

-- |
-- Filters the full list of exportable values, types, and classes for a module
-- based on a list of export declaration references.
--
filterModule
  :: forall m
   . MonadError MultipleErrors m
  => ModuleName
  -> Exports
  -> [DeclarationRef]
  -> m Exports
filterModule :: forall (m :: * -> *).
MonadError MultipleErrors m =>
ModuleName -> Exports -> [DeclarationRef] -> m Exports
filterModule ModuleName
mn Exports
exps [DeclarationRef]
refs = do
  Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
types <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
-> DeclarationRef
-> m (Map
        (ProperName 'TypeName)
        ([ProperName 'ConstructorName], ExportSource))
filterTypes forall k a. Map k a
M.empty ([DeclarationRef] -> [DeclarationRef]
combineTypeRefs [DeclarationRef]
refs)
  Map (OpName 'TypeOpName) ExportSource
typeOps <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a.
Ord a =>
(a -> Name)
-> (DeclarationRef -> Maybe a)
-> (Exports -> Map a ExportSource)
-> Map a ExportSource
-> DeclarationRef
-> m (Map a ExportSource)
filterExport OpName 'TypeOpName -> Name
TyOpName DeclarationRef -> Maybe (OpName 'TypeOpName)
getTypeOpRef Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps) forall k a. Map k a
M.empty [DeclarationRef]
refs
  Map (ProperName 'ClassName) ExportSource
classes <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a.
Ord a =>
(a -> Name)
-> (DeclarationRef -> Maybe a)
-> (Exports -> Map a ExportSource)
-> Map a ExportSource
-> DeclarationRef
-> m (Map a ExportSource)
filterExport ProperName 'ClassName -> Name
TyClassName DeclarationRef -> Maybe (ProperName 'ClassName)
getTypeClassRef Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses) forall k a. Map k a
M.empty [DeclarationRef]
refs
  Map Ident ExportSource
values <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a.
Ord a =>
(a -> Name)
-> (DeclarationRef -> Maybe a)
-> (Exports -> Map a ExportSource)
-> Map a ExportSource
-> DeclarationRef
-> m (Map a ExportSource)
filterExport Ident -> Name
IdentName DeclarationRef -> Maybe Ident
getValueRef Exports -> Map Ident ExportSource
exportedValues) forall k a. Map k a
M.empty [DeclarationRef]
refs
  Map (OpName 'ValueOpName) ExportSource
valueOps <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a.
Ord a =>
(a -> Name)
-> (DeclarationRef -> Maybe a)
-> (Exports -> Map a ExportSource)
-> Map a ExportSource
-> DeclarationRef
-> m (Map a ExportSource)
filterExport OpName 'ValueOpName -> Name
ValOpName DeclarationRef -> Maybe (OpName 'ValueOpName)
getValueOpRef Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps) forall k a. Map k a
M.empty [DeclarationRef]
refs
  forall (m :: * -> *) a. Monad m => a -> m a
return Exports
    { exportedTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exportedTypes = Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
types
    , exportedTypeOps :: Map (OpName 'TypeOpName) ExportSource
exportedTypeOps = Map (OpName 'TypeOpName) ExportSource
typeOps
    , exportedTypeClasses :: Map (ProperName 'ClassName) ExportSource
exportedTypeClasses = Map (ProperName 'ClassName) ExportSource
classes
    , exportedValues :: Map Ident ExportSource
exportedValues = Map Ident ExportSource
values
    , exportedValueOps :: Map (OpName 'ValueOpName) ExportSource
exportedValueOps = Map (OpName 'ValueOpName) ExportSource
valueOps
    }

  where

  -- Takes the list of exported refs, filters out any non-TypeRefs, then
  -- combines any duplicate type exports to ensure that all constructors
  -- listed for the type are covered. Without this, only the data constructor
  -- listing for the last ref would be used.
  combineTypeRefs :: [DeclarationRef] -> [DeclarationRef]
  combineTypeRefs :: [DeclarationRef] -> [DeclarationRef]
combineTypeRefs
    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SourceSpan
ss', (ProperName 'TypeName
tc, Maybe [ProperName 'ConstructorName]
dcs)) -> SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
TypeRef SourceSpan
ss' ProperName 'TypeName
tc Maybe [ProperName 'ConstructorName]
dcs)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a b. (a -> b) -> a -> b
$ \(SourceSpan
ss, (ProperName 'TypeName
tc, Maybe [ProperName 'ConstructorName]
dcs1)) (SourceSpan
_, (ProperName 'TypeName
_, Maybe [ProperName 'ConstructorName]
dcs2)) -> (SourceSpan
ss, (ProperName 'TypeName
tc, forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) Maybe [ProperName 'ConstructorName]
dcs1 Maybe [ProperName 'ConstructorName]
dcs2)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\DeclarationRef
ref -> (DeclarationRef -> SourceSpan
declRefSourceSpan DeclarationRef
ref,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeclarationRef
-> Maybe
     (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
getTypeRef DeclarationRef
ref)

  filterTypes
    :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)
    -> DeclarationRef
    -> m (M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource))
  filterTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
-> DeclarationRef
-> m (Map
        (ProperName 'TypeName)
        ([ProperName 'ConstructorName], ExportSource))
filterTypes Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
result (TypeRef SourceSpan
ss ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
expDcons) =
    case ProperName 'TypeName
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps of
      Maybe ([ProperName 'ConstructorName], ExportSource)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SimpleErrorMessage
UnknownExport forall a b. (a -> b) -> a -> b
$ ProperName 'TypeName -> Name
TyName ProperName 'TypeName
name
      Just ([ProperName 'ConstructorName]
dcons, ExportSource
src) -> do
        let expDcons' :: [ProperName 'ConstructorName]
expDcons' = forall a. a -> Maybe a -> a
fromMaybe [ProperName 'ConstructorName]
dcons Maybe [ProperName 'ConstructorName]
expDcons
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ProperName 'ConstructorName
-> m ()
checkDcon ProperName 'TypeName
name [ProperName 'ConstructorName]
dcons) [ProperName 'ConstructorName]
expDcons'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ProperName 'TypeName
name ([ProperName 'ConstructorName]
expDcons', ExportSource
src) Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
result
    where
    -- Ensures a data constructor is exportable for a given type. Takes a type
    -- name, a list of exportable data constructors for the type, and the name of
    -- the data constructor to check.
    checkDcon
      :: ProperName 'TypeName
      -> [ProperName 'ConstructorName]
      -> ProperName 'ConstructorName
      -> m ()
    checkDcon :: ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ProperName 'ConstructorName
-> m ()
checkDcon ProperName 'TypeName
tcon [ProperName 'ConstructorName]
dcons ProperName 'ConstructorName
dcon =
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProperName 'ConstructorName
dcon forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ProperName 'ConstructorName]
dcons) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall a b. (a -> b) -> a -> b
$ ProperName 'TypeName
-> ProperName 'ConstructorName -> SimpleErrorMessage
UnknownExportDataConstructor ProperName 'TypeName
tcon ProperName 'ConstructorName
dcon
  filterTypes Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
result DeclarationRef
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
result

  filterExport
    :: Ord a
    => (a -> Name)
    -> (DeclarationRef -> Maybe a)
    -> (Exports -> M.Map a ExportSource)
    -> M.Map a ExportSource
    -> DeclarationRef
    -> m (M.Map a ExportSource)
  filterExport :: forall a.
Ord a =>
(a -> Name)
-> (DeclarationRef -> Maybe a)
-> (Exports -> Map a ExportSource)
-> Map a ExportSource
-> DeclarationRef
-> m (Map a ExportSource)
filterExport a -> Name
toName DeclarationRef -> Maybe a
get Exports -> Map a ExportSource
fromExps Map a ExportSource
result DeclarationRef
ref
    | Just a
name <- DeclarationRef -> Maybe a
get DeclarationRef
ref =
        case a
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Exports -> Map a ExportSource
fromExps Exports
exps of
          -- TODO: I'm not sure if we actually need to check that these modules
          -- are the same here -gb
          Just ExportSource
source' | ModuleName
mn forall a. Eq a => a -> a -> Bool
== ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
source' ->
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
name ExportSource
source' Map a ExportSource
result
          Maybe ExportSource
_ ->
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' (DeclarationRef -> SourceSpan
declRefSourceSpan DeclarationRef
ref) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SimpleErrorMessage
UnknownExport forall a b. (a -> b) -> a -> b
$ a -> Name
toName a
name
  filterExport a -> Name
_ DeclarationRef -> Maybe a
_ Exports -> Map a ExportSource
_ Map a ExportSource
result DeclarationRef
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Map a ExportSource
result