module Language.PureScript.Sugar.Names.Imports
  ( ImportDef
  , resolveImports
  , resolveModuleImport
  , findImports
  ) where

import Prelude

import Control.Monad (foldM, when)
import Control.Monad.Error.Class (MonadError(..))

import Data.Foldable (for_, traverse_)
import Data.Maybe (fromMaybe)
import Data.Map qualified as M
import Data.Set qualified as S

import Language.PureScript.AST (Declaration(..), DeclarationRef(..), ErrorMessageHint(..), ExportSource(..), ImportDeclarationType(..), Module(..), SourceSpan, internalModuleSourceSpan)
import Language.PureScript.Crash (internalError)
import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), addHint, errorMessage', rethrow)
import Language.PureScript.Names (pattern ByNullSourcePos, ModuleName, Name(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName)
import Language.PureScript.Sugar.Names.Env (Env, Exports(..), ImportProvenance(..), ImportRecord(..), Imports(..), envModuleExports, nullImports)

type ImportDef = (SourceSpan, ImportDeclarationType, Maybe ModuleName)

-- |
-- Finds the imports within a module, mapping the imported module name to an optional set of
-- explicitly imported declarations.
--
findImports
  :: [Declaration]
  -> M.Map ModuleName [ImportDef]
findImports :: [Declaration] -> Map ModuleName [ImportDef]
findImports = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Declaration
-> Map ModuleName [ImportDef] -> Map ModuleName [ImportDef]
go forall k a. Map k a
M.empty
  where
  go :: Declaration
-> Map ModuleName [ImportDef] -> Map ModuleName [ImportDef]
go (ImportDeclaration (SourceSpan
pos, [Comment]
_) ModuleName
mn ImportDeclarationType
typ Maybe ModuleName
qual) =
    forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SourceSpan
pos, ImportDeclarationType
typ, Maybe ModuleName
qual) forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe []) ModuleName
mn
  go Declaration
_ = forall a. a -> a
id

-- |
-- Constructs a set of imports for a module.
--
resolveImports
  :: forall m
   . MonadError MultipleErrors m
  => Env
  -> Module
  -> m (Module, Imports)
resolveImports :: forall (m :: * -> *).
MonadError MultipleErrors m =>
Env -> Module -> m (Module, Imports)
resolveImports Env
env (Module SourceSpan
ss [Comment]
coms ModuleName
currentModule [Declaration]
decls Maybe [DeclarationRef]
exps) =
  forall e (m :: * -> *) a. MonadError e m => (e -> e) -> m a -> m a
rethrow (ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (ModuleName -> ErrorMessageHint
ErrorInModule ModuleName
currentModule)) forall a b. (a -> b) -> a -> b
$ do
    let imports :: Map ModuleName [ImportDef]
imports = [Declaration] -> Map ModuleName [ImportDef]
findImports [Declaration]
decls
        imports' :: Map
  ModuleName
  [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)]
imports' = forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a b. (a -> b) -> [a] -> [b]
map (\(SourceSpan
ss', ImportDeclarationType
dt, Maybe ModuleName
mmn) -> (SourceSpan
ss', forall a. a -> Maybe a
Just ImportDeclarationType
dt, Maybe ModuleName
mmn))) Map ModuleName [ImportDef]
imports
        scope :: Map
  ModuleName
  [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)]
scope = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ModuleName
currentModule [(String -> SourceSpan
internalModuleSourceSpan String
"<module>", forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)] Map
  ModuleName
  [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)]
imports'
    (SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
Module SourceSpan
ss [Comment]
coms ModuleName
currentModule [Declaration]
decls Maybe [DeclarationRef]
exps,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall (m :: * -> *).
MonadError MultipleErrors m =>
Env
-> Imports
-> (ModuleName,
    [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])
-> m Imports
resolveModuleImport Env
env) Imports
nullImports (forall k a. Map k a -> [(k, a)]
M.toList Map
  ModuleName
  [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)]
scope)

