f5548b1 · rowtype-yoga/purescript-native

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

Merge pull request #1685 from purescript/open-imports

Warn on unspecified imports

commitf5548b1b7ff81c1111e94e4339d9abb39d7dd9a0 authorGary Burgess <gary.burgess@gmail.com> dateFri 11 Dec 2015, 23:06 (11 years ago) parent368fce2 bb8aaa8

10 files changed+88−41

compare with golang

unifiedsplit

psci/Completion.hs+1−1 psci/PSCi.hs+4−3 psci/tests/Main.hs+2−2 src/Language/PureScript/AST/Declarations.hs+20−2 src/Language/PureScript/Docs/ParseAndDesugar.hs+1−10 src/Language/PureScript/Errors.hs+11−2 src/Language/PureScript/Linter/Imports.hs+41−3 src/Language/PureScript/Make.hs−12 src/Language/PureScript/Parser/Declarations.hs+4−2 src/Language/PureScript/Sugar/Names/Imports.hs+4−4

psci/Completion.hs+1−1

@@ -171,7 +171,7 @@ getAllQualifications sho m (declName, decl) = do

171171 qualificationsUsing (_, importType, asQ') =

172172 let q = qualifyWith asQ'

173173 in case importType of

174− P.Implicit -> [q]

174+ P.Implicit _ -> [q]

175175 P.Explicit refs -> [q | referencedBy refs]

176176 P.Hiding refs -> [q | not $ referencedBy refs]

177177

psci/PSCi.hs+4−3

@@ -315,10 +315,11 @@ handleShowImportedModules = do

315315 Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'

316316 Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType

317317

318− showDeclType P.Implicit = ""

318+ showDeclType (P.Implicit True) = " (..)"

319+ showDeclType (P.Implicit False) = ""

319320 showDeclType (P.Explicit refs) = refsList refs

320− showDeclType (P.Hiding refs) = "hiding " ++ refsList refs

321− refsList refs = "(" ++ commaList (map showRef refs) ++ ")"

321+ showDeclType (P.Hiding refs) = " hiding " ++ refsList refs

322+ refsList refs = " (" ++ commaList (map showRef refs) ++ ")"

322323

323324 showRef :: P.DeclarationRef -> String

324325 showRef (P.TypeRef pn dctors) = N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"

psci/tests/Main.hs+2−2

@@ -141,11 +141,11 @@ getPSCiState = do

141141 Left err ->

142142 print err >> exitFailure

143143 Right modules ->

144− let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]

144+ let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit True, Nothing)]

145145 in return (PSCiState [] imports modules foreigns [] [])

146146

147147controlMonadSTasST :: ImportedModule

148−controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))

148+controlMonadSTasST = (s "Control.Monad.ST", P.Implicit True, Just (s "ST"))

149149 where

150150 s = P.moduleNameFromString

151151

src/Language/PureScript/AST/Declarations.hs+20−2

