0e4f6db · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Merge pull request #1903 from purescript/1869-single-open-import

Allow one open import without warning

commit0e4f6db6d3ef0b44e4d5bcf6ab0ac1b3dbe7ed24 authorGary Burgess <gary.burgess@gmail.com> dateMon 29 Feb 2016, 01:14 (11 years ago) parentf5636d9 57a3833

12 files changed+197−76

compare with golang

unifiedsplit

examples/failing/ConflictingExports2.purs−13 examples/failing/ConflictingImports2.purs+8−4 examples/passing/ResolvableScopeConflict.purs+25 examples/passing/ResolvableScopeConflict2.purs+22 examples/passing/ResolvableScopeConflict3.purs+15 src/Language/PureScript/Docs/Convert/ReExports.hs+3−3 src/Language/PureScript/Errors.hs+9 src/Language/PureScript/Linter/Imports.hs+14−5 src/Language/PureScript/Sugar/Names.hs+5−4 src/Language/PureScript/Sugar/Names/Env.hs+55−15 src/Language/PureScript/Sugar/Names/Exports.hs+5−5 src/Language/PureScript/Sugar/Names/Imports.hs+36−27

examples/failing/ConflictingExports2.pursdeleted−13

@@ -1,13 +0,0 @@

1−-- @shouldFailWith ScopeConflict

2−module A where

3−

4− thing :: Int

5− thing = 1

6−

7−-- Fails here because re-exporting forces any scope conflicts to be resolved

8−module Main (thing, module A) where

9−

10− import A

11−

12− thing :: Int

13− thing = 2

examples/failing/ConflictingImports2.purs+8−4

@@ -4,13 +4,17 @@ module A where

44 thing :: Int

55 thing = 1

7−module Main where

8−

9− import A

7+module B where

108

119 thing :: Int

1210 thing = 2

1311

14− -- Error due to referencing `thing` which is in scope as A.thing and Main.thing

12+module Main where

13+

14+ import A (thing)

15+ import B (thing)

16+

17+ -- Error due to referencing `thing` which is explicitly in scope as A.thing

18+ -- and B.thing

1519 what :: Int

1620 what = thing

examples/passing/ResolvableScopeConflict.pursnew file+25

@@ -0,0 +1,25 @@

1+module A where

3+ thing :: Int

4+ thing = 1

6+module B where

8+ thing :: Int

9+ thing = 2

10+

11+ zing :: Int

12+ zing = 3

13+

14+module Main where

15+

16+ import A (thing)

17+ import B

18+

19+ -- Not an error as although we have `thing` in scope from both A and B, it is

20+ -- imported explicitly from A, giving it a resolvable solution.

21+ what :: Boolean -> Int

22+ what true = thing

23+ what false = zing

24+

25+ main = Control.Monad.Eff.Console.log "Done"

examples/passing/ResolvableScopeConflict2.pursnew file+22

@@ -0,0 +1,22 @@

1+module A where

3+ thing :: Int

4+ thing = 2

6+ zing :: Int

7+ zing = 3

9+module Main where

10+

11+ import A

12+

13+ thing :: Int

14+ thing = 1

15+

16+ -- Not an error as although we have `thing` in scope from both Main and A,

17+ -- as the local declaration takes precedence over the implicit import

18+ what :: Boolean -> Int

19+ what true = thing

20+ what false = zing

21+

22+ main = Control.Monad.Eff.Console.log "Done"

examples/passing/ResolvableScopeConflict3.pursnew file+15

@@ -0,0 +1,15 @@

1+module A where

3+ thing :: Int

4+ thing = 1

6+module Main (thing, main, module A) where

8+ import A

10+ thing :: Int

11+ thing = 2

12+

13+ main = Control.Monad.Eff.Console.log "Done"

14+

15+

src/Language/PureScript/Docs/Convert/ReExports.hs+3−3

@@ -155,16 +155,16 @@ collectDeclarations imports exports = do

155155--

156156findImport ::

157157 (Show name, Eq name, Applicative m, MonadReader P.ModuleName m) =>

158− [(P.Qualified name, P.ModuleName)] ->

158+ [P.ImportRecord name] ->

159159 (name, P.ModuleName) ->

160160 m (P.ModuleName, name)

161161findImport imps (name, orig) =

162162 let

163− matches (qual, mn) = P.disqualify qual == name && mn == orig

163+ matches (P.ImportRecord qual mn _) = P.disqualify qual == name && mn == orig

164164 matching = filter matches imps

165165 getQualified (P.Qualified mname _) = mname

