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

import Prelude

import Control.Monad (filterM, foldM, liftM2, unless, void, when)
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 Data.Map qualified as M

import Language.PureScript.AST
import Language.PureScript.Crash (internalError)
import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage', rethrow, rethrowWithPosition, warnAndRethrow)
import Language.PureScript.Names (Ident, ModuleName, Name(..), OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), disqualifyFor, isQualifiedWith, isUnqualified)
import Language.PureScript.Sugar.Names.Env (Env, ExportMode(..), Exports(..), ImportRecord(..), Imports(..), checkImportConflicts, envModuleExports, exportType, exportTypeClass, exportTypeOp, exportValue, exportValueOp, nullExports)
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