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