@@ -41,6 +41,18 @@ data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [Decla

4141getModuleName :: Module -> ModuleName

4242getModuleName (Module _ _ name _ _) = name

4343

44+-- |

45+-- Add an import declaration for a module if it does not already explicitly import it.

46+--

47+addDefaultImport :: ModuleName -> Module -> Module

48+addDefaultImport toImport m@(Module ss coms mn decls exps) =

49+ if isExistingImport `any` decls || mn == toImport then m

50+ else Module ss coms mn (ImportDeclaration toImport (Implicit True) Nothing False : decls) exps

51+ where

52+ isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True

53+ isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

54+ isExistingImport _ = False

55+

4456-- |

4557-- An item in a list of explicit imports or exports

4658--

@@ -118,9 +130,11 @@ findDuplicateRefs refs =

118130--

119131data ImportDeclarationType

120132 -- |

121− -- An import with no explicit list: `import M`

133+ -- An import with no explicit list: `import M`. The boolean signifies whether

134+ -- the import was imported with `(..)` or not. Without `(..)` a warning is

135+ -- raised for each member implicitly imported.

122136 --

123− = Implicit

137+ = Implicit Bool

124138 -- |

125139 -- An import with an explicit list of references to import: `import M (foo)`

126140 --

@@ -131,6 +145,10 @@ data ImportDeclarationType

131145 | Hiding [DeclarationRef]

132146 deriving (Eq, Show, Read, D.Data, D.Typeable)

133147

148+isImplicit :: ImportDeclarationType -> Bool

149+isImplicit (Implicit _) = True

150+isImplicit _ = False

151+

134152-- |

135153-- The data type of declarations

136154--

src/Language/PureScript/Docs/ParseAndDesugar.hs+1−10

@@ -105,17 +105,8 @@ fileInfoToString :: FileInfo -> FilePath

105105fileInfoToString (Local fn) = fn

106106fileInfoToString (FromDep _ fn) = fn

107107

108−addDefaultImport :: P.ModuleName -> P.Module -> P.Module

109−addDefaultImport toImport m@(P.Module ss coms mn decls exps) =

110− if isExistingImport `any` decls || mn == toImport then m

111− else P.Module ss coms mn (P.ImportDeclaration toImport P.Implicit Nothing False : decls) exps

112− where

113− isExistingImport (P.ImportDeclaration mn' _ _ _) | mn' == toImport = True

114− isExistingImport (P.PositionedDeclaration _ _ d) = isExistingImport d

115− isExistingImport _ = False

116−

117108importPrim :: P.Module -> P.Module

118−importPrim = addDefaultImport (P.ModuleName [P.ProperName C.prim])

109+importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])

119110

120111desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]

121112desugar = P.evalSupplyT 0 . desugar'

src/Language/PureScript/Errors.hs+11−2

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

138138 | DuplicateExportRef String

139139 | IntOutOfRange Integer String Integer Integer

140140 | RedundantEmptyHidingImport ModuleName

141+ | ImplicitImport ModuleName [DeclarationRef]

141142 deriving (Show)

142143

143144-- | Error message hints, providing more detailed information about failure.

@@ -282,6 +283,7 @@ errorCode em = case unwrapErrorMessage em of

282283 DuplicateExportRef{} -> "DuplicateExportRef"

283284 IntOutOfRange{} -> "IntOutOfRange"

284285 RedundantEmptyHidingImport{} -> "RedundantEmptyHidingImport"

286+ ImplicitImport{} -> "ImplicitImport"

285287

286288

287289-- |

@@ -819,6 +821,11 @@ prettyPrintSingleError full level e = do

819821 renderSimpleErrorMessage (RedundantEmptyHidingImport mn) =

820822 line $ "The import for module " ++ runModuleName mn ++ " is redundant as all members have been explicitly hidden."

821823

824+ renderSimpleErrorMessage (ImplicitImport mn refs) =

825+ paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the explicit form: "

826+ , indent $ line $ "import " ++ runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"

827+ ]

828+

822829 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

823830 renderHint (ErrorUnifyingTypes t1 t2) detail =

