57a3833 · rowtype-yoga/purescript-native

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

on golang help sign in

Allow one open import without warning

57a3833Gary Burgess11 years ago

examples/failing/ConflictingExports2.pursdeleted−13

compare with golang

unifiedsplit

@@ -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

4 thing :: Int

5 thing = 1

7−module Main where

7+module B where

8−

9− import A

11 thing :: Int

9 thing :: Int

12 thing = 2

10 thing = 2

12+module Main where

13+

14+ import A (thing)

15+ import B (thing)

16+

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

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

18+ -- and B.thing

15 what :: Int

19 what :: Int

16 what = thing

20 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

155--

156findImport ::

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

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

158+ [P.ImportRecord name] ->

159 (name, P.ModuleName) ->

160 m (P.ModuleName, name)

161findImport imps (name, orig) =

162 let

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

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

164 matching = filter matches imps

165 getQualified (P.Qualified mname _) = mname

166 in

167− case mapMaybe (getQualified . fst) matching of

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

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

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

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

src/Language/PureScript/Errors.hs+9

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

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

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

71 | ScopeConflict String [ModuleName]

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

72 | ConflictingTypeDecls (ProperName 'TypeName)

73 | ConflictingTypeDecls (ProperName 'TypeName)

73 | ConflictingCtorDecls (ProperName 'ConstructorName)

74 | ConflictingCtorDecls (ProperName 'ConstructorName)

74 | TypeConflictsWithClass (ProperName 'TypeName)

75 | TypeConflictsWithClass (ProperName 'TypeName)

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

248 UnknownImportDataConstructor{} -> "UnknownImportDataConstructor"

249 UnknownImportDataConstructor{} -> "UnknownImportDataConstructor"

249 UnknownExportDataConstructor{} -> "UnknownExportDataConstructor"

250 UnknownExportDataConstructor{} -> "UnknownExportDataConstructor"

250 ScopeConflict{} -> "ScopeConflict"

251 ScopeConflict{} -> "ScopeConflict"

252+ ScopeShadowing{} -> "ScopeShadowing"

251 ConflictingTypeDecls{} -> "ConflictingTypeDecls"

253 ConflictingTypeDecls{} -> "ConflictingTypeDecls"

252 ConflictingCtorDecls{} -> "ConflictingCtorDecls"

254 ConflictingCtorDecls{} -> "ConflictingCtorDecls"

253 TypeConflictsWithClass{} -> "TypeConflictsWithClass"

255 TypeConflictsWithClass{} -> "TypeConflictsWithClass"

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

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

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

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

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

606 ]

608 ]

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+ ]

607 renderSimpleErrorMessage (ConflictingTypeDecls nm) =

616 renderSimpleErrorMessage (ConflictingTypeDecls nm) =

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

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

609 renderSimpleErrorMessage (ConflictingCtorDecls nm) =

618 renderSimpleErrorMessage (ConflictingCtorDecls nm) =

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

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

17import Data.Foldable (forM_)

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

19import Data.Maybe (mapMaybe)

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

20import qualified Data.Map as M

21import qualified Data.Map as M

22import Language.PureScript.AST.Declarations

23import Language.PureScript.AST.Declarations

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

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

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

80 usedImps' = foldr (elaborateUsed scope) usedImps exportedModules

81 usedImps' = foldr (elaborateUsed scope) usedImps exportedModules

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

83+ allowImplicit = numImplicitImports == 1

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

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

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

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

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

87 censor (onErrorMessages $ addModuleLocError ss) $ do

90 censor (onErrorMessages $ addModuleLocError ss) $ do

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

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

89− lintImportDecl env mni qualifierName names declType

92+ lintImportDecl env mni qualifierName names declType allowImplicit

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

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

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

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

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

103

106

104 where

107 where

105

108

109+ countImplicitImports :: Declaration -> Int

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

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

112+ countImplicitImports _ = 0

113+

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

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

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

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

108 isPrim :: ModuleName -> Bool

116 isPrim :: ModuleName -> Bool

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

148 extractByQual

156 extractByQual

149 :: (Eq a)

157 :: (Eq a)

150 => ModuleName

158 => ModuleName

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

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

152 -> (Qualified a -> Name)

160 -> (Qualified a -> Name)

153 -> [(ModuleName, Name)]

161 -> [(ModuleName, Name)]

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

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

155 where

163 where

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

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

157− case fst (head is) of

165+ case importName (head is) of

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

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

159 _ -> internalError "unqualified name in extractByQual"

167 _ -> internalError "unqualified name in extractByQual"

160 go _ = Nothing

168 go _ = Nothing

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

167 -> Maybe ModuleName

175 -> Maybe ModuleName

168 -> [Name]

176 -> [Name]

169 -> ImportDeclarationType

177 -> ImportDeclarationType

178+ -> Bool

170 -> m ()

179 -> m ()

171−lintImportDecl env mni qualifierName names declType =

180+lintImportDecl env mni qualifierName names declType allowImplicit =

172 case declType of

181 case declType of

173 Implicit -> case qualifierName of

182 Implicit -> case qualifierName of

174− Nothing -> checkImplicit ImplicitImport

183+ Nothing -> unless allowImplicit (checkImplicit ImplicitImport)

175 Just q ->

184 Just q ->

176 let usedModuleNames = mapMaybe extractQualName names

185 let usedModuleNames = mapMaybe extractQualName names

177 in unless (q `elem` usedModuleNames) unused

186 in unless (q `elem` usedModuleNames) unused

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

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

7 ( desugarImports

8 , desugarImportsWithEnv

9 , Env

10+ , ImportRecord(..)

11+ , ImportProvenance(..)

10 , Imports(..)

12 , Imports(..)

11 , Exports(..)

13 , Exports(..)

12 ) where

14 ) where

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

67 let members = Exports{..}

69 let members = Exports{..}

68 ss = internalModuleSourceSpan "<Externs>"

70 ss = internalModuleSourceSpan "<Externs>"

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

71 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)])

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

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