-- | Constructs a set of imports for a single module import.
resolveModuleImport
  :: forall m
   . MonadError MultipleErrors m
  => Env
  -> Imports
  -> (ModuleName, [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])
  -> m Imports
resolveModuleImport :: forall (m :: * -> *).
MonadError MultipleErrors m =>
Env
-> Imports
-> (ModuleName,
    [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])
-> m Imports
resolveModuleImport Env
env Imports
ie (ModuleName
mn, [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)]
imps) = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Imports
-> (SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)
-> m Imports
go Imports
ie [(SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)]
imps
  where
  go :: Imports
     -> (SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)
     -> m Imports
  go :: Imports
-> (SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)
-> m Imports
go Imports
ie' (SourceSpan
ss, Maybe ImportDeclarationType
typ, Maybe ModuleName
impQual) = do
    Exports
modExports <-
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (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
. Qualified Name -> SimpleErrorMessage
UnknownName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos forall a b. (a -> b) -> a -> b
$ ModuleName -> Name
ModName ModuleName
mn)
        (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b, Exports) -> Exports
envModuleExports)
        (ModuleName
mn forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Env
env)
    let impModules :: Set ModuleName
impModules = Imports -> Set ModuleName
importedModules Imports
ie'
        qualModules :: Set ModuleName
qualModules = Imports -> Set ModuleName
importedQualModules Imports
ie'
        ie'' :: Imports
ie'' = Imports
ie' { importedModules :: Set ModuleName
importedModules = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Ord a => a -> Set a -> Set a
S.insert ModuleName
mn Set ModuleName
impModules) (forall a b. a -> b -> a
const Set ModuleName
impModules) Maybe ModuleName
impQual
                   , importedQualModules :: Set ModuleName
importedQualModules = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set ModuleName
qualModules (forall a. Ord a => a -> Set a -> Set a
`S.insert` Set ModuleName
qualModules) Maybe ModuleName
impQual
                   }
    forall (m :: * -> *).
MonadError MultipleErrors m =>
ModuleName
-> Exports
-> Imports
-> Maybe ModuleName
-> SourceSpan
-> Maybe ImportDeclarationType
-> m Imports
resolveImport ModuleName
mn Exports
modExports Imports
ie'' Maybe ModuleName
impQual SourceSpan
ss Maybe ImportDeclarationType
typ

-- |
-- Extends the local environment for a module by resolving an import of another module.
--
resolveImport
  :: forall m
   . MonadError MultipleErrors m
  => ModuleName
  -> Exports
  -> Imports
  -> Maybe ModuleName
  -> SourceSpan
  -> Maybe ImportDeclarationType
  -> m Imports
resolveImport :: forall (m :: * -> *).
MonadError MultipleErrors m =>
ModuleName
-> Exports
-> Imports
-> Maybe ModuleName
-> SourceSpan
-> Maybe ImportDeclarationType
-> m Imports
resolveImport ModuleName
importModule Exports
exps Imports
imps Maybe ModuleName
impQual = SourceSpan -> Maybe ImportDeclarationType -> m Imports
resolveByType
  where

  resolveByType :: SourceSpan -> Maybe ImportDeclarationType -> m Imports
  resolveByType :: SourceSpan -> Maybe ImportDeclarationType -> m Imports
resolveByType SourceSpan
ss Maybe ImportDeclarationType
Nothing =
    SourceSpan -> (Imports -> DeclarationRef -> m Imports) -> m Imports
importAll SourceSpan
ss (ImportProvenance -> Imports -> DeclarationRef -> m Imports
importRef ImportProvenance
Local)
  resolveByType SourceSpan
ss (Just ImportDeclarationType
Implicit) =
    SourceSpan -> (Imports -> DeclarationRef -> m Imports) -> m Imports
importAll SourceSpan
ss (ImportProvenance -> Imports -> DeclarationRef -> m Imports
importRef ImportProvenance
FromImplicit)
  resolveByType SourceSpan
_ (Just (Explicit [DeclarationRef]
refs)) =
    Bool -> [DeclarationRef] -> m ()