166166 in

167− case mapMaybe (getQualified . fst) matching of

167+ case mapMaybe (getQualified . P.importName) matching of

168168 -- A value can occur more than once if it is imported twice (eg, if it is

169169 -- exported by A, re-exported from A by B, and C imports it from both A

170170 -- and B). In this case, we just take its first appearance.

src/Language/PureScript/Errors.hs+9

@@ -69,6 +69,7 @@ data SimpleErrorMessage

6969 | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)

7070 | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)

7171 | ScopeConflict String [ModuleName]

72+ | ScopeShadowing String (Maybe ModuleName) [ModuleName]

7273 | ConflictingTypeDecls (ProperName 'TypeName)

7374 | ConflictingCtorDecls (ProperName 'ConstructorName)

7475 | TypeConflictsWithClass (ProperName 'TypeName)

@@ -248,6 +249,7 @@ errorCode em = case unwrapErrorMessage em of

248249 UnknownImportDataConstructor{} -> "UnknownImportDataConstructor"

249250 UnknownExportDataConstructor{} -> "UnknownExportDataConstructor"

250251 ScopeConflict{} -> "ScopeConflict"

252+ ScopeShadowing{} -> "ScopeShadowing"

251253 ConflictingTypeDecls{} -> "ConflictingTypeDecls"

252254 ConflictingCtorDecls{} -> "ConflictingCtorDecls"

253255 TypeConflictsWithClass{} -> "TypeConflictsWithClass"

@@ -604,6 +606,13 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

604606 paras [ line $ "Conflicting definitions are in scope for " ++ nm ++ " from the following modules:"

605607 , indent $ paras $ map (line . runModuleName) ms

606608 ]

609+ renderSimpleErrorMessage (ScopeShadowing nm exmn ms) =

610+ paras [ line $ "Shadowed definitions are in scope for " ++ nm ++ " from the following open imports:"

611+ , indent $ paras $ map (line . ("import " ++) . runModuleName) ms

612+ , line $ "These will be ignored and the " ++ case exmn of

613+ Just exmn' -> "declaration from " ++ runModuleName exmn' ++ " will be used."

614+ Nothing -> "local declaration will be used."

615+ ]

607616 renderSimpleErrorMessage (ConflictingTypeDecls nm) =

608617 line $ "Conflicting type declarations for " ++ runProperName nm

609618 renderSimpleErrorMessage (ConflictingCtorDecls nm) =

src/Language/PureScript/Linter/Imports.hs+14−5

@@ -17,6 +17,7 @@ import Control.Monad.Writer.Class

1717import Data.Foldable (forM_)

1818import Data.List ((\\), find, intersect, nub)

1919import Data.Maybe (mapMaybe)

20+import Data.Monoid (Sum(..))

2021import qualified Data.Map as M

2122

2223import Language.PureScript.AST.Declarations

@@ -78,6 +79,8 @@ lintImports (Module _ _ mn mdecls mexports) env usedImps = do

7879

7980 let scope = maybe nullImports (\(_, imps, _) -> imps) (M.lookup mn env)

8081 usedImps' = foldr (elaborateUsed scope) usedImps exportedModules

82+ numImplicitImports = getSum $ foldMap (Sum . countImplicitImports) mdecls

83+ allowImplicit = numImplicitImports == 1

8184

8285 imps <- M.toAscList <$> findImports mdecls

8386

@@ -86,7 +89,7 @@ lintImports (Module _ _ mn mdecls mexports) env usedImps = do

8689 forM_ decls $ \(ss, declType, qualifierName) ->

8790 censor (onErrorMessages $ addModuleLocError ss) $ do

8891 let names = nub $ M.findWithDefault [] mni usedImps'

89− lintImportDecl env mni qualifierName names declType

92+ lintImportDecl env mni qualifierName names declType allowImplicit

9093

9194 forM_ (M.toAscList (byQual imps)) $ \(mnq, entries) -> do

9295 let mnis = nub $ map (\(_, _, mni) -> mni) entries

@@ -103,6 +106,11 @@ lintImports (Module _ _ mn mdecls mexports) env usedImps = do

103106

104107 where

105108

109+ countImplicitImports :: Declaration -> Int

110+ countImplicitImports (ImportDeclaration mn' Implicit _ _) | not (isPrim mn') = 1

111+ countImplicitImports (PositionedDeclaration _ _ d) = countImplicitImports d

112+ countImplicitImports _ = 0

113+

106114 -- Checks whether a module is the Prim module - used to suppress any checks

107115 -- made, as Prim is always implicitly imported.

108116 isPrim :: ModuleName -> Bool

@@ -148,13 +156,13 @@ lintImports (Module _ _ mn mdecls mexports) env usedImps = do

148156 extractByQual

149157 :: (Eq a)

150158 => ModuleName

151− -> M.Map (Qualified a) [(Qualified a, ModuleName)]

159+ -> M.Map (Qualified a) [ImportRecord a]

152160 -> (Qualified a -> Name)

153161 -> [(ModuleName, Name)]

154162 extractByQual k m toName = mapMaybe go (M.toList m)

155163 where

156164 go (q@(Qualified mnq _), is) | isUnqualified q || isQualifiedWith k q =

157− case fst (head is) of

165+ case importName (head is) of

158166 Qualified (Just mn') name -> Just (mn', toName $ Qualified mnq name)

159167 _ -> internalError "unqualified name in extractByQual"

160168 go _ = Nothing

@@ -167,11 +175,12 @@ lintImportDecl

167175 -> Maybe ModuleName

168176 -> [Name]

169177 -> ImportDeclarationType

178+ -> Bool

170179 -> m ()

171−lintImportDecl env mni qualifierName names declType =

180+lintImportDecl env mni qualifierName names declType allowImplicit =

172181 case declType of

173182 Implicit -> case qualifierName of

174− Nothing -> checkImplicit ImplicitImport

183+ Nothing -> unless allowImplicit (checkImplicit ImplicitImport)

175184 Just q ->

176185 let usedModuleNames = mapMaybe extractQualName names

177186 in unless (q `elem` usedModuleNames) unused

src/Language/PureScript/Sugar/Names.hs+5−4

@@ -7,6 +7,8 @@ module Language.PureScript.Sugar.Names

77 ( desugarImports

88 , desugarImportsWithEnv

99 , Env

10+ , ImportRecord(..)

11+ , ImportProvenance(..)

1012 , Imports(..)

1113 , Exports(..)

1214 ) where

@@ -67,7 +69,7 @@ desugarImportsWithEnv externs modules = do

6769 let members = Exports{..}

6870 ss = internalModuleSourceSpan "<Externs>"

6971 env' = M.insert efModuleName (ss, nullImports, members) env

70− fromEFImport (ExternsImport mn mt qmn) = (mn, [(Nothing, mt, qmn)])

72+ fromEFImport (ExternsImport mn mt qmn) = (mn, [(Nothing, Just mt, qmn)])

7173 imps <- foldM (resolveModuleImport env') nullImports (map fromEFImport efImports)

7274 exps <- resolveExports env' efModuleName imps members efExports

7375 return $ M.insert efModuleName (ss, imps, exps) env

@@ -284,7 +286,7 @@ renameInModule env imports (Module ss coms mn decls exps) =

284286 update

285287 :: (Ord a, Show a)

286288 => (Qualified a -> SimpleErrorMessage)

287− -> M.Map (Qualified a) [(Qualified a, ModuleName)]

289+ -> M.Map (Qualified a) [ImportRecord a]

288290 -> (Exports -> a -> Maybe (Qualified a))

289291 -> (Qualified a -> Name)

290292 -> (a -> String)

@@ -300,8 +302,7 @@ renameInModule env imports (Module ss coms mn decls exps) =

300302 -- re-exports. If there are multiple options for the name to resolve to

301303 -- in scope, we throw an error.

302304 (Just options, _) -> do

303− checkImportConflicts render options

304− let (Qualified (Just mnNew) _, mnOrig) = head options

305+ (mnNew, mnOrig) <- checkImportConflicts mn render options

305306 modify $ \result -> M.insert mnNew (maybe [toName qname] (toName qname :) (mnNew `M.lookup` result)) result

306307 return $ Qualified (Just mnOrig) name

307308

src/Language/PureScript/Sugar/Names/Env.hs+55−15

@@ -2,7 +2,9 @@

22{-# LANGUAGE ScopedTypeVariables #-}

44module Language.PureScript.Sugar.Names.Env

5− ( Imports(..)

5+ ( ImportRecord(..)

6+ , ImportProvenance(..)

7+ , Imports(..)

68 , nullImports

79 , Exports(..)

810 , nullExports

@@ -19,13 +21,14 @@ module Language.PureScript.Sugar.Names.Env

1921 ) where

2022

2123import Data.Function (on)

22−import Data.List (groupBy, sortBy, nub)

24+import Data.List (groupBy, sortBy, nub, delete)

2325import Data.Maybe (fromJust)

2426import qualified Data.Map as M

2527import qualified Data.Set as S

2628

2729import Control.Monad

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

31+import Control.Monad.Writer.Class (MonadWriter(..))

2932

3033import Language.PureScript.AST

3134import Language.PureScript.Crash

@@ -33,6 +36,30 @@ import Language.PureScript.Names

3336import Language.PureScript.Environment

3437import Language.PureScript.Errors

3538

39+-- |

40+-- The details for an import: the name of the thing that is being imported

41+-- (`A.x` if importing from `A`), the module that the thing was originally

42+-- defined in (for re-export resolution), and the import provenance (see below).

43+--

44+data ImportRecord a =

45+ ImportRecord

46+ { importName :: Qualified a

47+ , importSourceModule :: ModuleName

48+ , importProvenance :: ImportProvenance

49+ }

50+ deriving (Eq, Ord, Show, Read)

51+

52+-- |

53+-- Used to track how an import was introduced into scope. This allows us to

54+-- handle the one-open-import special case that allows a name conflict to become

55+-- a warning rather than being an unresolvable situation.

56+--

57+data ImportProvenance

58+ = FromImplicit

59+ | FromExplicit

60+ | Local

61+ deriving (Eq, Ord, Show, Read)

62+

3663-- |

3764-- The imported declarations for a module, including the module's own members.

3865--

@@ -41,19 +68,19 @@ data Imports = Imports

4168 -- |

4269 -- Local names for types within a module mapped to to their qualified names

4370 --

44− importedTypes :: M.Map (Qualified (ProperName 'TypeName)) [(Qualified (ProperName 'TypeName), ModuleName)]

71+ importedTypes :: M.Map (Qualified (ProperName 'TypeName)) [ImportRecord (ProperName 'TypeName)]

4572 -- |

4673 -- Local names for data constructors within a module mapped to to their qualified names

4774 --

48− , importedDataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) [(Qualified (ProperName 'ConstructorName), ModuleName)]

75+ , importedDataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) [ImportRecord (ProperName 'ConstructorName)]

4976 -- |

5077 -- Local names for classes within a module mapped to to their qualified names

5178 --

52− , importedTypeClasses :: M.Map (Qualified (ProperName 'ClassName)) [(Qualified (ProperName 'ClassName), ModuleName)]

79+ , importedTypeClasses :: M.Map (Qualified (ProperName 'ClassName)) [ImportRecord (ProperName 'ClassName)]

5380 -- |

5481 -- Local names for values within a module mapped to to their qualified names

5582 --

56− , importedValues :: M.Map (Qualified Ident) [(Qualified Ident, ModuleName)]

83+ , importedValues :: M.Map (Qualified Ident) [ImportRecord Ident]

5784 -- |

5885 -- The modules that have been imported into the current scope.

5986 --

@@ -202,16 +229,29 @@ getExports env mn = maybe (throwError . errorMessage $ UnknownModule mn) (return

202229--

203230checkImportConflicts

204231 :: forall m a

205− . (MonadError MultipleErrors m, Ord a)

206− => (a -> String)

207− -> [(Qualified a, ModuleName)]

208− -> m ()

209−checkImportConflicts render xs =

210− let byOrig = groupBy ((==) `on` snd) . sortBy (compare `on` snd) $ xs

232+ . (Show a, MonadError MultipleErrors m, MonadWriter MultipleErrors m, Ord a)

233+ => ModuleName

234+ -> (a -> String)

235+ -> [ImportRecord a]

236+ -> m (ModuleName, ModuleName)

237+checkImportConflicts currentModule render xs =

238+ let

239+ byOrig = sortBy (compare `on` importSourceModule) xs

240+ groups = groupBy ((==) `on` importSourceModule) byOrig

241+ nonImplicit = filter ((/= FromImplicit) . importProvenance) xs

242+ name = render' (importName . head $ xs)

243+ conflictModules = map (getQual . importName . head) groups

211244 in

212− if length byOrig > 1

213− then throwError . errorMessage $ ScopeConflict (render' (fst . head $ xs)) (map (getQual . fst . head) byOrig)

214− else return ()

245+ if length groups > 1

246+ then case nonImplicit of

247+ [ImportRecord (Qualified (Just mnNew) _) mnOrig _] -> do

248+ let warningModule = if mnNew == currentModule then Nothing else Just mnNew

249+ tell . errorMessage $ ScopeShadowing name warningModule $ delete mnNew conflictModules

250+ return (mnNew, mnOrig)

251+ _ -> throwError . errorMessage $ ScopeConflict name conflictModules

252+ else

253+ let ImportRecord (Qualified (Just mnNew) _) mnOrig _ = head byOrig

254+ in return (mnNew, mnOrig)

215255 where

216256 getQual :: Qualified a -> ModuleName

217257 getQual (Qualified (Just mn) _) = mn

src/Language/PureScript/Sugar/Names/Exports.hs+5−5

@@ -110,17 +110,17 @@ resolveExports env mn imps exps refs =

110110 -- Extracts a list of values for a module based on a lookup table. If the

111111 -- boolean is true the values are filtered by the qualification

112112 extract

113− :: (Ord a)

113+ :: (Show a, Ord a)

114114 => Bool

115115 -> ModuleName

116116 -> (a -> String)

117− -> M.Map (Qualified a) [(Qualified a, ModuleName)]

117+ -> M.Map (Qualified a) [ImportRecord a]

118118 -> m [Qualified a]

119− extract useQual name render = fmap (map (fst . head . snd)) . go . M.toList

119+ extract useQual name render = fmap (map (importName . head . snd)) . go . M.toList

120120 where

121121 go = filterM $ \(name', options) -> do

122− let isMatch = if useQual then eqQual name name' else any (eqQual name . fst) options

123− when (isMatch && length options > 1) $ checkImportConflicts render options

122+ let isMatch = if useQual then eqQual name name' else any (eqQual name . importName) options

123+ when (isMatch && length options > 1) $ void $ checkImportConflicts mn render options

124124 return isMatch

125125

126126 -- Check whether a module name refers to a "pseudo module" that came into

src/Language/PureScript/Sugar/Names/Imports.hs+36−27

@@ -99,7 +99,8 @@ resolveImports env (Module ss coms currentModule decls exps) =

9999

100100 return ()

101101

102− let scope = M.insert currentModule [(Nothing, Implicit, Nothing)] imports

102+ let imports' = M.map (map (\(ss', dt, mmn) -> (ss', Just dt, mmn))) imports

103+ scope = M.insert currentModule [(Nothing, Nothing, Nothing)] imports'

103104 resolved <- foldM (resolveModuleImport env) nullImports (M.toList scope)

104105 return (Module ss coms currentModule decls' exps, resolved)

105106

@@ -162,11 +163,13 @@ resolveModuleImport

162163 . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

163164 => Env

164165 -> Imports

165− -> (ModuleName, [(Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)])

166+ -> (ModuleName, [(Maybe SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])

166167 -> m Imports

167168resolveModuleImport env ie (mn, imps) = foldM go ie imps

168169 where

169− go :: Imports -> (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName) -> m Imports

170+ go :: Imports

171+ -> (Maybe SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)

172+ -> m Imports

170173 go ie' (pos, typ, impQual) = do

171174 modExports <- positioned $ maybe (throwError . errorMessage $ UnknownModule mn) (return . envModuleExports) $ mn `M.lookup` env

172175 let virtualModules = importedVirtualModules ie'

@@ -189,15 +192,16 @@ resolveImport

189192 -> Exports

190193 -> Imports

191194 -> Maybe ModuleName

192− -> ImportDeclarationType

195+ -> Maybe ImportDeclarationType

193196 -> m Imports

194197resolveImport importModule exps imps impQual = resolveByType

195198 where

196199

197− resolveByType :: ImportDeclarationType -> m Imports

198− resolveByType Implicit = importAll importExplicit

199− resolveByType (Explicit refs) = checkRefs False refs >> foldM importExplicit imps refs

200− resolveByType (Hiding refs) = do

200+ resolveByType :: Maybe ImportDeclarationType -> m Imports

201+ resolveByType Nothing = importAll (importRef Local)

202+ resolveByType (Just Implicit) = importAll (importRef FromImplicit)

203+ resolveByType (Just (Explicit refs)) = checkRefs False refs >> foldM (importRef FromExplicit) imps refs

204+ resolveByType (Just (Hiding refs)) = do

201205 imps' <- checkRefs True refs >> importAll (importNonHidden refs)

202206 let isEmptyImport

203207 = M.null (importedTypes imps')

@@ -246,7 +250,7 @@ resolveImport importModule exps imps impQual = resolveByType

246250

247251 importNonHidden :: [DeclarationRef] -> Imports -> DeclarationRef -> m Imports

248252 importNonHidden hidden m ref | isHidden ref = return m

249− | otherwise = importExplicit m ref

253+ | otherwise = importRef FromImplicit m ref

250254 where

251255 -- TODO: rework this to be not confusing

252256 isHidden :: DeclarationRef -> Bool

@@ -268,27 +272,26 @@ resolveImport importModule exps imps impQual = resolveByType

268272 imp'' <- foldM (\m (name, _) -> importer m (ValueRef name)) imp' (exportedValues exps)

269273 foldM (\m (name, _) -> importer m (TypeClassRef name)) imp'' (exportedTypeClasses exps)

270274

271− -- Import something explicitly

272− importExplicit :: Imports -> DeclarationRef -> m Imports

273− importExplicit imp (PositionedDeclarationRef pos _ r) =

274− warnAndRethrowWithPosition pos $ importExplicit imp r

275− importExplicit imp (ValueRef name) = do

276− let values' = updateImports (importedValues imp) (exportedValues exps) name

275+ importRef :: ImportProvenance -> Imports -> DeclarationRef -> m Imports

276+ importRef prov imp (PositionedDeclarationRef pos _ r) =

277+ warnAndRethrowWithPosition pos $ importRef prov imp r

278+ importRef prov imp (ValueRef name) = do

279+ let values' = updateImports (importedValues imp) (exportedValues exps) name prov

277280 return $ imp { importedValues = values' }

278− importExplicit imp (TypeRef name dctors) = do

279− let types' = updateImports (importedTypes imp) (first fst `map` exportedTypes exps) name

281+ importRef prov imp (TypeRef name dctors) = do

282+ let types' = updateImports (importedTypes imp) (first fst `map` exportedTypes exps) name prov

280283 let exportedDctors :: [(ProperName 'ConstructorName, ModuleName)]

281284 exportedDctors = allExportedDataConstructors name

282285 dctorNames :: [ProperName 'ConstructorName]

283286 dctorNames = fst `map` exportedDctors

284287 maybe (return ()) (traverse_ $ checkDctorExists name dctorNames) dctors

285288 when (null dctorNames && isNothing dctors) . tell . errorMessage $ MisleadingEmptyTypeImport importModule name

286− let dctors' = foldl (\m -> updateImports m exportedDctors) (importedDataConstructors imp) (fromMaybe dctorNames dctors)

289+ let dctors' = foldl (\m d -> updateImports m exportedDctors d prov) (importedDataConstructors imp) (fromMaybe dctorNames dctors)

287290 return $ imp { importedTypes = types', importedDataConstructors = dctors' }

288− importExplicit imp (TypeClassRef name) = do

289− let typeClasses' = updateImports (importedTypeClasses imp) (exportedTypeClasses exps) name

291+ importRef prov imp (TypeClassRef name) = do

292+ let typeClasses' = updateImports (importedTypeClasses imp) (exportedTypeClasses exps) name prov

290293 return $ imp { importedTypeClasses = typeClasses' }

291− importExplicit _ _ = internalError "Invalid argument to importExplicit"

294+ importRef _ _ _ = internalError "Invalid argument to importRef"

292295

293296 -- Find all exported data constructors for a given type

294297 allExportedDataConstructors :: ProperName 'TypeName -> [(ProperName 'ConstructorName, ModuleName)]

@@ -300,11 +303,17 @@ resolveImport importModule exps imps impQual = resolveByType

300303 -- Add something to an import resolution list

301304 updateImports

302305 :: (Ord a)

303− => M.Map (Qualified a) [(Qualified a, ModuleName)]

306+ => M.Map (Qualified a) [ImportRecord a]

304307 -> [(a, ModuleName)]

305308 -> a

306− -> M.Map (Qualified a) [(Qualified a, ModuleName)]

307− updateImports imps' exps' name =

308− let mnOrig = fromMaybe (internalError "Invalid state in updateImports") (name `lookup` exps')

309− currNames = fromMaybe [] (M.lookup (Qualified impQual name) imps')

310− in M.insert (Qualified impQual name) ((Qualified (Just importModule) name, mnOrig) : currNames) imps'

309+ -> ImportProvenance

310+ -> M.Map (Qualified a) [ImportRecord a]

311+ updateImports imps' exps' name prov =

312+ let

313+ mnOrig = fromMaybe (internalError "Invalid state in updateImports") (name `lookup` exps')

314+ rec = ImportRecord (Qualified (Just importModule) name) mnOrig prov

315+ in

316+ M.alter

317+ (\currNames -> Just $ rec : fromMaybe [] currNames)

318+ (Qualified impQual name)

319+ imps'