72 exps <- resolveExports env' efModuleName imps members efExports

74 exps <- resolveExports env' efModuleName imps members efExports

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

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

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

284 update

286 update

285 :: (Ord a, Show a)

287 :: (Ord a, Show a)

286 => (Qualified a -> SimpleErrorMessage)

288 => (Qualified a -> SimpleErrorMessage)

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

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

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

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

289 -> (Qualified a -> Name)

291 -> (Qualified a -> Name)

290 -> (a -> String)

292 -> (a -> String)

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

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

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

301 -- in scope, we throw an error.

303 -- in scope, we throw an error.

302 (Just options, _) -> do

304 (Just options, _) -> do

303− checkImportConflicts render options

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

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

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

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

306 return $ Qualified (Just mnOrig) name

307 return $ Qualified (Just mnOrig) name

307

308

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

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

2{-# LANGUAGE ScopedTypeVariables #-}

4module Language.PureScript.Sugar.Names.Env

5+ ( ImportRecord(..)

6+ , ImportProvenance(..)

5− ( Imports(..)

7+ , Imports(..)

6 , nullImports

8 , nullImports

7 , Exports(..)

9 , Exports(..)

8 , nullExports

10 , nullExports

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

19 ) where

21 ) where

21import Data.Function (on)

23import Data.Function (on)

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

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

23import Data.Maybe (fromJust)

25import Data.Maybe (fromJust)

24import qualified Data.Map as M

26import qualified Data.Map as M

25import qualified Data.Set as S

27import qualified Data.Set as S

27import Control.Monad

29import Control.Monad

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

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

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

30import Language.PureScript.AST

33import Language.PureScript.AST

31import Language.PureScript.Crash

34import Language.PureScript.Crash

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

33import Language.PureScript.Environment

36import Language.PureScript.Environment

34import Language.PureScript.Errors

37import Language.PureScript.Errors

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+

36-- |

63-- |

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

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

38--

65--

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

41 -- |

68 -- |

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

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

43 --

70 --

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

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

45 -- |

72 -- |

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

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

47 --

74 --

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

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

49 -- |

76 -- |

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

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

51 --

78 --

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

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

53 -- |

80 -- |

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

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

55 --

82 --

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

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

57 -- |

84 -- |

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

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

59 --

86 --

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

202--

229--

203checkImportConflicts

230checkImportConflicts

204 :: forall m a

231 :: forall m a

205− . (MonadError MultipleErrors m, Ord a)

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

233+ => ModuleName

206− => (a -> String)

234+ -> (a -> String)

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

235+ -> [ImportRecord a]

208− -> m ()

236+ -> m (ModuleName, ModuleName)

209−checkImportConflicts render xs =

237+checkImportConflicts currentModule render xs =

238+ let

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

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

211 in

244 in

212− if length byOrig > 1

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)

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

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