824831 paras [ detail

@@ -954,9 +961,10 @@ prettyPrintSingleError full level e = do

954961

955962 prettyPrintRef :: DeclarationRef -> String

956963 prettyPrintRef (TypeRef pn Nothing) = runProperName pn ++ "(..)"

964+ prettyPrintRef (TypeRef pn (Just [])) = runProperName pn

957965 prettyPrintRef (TypeRef pn (Just dctors)) = runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"

958966 prettyPrintRef (ValueRef ident) = showIdent ident

959− prettyPrintRef (TypeClassRef pn) = runProperName pn

967+ prettyPrintRef (TypeClassRef pn) = "class " ++ runProperName pn

960968 prettyPrintRef (ProperRef pn) = runProperName pn

961969 prettyPrintRef (TypeInstanceRef ident) = showIdent ident

962970 prettyPrintRef (ModuleRef name) = "module " ++ runModuleName name

@@ -965,7 +973,8 @@ prettyPrintSingleError full level e = do

965973 prettyPrintImport :: ModuleName -> ImportDeclarationType -> Maybe ModuleName -> String

966974 prettyPrintImport mn idt qual =

967975 let i = case idt of

968− Implicit -> runModuleName mn

976+ Implicit True -> runModuleName mn ++ " (..)"

977+ Implicit False -> runModuleName mn

969978 Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"

970979 Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (map prettyPrintRef refs) ++ ")"

971980 in i ++ maybe "" (\q -> " as " ++ runModuleName q) qual

src/Language/PureScript/Linter/Imports.hs+41−3

@@ -16,6 +16,7 @@ import Data.Foldable (forM_)

1616

1717import Language.PureScript.AST.Declarations

1818import Language.PureScript.AST.SourcePos

19+import Language.PureScript.Crash

1920import Language.PureScript.Names as P

2021

2122import Language.PureScript.Errors

@@ -30,6 +31,19 @@ data Name

3031 | TypeName (Qualified ProperName)

3132 | DctorName (Qualified ProperName)

3233 | ClassName (Qualified ProperName)

34+ deriving (Eq)

35+

36+getIdentName :: Name -> Maybe Ident

37+getIdentName (IdentName (Qualified _ name)) = Just name

38+getIdentName _ = Nothing

39+

40+getTypeName :: Name -> Maybe ProperName

41+getTypeName (TypeName (Qualified _ name)) = Just name

42+getTypeName _ = Nothing

43+

44+getClassName :: Name -> Maybe ProperName

45+getClassName (ClassName (Qualified _ name)) = Just name

46+getClassName _ = Nothing

3347

3448-- | Map of module name to list of imported names from that module which have been used.

3549type UsedImports = M.Map ModuleName [Name]

@@ -44,11 +58,21 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

4458 forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` alwaysUsedModules) $

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

4660 censor (onErrorMessages $ addModuleLocError ss) $ unless (qnameUsed qualifierName) $

47− let names = sugarNames mni ++ M.findWithDefault [] mni usedImps

61+ let names = nub $ sugarNames mni ++ M.findWithDefault [] mni usedImps

4862 usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) names

4963 usedDctors = mapMaybe (matchDctor qualifierName) names

5064 in case declType of

51− Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni

65+ Implicit _ | null usedNames -> tell $ errorMessage $ UnusedImport mni

66+ Implicit False ->

67+ let classRefs = TypeClassRef <$> mapMaybe getClassName names

68+ valueRefs = ValueRef <$> mapMaybe getIdentName names

69+ types = mapMaybe getTypeName names

70+ typesWithDctors = reconstructTypeRefs mni usedDctors

71+ typesWithoutDctors = filter (`M.notMember` typesWithDctors) types

72+ typesRefs

73+ = map (flip TypeRef (Just [])) typesWithoutDctors

74+ ++ map (\(ty, ds) -> TypeRef ty (Just ds)) (M.toList typesWithDctors)

75+ in tell $ errorMessage $ ImplicitImport mni (classRefs ++ typesRefs ++ valueRefs)

5276 Explicit declrefs -> do

5377 let idents = nub (mapMaybe runDeclRef declrefs)

5478 let diff = idents \\ usedNames

@@ -76,6 +100,20 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

76100 sugarNames (ModuleName [ProperName n]) | n == C.prelude = [ IdentName $ Qualified Nothing (Ident C.bind) ]

77101 sugarNames _ = []

78102

103+ reconstructTypeRefs :: ModuleName -> [ProperName] -> M.Map ProperName [ProperName]

104+ reconstructTypeRefs mni = foldr accumDctors M.empty

105+ where

106+ accumDctors dctor = M.alter (Just . maybe [dctor] (dctor :)) (findTypeForDctor mni dctor)

107+

108+ findTypeForDctor :: ModuleName -> ProperName -> ProperName

109+ findTypeForDctor mn dctor =

110+ case mn `M.lookup` env of

111+ Just (_, _, exps) ->

112+ case find (elem dctor . snd . fst) (exportedTypes exps) of

113+ Just ((ty, _), _) -> ty

114+ Nothing -> internalError $ "missing type for data constructor " ++ runProperName dctor ++ " in findTypeForDctor"

115+ Nothing -> internalError $ "missing module " ++ runModuleName mn ++ " in findTypeForDctor"

116+

79117 -- rely on exports being elaborated by this point

80118 alwaysUsedModules :: [ ModuleName ]

81119 alwaysUsedModules = ModuleName [ProperName C.prim] : maybe [] (mapMaybe extractModule) mexports

@@ -121,7 +159,7 @@ runDeclRef :: DeclarationRef -> Maybe String

121159runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref

122160runDeclRef (ValueRef ident) = Just $ showIdent ident

123161runDeclRef (TypeRef pn _) = Just $ runProperName pn

124−runDeclRef (TypeClassRef pn) = Just $ runProperName pn

162+runDeclRef (TypeClassRef pn) = Just $ "class " ++ runProperName pn

125163runDeclRef _ = Nothing

126164

127165getTypeRef :: DeclarationRef -> Maybe (ProperName, Maybe [ProperName])

src/Language/PureScript/Make.hs−12

@@ -266,18 +266,6 @@ make MakeActions{..} ms = do

266266 guard $ efVersion externs == showVersion Paths.version

267267 return externs

268268

269−-- |

270−-- Add an import declaration for a module if it does not already explicitly import it.

271−--

272−addDefaultImport :: ModuleName -> Module -> Module

273−addDefaultImport toImport m@(Module ss coms mn decls exps) =

274− if isExistingImport `any` decls || mn == toImport then m

275− else Module ss coms mn (ImportDeclaration toImport Implicit Nothing False : decls) exps

276− where

277− isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True

278− isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

279− isExistingImport _ = False

280−

281269importPrim :: Module -> Module

282270importPrim = addDefaultImport (ModuleName [ProperName C.prim])

283271

src/Language/PureScript/Parser/Declarations.hs+4−2

@@ -152,8 +152,10 @@ parseImportDeclaration' = do

152152 qName <- qualifiedName

153153 return (moduleName', declType, Just qName, True)

154154 qualifyingList expectedType = do

155− idents <- P.optionMaybe $ indented *> parens (commaSep parseDeclarationRef)

156− return $ fromMaybe Implicit (expectedType <$> idents)

155+ declType <- P.optionMaybe

156+ $ P.try (expectedType <$> (indented *> parens (commaSep parseDeclarationRef)))

157+ <|> (const (Implicit True) <$> (indented *> parens (symbol' "..")))

158+ return $ fromMaybe (Implicit False) declType

157159

158160

159161parseDeclarationRef :: TokenParser DeclarationRef

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

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

7979 warned' <- (warned ++) <$>

8080 if (length unqual < 2)

8181 then return []

82− else case find (\(_, typ, _) -> typ == Implicit) unqual of

82+ else case find (\(_, typ, _) -> isImplicit typ) unqual of

8383 Just i ->

8484 for (delete i unqual) $ \i'@(pos, typ, _) -> do

8585 warn pos $ RedundantUnqualifiedImport mn typ

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

9898

9999 return ()

100100

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

101+ let scope = M.insert currentModule [(Nothing, Implicit True, Nothing)] imports

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

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

104104

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

138138 updateImportRef (ImportDeclaration mn typ qual isOldSyntax) = do

139139 modExports <- getExports env mn

140140 typ' <- case typ of

141− Implicit -> return Implicit

141+ Implicit b -> return $ Implicit b

142142 Explicit refs -> Explicit <$> updateProperRef mn modExports `traverse` refs

143143 Hiding refs -> Hiding <$> updateProperRef mn modExports `traverse` refs

144144 return $ ImportDeclaration mn typ' qual isOldSyntax

@@ -193,7 +193,7 @@ resolveImport currentModule importModule exps imps impQual = resolveByType

193193 where

194194

195195 resolveByType :: ImportDeclarationType -> m Imports

196− resolveByType Implicit = importAll importExplicit

196+ resolveByType (Implicit _) = importAll importExplicit

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

198198 resolveByType (Hiding refs) = do

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