checkRefs Bool
False [DeclarationRef]
refs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ImportProvenance -> Imports -> DeclarationRef -> m Imports
importRef ImportProvenance
FromExplicit) Imports
imps [DeclarationRef]
refs
  resolveByType SourceSpan
ss (Just (Hiding [DeclarationRef]
refs)) =
    Bool -> [DeclarationRef] -> m ()
checkRefs Bool
True [DeclarationRef]
refs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SourceSpan -> (Imports -> DeclarationRef -> m Imports) -> m Imports
importAll SourceSpan
ss ([DeclarationRef] -> Imports -> DeclarationRef -> m Imports
importNonHidden [DeclarationRef]
refs)

  -- Check that a 'DeclarationRef' refers to an importable symbol
  checkRefs :: Bool -> [DeclarationRef] -> m ()
  checkRefs :: Bool -> [DeclarationRef] -> m ()
checkRefs Bool
isHiding = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ DeclarationRef -> m ()
check
    where
    check :: DeclarationRef -> m ()
check (ValueRef SourceSpan
ss Ident
name) =
      forall a b.
Ord a =>
SourceSpan -> (a -> Name) -> Map a b -> a -> m ()
checkImportExists SourceSpan
ss Ident -> Name
IdentName (Exports -> Map Ident ExportSource
exportedValues Exports
exps) Ident
name
    check (ValueOpRef SourceSpan
ss OpName 'ValueOpName
op) =
      forall a b.
Ord a =>
SourceSpan -> (a -> Name) -> Map a b -> a -> m ()
checkImportExists SourceSpan
ss OpName 'ValueOpName -> Name
ValOpName (Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps Exports
exps) OpName 'ValueOpName
op
    check (TypeRef SourceSpan
ss ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
dctors) = do
      forall a b.