252+ else

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

214− else return ()

254+ in return (mnNew, mnOrig)

215 where

255 where

216 getQual :: Qualified a -> ModuleName

256 getQual :: Qualified a -> ModuleName

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

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

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

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

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

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

112 extract

113− :: (Ord a)

113+ :: (Show a, Ord a)

114 => Bool

115 -> ModuleName

116 -> (a -> String)

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

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

118 -> 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

120 where

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

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

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

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

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

124 return isMatch

125

126 -- 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) =

100 return ()

101

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

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

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

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

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

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

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

105

106

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

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

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

163 => Env

164 => Env

164 -> Imports

165 -> Imports

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

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

166 -> m Imports

167 -> m Imports

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

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

168 where

169 where

170+ go :: Imports

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

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

172+ -> m Imports

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

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

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

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

172 let virtualModules = importedVirtualModules ie'

175 let virtualModules = importedVirtualModules ie'

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

189 -> Exports

192 -> Exports

190 -> Imports

193 -> Imports

191 -> Maybe ModuleName

194 -> Maybe ModuleName

192− -> ImportDeclarationType

195+ -> Maybe ImportDeclarationType

193 -> m Imports

196 -> m Imports

194resolveImport importModule exps imps impQual = resolveByType

197resolveImport importModule exps imps impQual = resolveByType

195 where

198 where

196

199

197− resolveByType :: ImportDeclarationType -> m Imports

200+ resolveByType :: Maybe ImportDeclarationType -> m Imports

198− resolveByType Implicit = importAll importExplicit

201+ resolveByType Nothing = importAll (importRef Local)

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

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

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

200− resolveByType (Hiding refs) = do

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

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

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

202 let isEmptyImport

206 let isEmptyImport

203 = M.null (importedTypes imps')

207 = M.null (importedTypes imps')

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

246

250

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

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

248 importNonHidden hidden m ref | isHidden ref = return m

252 importNonHidden hidden m ref | isHidden ref = return m

249− | otherwise = importExplicit m ref

253+ | otherwise = importRef FromImplicit m ref

250 where

254 where

251 -- TODO: rework this to be not confusing

255 -- TODO: rework this to be not confusing

252 isHidden :: DeclarationRef -> Bool

256 isHidden :: DeclarationRef -> Bool

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

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

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

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

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

270

274

271− -- Import something explicitly

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

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

273− importExplicit imp (PositionedDeclarationRef pos _ r) =

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

274− warnAndRethrowWithPosition pos $ importExplicit imp r

277+ warnAndRethrowWithPosition pos $ importRef prov imp r

275− importExplicit imp (ValueRef name) = do

278+ importRef prov imp (ValueRef name) = do

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

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

277 return $ imp { importedValues = values' }

280 return $ imp { importedValues = values' }

278− importExplicit imp (TypeRef name dctors) = do

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

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

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

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

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

281 exportedDctors = allExportedDataConstructors name

284 exportedDctors = allExportedDataConstructors name

282 dctorNames :: [ProperName 'ConstructorName]

285 dctorNames :: [ProperName 'ConstructorName]

283 dctorNames = fst `map` exportedDctors

286 dctorNames = fst `map` exportedDctors

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

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

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

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

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

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

288− importExplicit imp (TypeClassRef name) = do

291+ importRef prov imp (TypeClassRef name) = do

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

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

290 return $ imp { importedTypeClasses = typeClasses' }

293 return $ imp { importedTypeClasses = typeClasses' }

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

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

292

295

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

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

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

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

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

300 -- Add something to an import resolution list

303 -- Add something to an import resolution list

301 updateImports

304 updateImports

302 :: (Ord a)

305 :: (Ord a)

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

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

304 -> [(a, ModuleName)]

307 -> [(a, ModuleName)]

305 -> a

308 -> a

309+ -> ImportProvenance

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

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

307− updateImports imps' exps' name =

311+ updateImports imps' exps' name prov =

312+ let

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

313+ 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'

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'