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

import Prelude

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

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

import Language.PureScript.AST
import Language.PureScript.Crash
import Language.PureScript.Errors
import Language.PureScript.Names
import Language.PureScript.Sugar.Names.Env

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'