Ord a =>
SourceSpan -> (a -> Name) -> Map a b -> a -> m ()
checkImportExists SourceSpan
ss ProperName 'TypeName -> Name
TyName (Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps) ProperName 'TypeName
name
      let ([ProperName 'ConstructorName]
allDctors, ExportSource
_) = ProperName 'TypeName
-> ([ProperName 'ConstructorName], ExportSource)
allExportedDataConstructors ProperName 'TypeName
name
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe [ProperName 'ConstructorName]
dctors forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (SourceSpan
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ProperName 'ConstructorName
-> m ()
checkDctorExists SourceSpan
ss ProperName 'TypeName
name [ProperName 'ConstructorName]
allDctors)
    check (TypeOpRef SourceSpan
ss OpName 'TypeOpName
name) =
      forall a b.
Ord a =>
SourceSpan -> (a -> Name) -> Map a b -> a -> m ()
checkImportExists SourceSpan
ss OpName 'TypeOpName -> Name
TyOpName (Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps Exports
exps) OpName 'TypeOpName
name
    check (TypeClassRef SourceSpan
ss ProperName 'ClassName
name) =
      forall a b.
Ord a =>
SourceSpan -> (a -> Name) -> Map a b -> a -> m ()
checkImportExists SourceSpan
ss ProperName 'ClassName -> Name
TyClassName (Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses Exports
exps) ProperName 'ClassName
name
    check (ModuleRef SourceSpan
ss ModuleName
name) | Bool
isHiding =
      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
$ ModuleName -> SimpleErrorMessage
ImportHidingModule ModuleName
name
    check DeclarationRef
r = forall a. HasCallStack => String -> a
internalError forall a b. (a -> b) -> a -> b
$ String
"Invalid argument to checkRefs: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DeclarationRef
r

  -- Check that an explicitly imported item exists in the module it is being imported from
  checkImportExists
    :: Ord a
    => SourceSpan
    -> (a -> Name)
    -> M.Map a b
    -> a
    -> m ()
  checkImportExists :: forall a b.
Ord a =>
SourceSpan -> (a -> Name) -> Map a b -> a -> m ()
checkImportExists SourceSpan
ss a -> Name
toName Map a b
exports a
item
    = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
item forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Map a b
exports)
    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
$ ModuleName -> Name -> SimpleErrorMessage
UnknownImport ModuleName
importModule (a -> Name
toName a
item)

  -- Ensure that an explicitly imported data constructor exists for the type it is being imported
  -- from
  checkDctorExists
    :: SourceSpan
    -> ProperName 'TypeName
    -> [ProperName 'ConstructorName]
    -> ProperName 'ConstructorName
    -> m ()
  checkDctorExists :: SourceSpan
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ProperName 'ConstructorName
-> m ()
checkDctorExists SourceSpan
ss ProperName 'TypeName
tcon [ProperName 'ConstructorName]
exports ProperName 'ConstructorName
dctor
    = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProperName 'ConstructorName
dctor forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ProperName 'ConstructorName]
exports)
    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
$ ModuleName
-> ProperName 'TypeName
-> ProperName 'ConstructorName
-> SimpleErrorMessage
UnknownImportDataConstructor ModuleName
importModule ProperName 'TypeName
tcon ProperName 'ConstructorName
dctor

  importNonHidden :: [DeclarationRef] -> Imports -> DeclarationRef -> m Imports
  importNonHidden :: [DeclarationRef] -> Imports -> DeclarationRef -> m Imports
importNonHidden [DeclarationRef]
hidden Imports
m DeclarationRef
ref | DeclarationRef -> Bool
isHidden DeclarationRef
ref = forall (m :: * -> *) a. Monad m => a -> m a
return Imports
m
                               | Bool
otherwise = ImportProvenance -> Imports -> DeclarationRef -> m Imports
importRef ImportProvenance
FromImplicit Imports
m DeclarationRef
ref
    where
    -- TODO: rework this to be not confusing
    isHidden :: DeclarationRef -> Bool
    isHidden :: DeclarationRef -> Bool
isHidden ref' :: DeclarationRef
ref'@TypeRef{} = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (DeclarationRef -> Bool -> DeclarationRef -> Bool
checkTypeRef DeclarationRef
ref') Bool
False [DeclarationRef]
hidden
    isHidden DeclarationRef
ref' = DeclarationRef
ref' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DeclarationRef]
hidden
    checkTypeRef :: DeclarationRef -> Bool -> DeclarationRef -> Bool
    checkTypeRef :: DeclarationRef -> Bool -> DeclarationRef -> Bool
checkTypeRef DeclarationRef
_ Bool
True DeclarationRef
_ = Bool
True
    checkTypeRef (TypeRef SourceSpan
_ ProperName 'TypeName
_ Maybe [ProperName 'ConstructorName]
Nothing) Bool
acc (TypeRef SourceSpan
_ ProperName 'TypeName
_ (Just [ProperName 'ConstructorName]
_)) = Bool
acc
    checkTypeRef (TypeRef SourceSpan
_ ProperName 'TypeName
name (Just [ProperName 'ConstructorName]
dctor)) Bool
_ (TypeRef SourceSpan
_ ProperName 'TypeName
name' (Just [ProperName 'ConstructorName]
dctor')) = ProperName 'TypeName
name forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
name' Bool -> Bool -> Bool
&& [ProperName 'ConstructorName]
dctor forall a. Eq a => a -> a -> Bool
== [ProperName 'ConstructorName]
dctor'
    checkTypeRef (TypeRef SourceSpan
_ ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
_) Bool
_ (TypeRef SourceSpan
_ ProperName 'TypeName
name' Maybe [ProperName 'ConstructorName]
Nothing) = ProperName 'TypeName
name forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
name'
    checkTypeRef DeclarationRef
_ Bool
acc DeclarationRef
_ = Bool
acc

  -- Import all symbols
  importAll :: SourceSpan -> (Imports -> DeclarationRef -> m Imports) -> m Imports
  importAll :: SourceSpan -> (Imports -> DeclarationRef -> m Imports) -> m Imports
importAll SourceSpan
ss Imports -> DeclarationRef -> m Imports
importer =
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Imports
m (ProperName 'TypeName
name, ([ProperName 'ConstructorName]
dctors, ExportSource
_)) -> Imports -> DeclarationRef -> m Imports
importer Imports
m (SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
TypeRef SourceSpan
ss ProperName 'TypeName
name (forall a. a -> Maybe a
Just [ProperName 'ConstructorName]
dctors))) Imports
imps (forall k a. Map k a -> [(k, a)]
M.toList (Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps))
      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 (\Imports
m (OpName 'TypeOpName
name, ExportSource
_) -> Imports -> DeclarationRef -> m Imports
importer Imports
m (SourceSpan -> OpName 'TypeOpName -> DeclarationRef
TypeOpRef SourceSpan
ss OpName 'TypeOpName
name))) (forall k a. Map k a -> [(k, a)]
M.toList (Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps Exports
exps))
      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 (\Imports
m (Ident
name, ExportSource
_) -> Imports -> DeclarationRef -> m Imports
importer Imports
m (SourceSpan -> Ident -> DeclarationRef
ValueRef SourceSpan
ss Ident
name))) (forall k a. Map k a -> [(k, a)]
M.toList (Exports -> Map Ident ExportSource
exportedValues Exports
exps))
      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 (\Imports
m (OpName 'ValueOpName
name, ExportSource
_) -> Imports -> DeclarationRef -> m Imports
importer Imports
m (SourceSpan -> OpName 'ValueOpName -> DeclarationRef
ValueOpRef SourceSpan
ss OpName 'ValueOpName
name))) (forall k a. Map k a -> [(k, a)]
M.toList (Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps Exports
exps))
      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 (\Imports
m (ProperName 'ClassName
name, ExportSource
_) -> Imports -> DeclarationRef -> m Imports
importer Imports
m (SourceSpan -> ProperName 'ClassName -> DeclarationRef
TypeClassRef SourceSpan
ss ProperName 'ClassName
name))) (forall k a. Map k a -> [(k, a)]
M.toList (Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses Exports
exps))

  importRef :: ImportProvenance -> Imports -> DeclarationRef -> m Imports
  importRef :: ImportProvenance -> Imports -> DeclarationRef -> m Imports
importRef ImportProvenance
prov Imports
imp (ValueRef SourceSpan
ss Ident
name) = do
    let values' :: Map (Qualified Ident) [ImportRecord Ident]
values' = forall a b.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> Map a b
-> (b -> ExportSource)
-> a
-> SourceSpan
-> ImportProvenance
-> Map (Qualified a) [ImportRecord a]
updateImports (Imports -> Map (Qualified Ident) [ImportRecord Ident]
importedValues Imports
imp) (Exports -> Map Ident ExportSource
exportedValues Exports
exps) forall a. a -> a
id Ident
name SourceSpan
ss ImportProvenance
prov
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Imports
imp { importedValues :: Map (Qualified Ident) [ImportRecord Ident]
importedValues = Map (Qualified Ident) [ImportRecord Ident]
values' }
  importRef ImportProvenance
prov Imports
imp (ValueOpRef SourceSpan
ss OpName 'ValueOpName
name) = do
    let valueOps' :: Map
  (Qualified (OpName 'ValueOpName))
  [ImportRecord (OpName 'ValueOpName)]
valueOps' = forall a b.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> Map a b
-> (b -> ExportSource)
-> a
-> SourceSpan
-> ImportProvenance
-> Map (Qualified a) [ImportRecord a]
updateImports (Imports
-> Map
     (Qualified (OpName 'ValueOpName))
     [ImportRecord (OpName 'ValueOpName)]
importedValueOps Imports
imp) (Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps Exports
exps) forall a. a -> a
id OpName 'ValueOpName
name SourceSpan
ss ImportProvenance
prov
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Imports
imp { importedValueOps :: Map
  (Qualified (OpName 'ValueOpName))
  [ImportRecord (OpName 'ValueOpName)]
importedValueOps = Map
  (Qualified (OpName 'ValueOpName))
  [ImportRecord (OpName 'ValueOpName)]
valueOps' }
  importRef ImportProvenance
prov Imports
imp (TypeRef SourceSpan
ss ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
dctors) = do
    let types' :: Map
  (Qualified (ProperName 'TypeName))
  [ImportRecord (ProperName 'TypeName)]
types' = forall a b.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> Map a b
-> (b -> ExportSource)
-> a
-> SourceSpan
-> ImportProvenance
-> Map (Qualified a) [ImportRecord a]
updateImports (Imports
-> Map
     (Qualified (ProperName 'TypeName))
     [ImportRecord (ProperName 'TypeName)]
importedTypes Imports
imp) (Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps) forall a b. (a, b) -> b
snd ProperName 'TypeName
name SourceSpan
ss ImportProvenance
prov
    let ([ProperName 'ConstructorName]
dctorNames, ExportSource
src) = ProperName 'TypeName
-> ([ProperName 'ConstructorName], ExportSource)
allExportedDataConstructors ProperName 'TypeName
name
        dctorLookup :: M.Map (ProperName 'ConstructorName) ExportSource
        dctorLookup :: Map (ProperName 'ConstructorName) ExportSource
dctorLookup = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (, ExportSource
src) [ProperName 'ConstructorName]
dctorNames
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a b. (a -> b) -> a -> b
$ SourceSpan
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ProperName 'ConstructorName
-> m ()
checkDctorExists SourceSpan
ss ProperName 'TypeName
name [ProperName 'ConstructorName]
dctorNames) Maybe [ProperName 'ConstructorName]
dctors
    let dctors' :: Map
  (Qualified (ProperName 'ConstructorName))
  [ImportRecord (ProperName 'ConstructorName)]
dctors' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Map
  (Qualified (ProperName 'ConstructorName))
  [ImportRecord (ProperName 'ConstructorName)]
m ProperName 'ConstructorName
d -> forall a b.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> Map a b
-> (b -> ExportSource)
-> a
-> SourceSpan
-> ImportProvenance
-> Map (Qualified a) [ImportRecord a]
updateImports Map
  (Qualified (ProperName 'ConstructorName))
  [ImportRecord (ProperName 'ConstructorName)]
m Map (ProperName 'ConstructorName) ExportSource
dctorLookup forall a. a -> a
id ProperName 'ConstructorName
d SourceSpan
ss ImportProvenance
prov) (Imports
-> Map
     (Qualified (ProperName 'ConstructorName))
     [ImportRecord (ProperName 'ConstructorName)]
importedDataConstructors Imports
imp) (forall a. a -> Maybe a -> a
fromMaybe [ProperName 'ConstructorName]
dctorNames Maybe [ProperName 'ConstructorName]
dctors)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Imports
imp { importedTypes :: Map
  (Qualified (ProperName 'TypeName))
  [ImportRecord (ProperName 'TypeName)]
importedTypes = Map
  (Qualified (ProperName 'TypeName))
  [ImportRecord (ProperName 'TypeName)]
types', importedDataConstructors :: Map
  (Qualified (ProperName 'ConstructorName))
  [ImportRecord (ProperName 'ConstructorName)]
importedDataConstructors = Map
  (Qualified (ProperName 'ConstructorName))
  [ImportRecord (ProperName 'ConstructorName)]
dctors' }
  importRef ImportProvenance
prov Imports
imp (TypeOpRef SourceSpan
ss OpName 'TypeOpName
name) = do
    let ops' :: Map
  (Qualified (OpName 'TypeOpName))
  [ImportRecord (OpName 'TypeOpName)]
ops' = forall a b.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> Map a b
-> (b -> ExportSource)
-> a
-> SourceSpan
-> ImportProvenance
-> Map (Qualified a) [ImportRecord a]
updateImports (Imports
-> Map
     (Qualified (OpName 'TypeOpName))
     [ImportRecord (OpName 'TypeOpName)]
importedTypeOps Imports
imp) (Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps Exports
exps) forall a. a -> a
id OpName 'TypeOpName
name SourceSpan
ss ImportProvenance
prov
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Imports
imp { importedTypeOps :: Map
  (Qualified (OpName 'TypeOpName))
  [ImportRecord (OpName 'TypeOpName)]
importedTypeOps = Map
  (Qualified (OpName 'TypeOpName))
  [ImportRecord (OpName 'TypeOpName)]
ops' }
  importRef ImportProvenance
prov Imports
imp (TypeClassRef SourceSpan
ss ProperName 'ClassName
name) = do
    let typeClasses' :: Map
  (Qualified (ProperName 'ClassName))
  [ImportRecord (ProperName 'ClassName)]
typeClasses' = forall a b.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> Map a b
-> (b -> ExportSource)
-> a
-> SourceSpan
-> ImportProvenance
-> Map (Qualified a) [ImportRecord a]
updateImports (Imports
-> Map
     (Qualified (ProperName 'ClassName))
     [ImportRecord (ProperName 'ClassName)]
importedTypeClasses Imports
imp) (Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses Exports
exps) forall a. a -> a
id ProperName 'ClassName
name SourceSpan
ss ImportProvenance
prov
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Imports
imp { importedTypeClasses :: Map
  (Qualified (ProperName 'ClassName))
  [ImportRecord (ProperName 'ClassName)]
importedTypeClasses = Map
  (Qualified (ProperName 'ClassName))
  [ImportRecord (ProperName 'ClassName)]
typeClasses' }
  importRef ImportProvenance
_ Imports
_ TypeInstanceRef{} = forall a. HasCallStack => String -> a
internalError String
"TypeInstanceRef in importRef"
  importRef ImportProvenance
_ Imports
_ ModuleRef{} = forall a. HasCallStack => String -> a
internalError String
"ModuleRef in importRef"
  importRef ImportProvenance
_ Imports
_ ReExportRef{} = forall a. HasCallStack => String -> a
internalError String
"ReExportRef in importRef"

  -- Find all exported data constructors for a given type
  allExportedDataConstructors
    :: ProperName 'TypeName
    -> ([ProperName 'ConstructorName], ExportSource)
  allExportedDataConstructors :: ProperName 'TypeName
-> ([ProperName 'ConstructorName], ExportSource)
allExportedDataConstructors ProperName 'TypeName
name =
    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Invalid state in allExportedDataConstructors")
      forall a b. (a -> b) -> a -> b
$ 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

  -- Add something to an import resolution list
  updateImports
    :: Ord a
    => M.Map (Qualified a) [ImportRecord a]
    -> M.Map a b
    -> (b -> ExportSource)
    -> a
    -> SourceSpan
    -> ImportProvenance
    -> M.Map (Qualified a) [ImportRecord a]
  updateImports :: forall a b.
Ord a =>
Map (Qualified a) [ImportRecord a]
-> Map a b
-> (b -> ExportSource)
-> a
-> SourceSpan
-> ImportProvenance
-> Map (Qualified a) [ImportRecord a]
updateImports Map (Qualified a) [ImportRecord a]
imps' Map a b
exps' b -> ExportSource
expName a
name SourceSpan
ss ImportProvenance
prov =
    let
      src :: ExportSource
src = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
internalError String
"Invalid state in updateImports") b -> ExportSource
expName (a
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map a b
exps')
      rec :: ImportRecord a
rec = forall a.
Qualified a
-> ModuleName -> SourceSpan -> ImportProvenance -> ImportRecord a
ImportRecord (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
importModule) a
name) (ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src) SourceSpan
ss ImportProvenance
prov
    in
      forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter
        (\Maybe [ImportRecord a]
currNames -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ImportRecord a
rec forall a. a -> [a] -> [a]
: forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ImportRecord a]
currNames)
        (forall a. QualifiedBy -> a -> Qualified a
Qualified (Maybe ModuleName -> QualifiedBy
byMaybeModuleName Maybe ModuleName
impQual) a
name)
        Map (Qualified a) [ImportRecord a]
imps'