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)
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
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)
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
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)
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
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)
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
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
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"
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
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'