0281a04 · rowtype-yoga/purescript-native

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

Merge pull request #1545 from nwolverson/unused-imports

Give warnings on unused imports (implicit and explicit)

commit0281a04abf2176f72267327bf07d26d4c4532aa3 authorGary Burgess <gary.burgess@gmail.com> dateSun 1 Nov 2015, 01:45 (11 years ago) parent62192bd 9314ff8

7 files changed+124−14

compare with golang

unifiedsplit

CONTRIBUTORS.md+1 purescript.cabal+1 src/Language/PureScript/Errors.hs+11−1 src/Language/PureScript/Linter.hs+1 src/Language/PureScript/Linter/Imports.hs+83 src/Language/PureScript/Sugar/Names.hs+24−13 src/Language/PureScript/Sugar/Names/Imports.hs+3

CONTRIBUTORS.md+1

@@ -36,6 +36,7 @@ This file lists the contributors to the PureScript compiler project, and the ter

3636- [@natefaubion](https://github.com/natefaubion) (Nathan Faubion) My existing contributions and all future contributions until further notice are Copyright Nathan Faubion, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

3737- [@nicodelpiano](https://github.com/nicodelpiano) (Nicolas Del Piano) My existing contributions and all future contributions until further notice are Copyright Nicolas Del Piano, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

3838- [@nullobject](https://github.com/nullobject) (Josh Bassett) My existing contributions and all future contributions until further notice are Copyright Josh Bassett, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

39+- [@nwolverson](https://github.com/nwolverson) (Nicholas Wolverson) My existing contributions and all future contributions until further notice are Copyright Nicholas Wolverson, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

3940- [@osa1](https://github.com/osa1) (Ömer Sinan Ağacan) - My existing contributions and all future contributions until further notice are Copyright Ömer Sinan Ağacan, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

4041- [@paf31](https://github.com/paf31) (Phil Freeman) My existing contributions and all future contributions until further notice are Copyright Phil Freeman, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

4142- [@paulyoung](https://github.com/paulyoung) (Paul Young) My existing contributions and all future contributions until further notice are Copyright Paul Young, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

purescript.cabal+1

@@ -108,6 +108,7 @@ library

108108 Language.PureScript.Kinds

109109 Language.PureScript.Linter

110110 Language.PureScript.Linter.Exhaustive

111+ Language.PureScript.Linter.Imports

111112 Language.PureScript.Make

112113 Language.PureScript.ModuleDependencies

113114 Language.PureScript.Names

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

@@ -144,7 +144,9 @@ data SimpleErrorMessage

144144 | ClassOperator ProperName Ident

145145 | MisleadingEmptyTypeImport ModuleName ProperName

146146 | ImportHidingModule ModuleName

147− deriving Show

147+ | UnusedImport ModuleName

148+ | UnusedExplicitImport ModuleName [String]

149+ deriving (Show)

148150

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

150152data ErrorMessageHint

@@ -280,6 +282,8 @@ errorCode em = case unwrapErrorMessage em of

280282 ClassOperator{} -> "ClassOperator"

281283 MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"

282284 ImportHidingModule{} -> "ImportHidingModule"

285+ UnusedImport{} -> "UnusedImport"

286+ UnusedExplicitImport{} -> "UnusedExplicitImport"

283287

284288-- |

285289-- A stack trace for an error

@@ -688,6 +692,12 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

688692 paras [ line "An exhaustivity check was abandoned due to too many possible cases."

689693 , line "You may want to decompose your data types into smaller types."

690694 ]

695+ renderSimpleErrorMessage (UnusedImport name) =

696+ line $ "The import of module " ++ runModuleName name ++ " is redundant"

697+

698+ renderSimpleErrorMessage (UnusedExplicitImport name names) =

699+ paras [ line $ "The import of module " ++ runModuleName name ++ " contains the following unused references:"

700+ , indent $ paras $ map line names ]

691701

692702 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

693703 renderHint (ErrorUnifyingTypes t1 t2) detail =

src/Language/PureScript/Linter.hs+1

@@ -36,6 +36,7 @@ import Language.PureScript.Names

3636import Language.PureScript.Errors

3737import Language.PureScript.Types

3838import Language.PureScript.Linter.Exhaustive as L

39+import Language.PureScript.Linter.Imports as L

3940

4041-- | Lint the PureScript AST.

4142-- |

src/Language/PureScript/Linter/Imports.hsnew file+83

@@ -0,0 +1,83 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

2+{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE CPP #-}

5+module Language.PureScript.Linter.Imports (findUnusedImports, Name(..), UsedImports()) where

7+import qualified Data.Map as M

8+import Data.Maybe (mapMaybe)

9+import Data.List ((\\), find)

10+import Control.Monad.Error.Class (MonadError(..))

11+import Control.Monad.Writer.Class

12+import Control.Monad(unless,when)

13+#if __GLASGOW_HASKELL__ < 710

14+import Control.Applicative

15+#endif

16+import Data.Foldable (forM_)

17+

18+import Language.PureScript.AST.Declarations

19+import Language.PureScript.AST.SourcePos

20+import Language.PureScript.Names as P

21+

22+import Language.PureScript.Errors

23+import Language.PureScript.Sugar.Names.Env

24+import Language.PureScript.Sugar.Names.Imports

25+

26+import qualified Language.PureScript.Constants as C

27+

28+-- | Imported name used in some type or expression.

29+data Name = IdentName (Qualified Ident) | IsProperName (Qualified ProperName) | DctorName (Qualified ProperName)

30+

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

32+type UsedImports = M.Map ModuleName [Name]

33+

34+-- |

35+-- Find and warn on any unused import statements (qualified or unqualified)

36+-- or references in an explicit import list.

37+--

38+findUnusedImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Module -> Env -> UsedImports -> m ()

39+findUnusedImports (Module _ _ _ mdecls _) env usedImps = do

40+ imps <- findImports mdecls

41+ forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` autoIncludes) $

42+ forM_ decls $ \(ss, declType, qualifierName) -> censor (onErrorMessages $ addModuleLocError ss) $

43+ let usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) $ sugarNames ++ M.findWithDefault [] mni usedImps in

44+ case declType of

45+ Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni

46+ Explicit declrefs -> do

47+ let idents = mapMaybe runDeclRef declrefs

48+ let diff = idents \\ usedNames

49+ unless (null diff) $ tell $ errorMessage $ UnusedExplicitImport mni diff

50+ _ -> return ()

51+ where

52+ sugarNames :: [ Name ]

53+ sugarNames = [ IdentName $ Qualified Nothing (Ident C.bind) ]

54+

55+ autoIncludes :: [ ModuleName ]

56+ autoIncludes = [ ModuleName [ProperName C.prim] ]

57+

58+ typeForDCtor :: ModuleName -> ProperName -> Maybe ProperName

59+ typeForDCtor mn pn =

60+ getTy <$> find matches tys

61+ where

62+ matches ((_, ctors), _) = pn `elem` ctors

63+ getTy ((ty, _), _) = ty

64+ tys :: [((ProperName, [ProperName]), ModuleName)]

65+ tys = maybe [] exportedTypes $ envModuleExports <$> mn `M.lookup` env

66+

67+matchName :: (ProperName -> Maybe ProperName) -> Maybe ModuleName -> Name -> Maybe String

68+matchName _ qual (IdentName (Qualified q x)) | q == qual = Just $ showIdent x

69+matchName _ qual (IsProperName (Qualified q x)) | q == qual = Just $ runProperName x

70+matchName lookupDc qual (DctorName (Qualified q x)) | q == qual = runProperName <$> lookupDc x

71+matchName _ _ _ = Nothing

72+

73+runDeclRef :: DeclarationRef -> Maybe String

74+runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref

75+runDeclRef (ValueRef ident) = Just $ showIdent ident

76+runDeclRef (TypeRef pn _) = Just $ runProperName pn

77+runDeclRef _ = Nothing

78+

79+addModuleLocError :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage

80+addModuleLocError sp err =

81+ case sp of

82+ Just pos -> withPosition pos err

83+ _ -> err

src/Language/PureScript/Sugar/Names.hs+24−13

@@ -28,6 +28,7 @@ import Control.Applicative (Applicative(..), (<$>), (<*>))

2828import Control.Monad

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

3030import Control.Monad.Writer (MonadWriter(..), censor)

31+import Control.Monad.State.Lazy

3132

3233import qualified Data.Map as M

3334

@@ -41,6 +42,7 @@ import Language.PureScript.Externs

4142import Language.PureScript.Sugar.Names.Env

4243import Language.PureScript.Sugar.Names.Imports

4344import Language.PureScript.Sugar.Names.Exports

45+import Language.PureScript.Linter.Imports

4446

4547-- |

4648-- Replaces all local names with qualified names within a list of modules. The

@@ -103,9 +105,11 @@ desugarImports externs modules = do

103105

104106 renameInModule' :: Env -> Module -> m Module

105107 renameInModule' env m@(Module _ _ mn _ _) =

106− rethrow (addHint (ErrorInModule mn)) $ do

108+ warnAndRethrow (addHint (ErrorInModule mn)) $ do

107109 let (_, imps, exps) = fromMaybe (internalError "Module is missing in renameInModule'") $ M.lookup mn env

108− elaborateImports imps <$> renameInModule env imps (elaborateExports exps m)

110+ (m', used) <- flip runStateT M.empty $ renameInModule env imps (elaborateExports exps m)

111+ findUnusedImports m env used

112+ return $ elaborateImports imps m'

109113

110114-- |

111115-- Make all exports for a module explicit. This may still effect modules that

@@ -146,10 +150,11 @@ elaborateImports imps (Module ss coms mn decls exps) = Module ss coms mn decls'

146150-- Replaces all local names with qualified names within a module and checks that all existing

147151-- qualified names are valid.

148152--

149−renameInModule :: forall m. (Applicative m, MonadError MultipleErrors m) => Env -> Imports -> Module -> m Module

153+renameInModule :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState UsedImports m) => Env -> Imports -> Module -> m Module

150154renameInModule env imports (Module ss coms mn decls exps) =

151155 Module ss coms mn <$> parU decls go <*> pure exps

152156 where

157+

153158 (go, _, _, _, _) = everywhereWithContextOnValuesM (Nothing, []) updateDecl updateValue updateBinder updateCase defS

154159

155160 updateDecl :: (Maybe SourceSpan, [Ident]) -> Declaration -> m ((Maybe SourceSpan, [Ident]), Declaration)

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

168173 updateDecl (pos, bound) (ExternDeclaration name ty) =

169174 (,) (pos, name : bound) <$> (ExternDeclaration name <$> updateTypesEverywhere pos ty)

170175 updateDecl s d = return (s, d)

171−

176+ --

172177 updateValue :: (Maybe SourceSpan, [Ident]) -> Expr -> m ((Maybe SourceSpan, [Ident]), Expr)

173178 updateValue (_, bound) v@(PositionedValue pos' _ _) =

174179 return ((Just pos', bound), v)

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

189194 updateValue s@(pos, _) (TypedValue check val ty) =

190195 (,) s <$> (TypedValue check val <$> updateTypesEverywhere pos ty)

191196 updateValue s v = return (s, v)

192−

197+ --

193198 updateBinder :: (Maybe SourceSpan, [Ident]) -> Binder -> m ((Maybe SourceSpan, [Ident]), Binder)

194199 updateBinder (_, bound) v@(PositionedBinder pos _ _) =

195200 return ((Just pos, bound), v)

@@ -201,8 +206,8 @@ renameInModule env imports (Module ss coms mn decls exps) =

201206 return (s', TypedBinder t' b')

202207 updateBinder s v =

203208 return (s, v)

204−

205− updateCase :: (Maybe SourceSpan, [Ident]) -> CaseAlternative -> m ((Maybe SourceSpan, [Ident]), CaseAlternative)

209+ --

210+ updateCase :: (Maybe SourceSpan, [Ident]) -> CaseAlternative -> m ((Maybe SourceSpan, [Ident]), CaseAlternative)

206211 updateCase (pos, bound) c@(CaseAlternative bs _) =

207212 return ((pos, concatMap binderNames bs ++ bound), c)

208213

@@ -223,16 +228,16 @@ renameInModule env imports (Module ss coms mn decls exps) =

223228 updateConstraints pos = mapM (\(name, ts) -> (,) <$> updateClassName name pos <*> mapM (updateTypesEverywhere pos) ts)

224229

225230 updateTypeName :: Qualified ProperName -> Maybe SourceSpan -> m (Qualified ProperName)

226− updateTypeName = update UnknownType (importedTypes imports) (resolveType . exportedTypes)

231+ updateTypeName = update UnknownType (importedTypes imports) (resolveType . exportedTypes) IsProperName

227232

228233 updateDataConstructorName :: Qualified ProperName -> Maybe SourceSpan -> m (Qualified ProperName)

229− updateDataConstructorName = update (flip UnknownDataConstructor Nothing) (importedDataConstructors imports) (resolveDctor . exportedTypes)

234+ updateDataConstructorName = update (flip UnknownDataConstructor Nothing) (importedDataConstructors imports) (resolveDctor . exportedTypes) DctorName

230235

231236 updateClassName :: Qualified ProperName -> Maybe SourceSpan -> m (Qualified ProperName)

232− updateClassName = update UnknownTypeClass (importedTypeClasses imports) (resolve . exportedTypeClasses)

237+ updateClassName = update UnknownTypeClass (importedTypeClasses imports) (resolve . exportedTypeClasses) IsProperName

233238

234239 updateValueName :: Qualified Ident -> Maybe SourceSpan -> m (Qualified Ident)

235− updateValueName = update UnknownValue (importedValues imports) (resolve . exportedValues)

240+ updateValueName = update UnknownValue (importedValues imports) (resolve . exportedValues) IdentName

236241

237242 -- Used when performing an update to qualify values and classes with their

238243 -- module of original definition.

@@ -255,16 +260,22 @@ renameInModule env imports (Module ss coms mn decls exps) =

255260 update :: (Ord a) => (Qualified a -> SimpleErrorMessage)

256261 -> M.Map (Qualified a) (Qualified a, ModuleName)

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

263+ -> (Qualified a -> Name)

258264 -> Qualified a

259265 -> Maybe SourceSpan

260266 -> m (Qualified a)

261− update unknown imps getE qname@(Qualified mn' name) pos = positioned $

267+ update unknown imps getE toName qname@(Qualified mn' name) pos = positioned $

262268 case (M.lookup qname imps, mn') of

263269 -- We found the name in our imports, so we return the name for it,

264270 -- qualifying with the name of the module it was originally defined in

265271 -- rather than the module we're importing from, to handle the case of

266272 -- re-exports.

267− (Just (_, mnOrig), _) -> return $ Qualified (Just mnOrig) name

273+ (Just (qn, mnOrig), _) -> do

274+ case qn of

275+ Qualified (Just mnNew) _ ->

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

277+ _ -> return ()

278+ return $ Qualified (Just mnOrig) name

268279 -- If the name wasn't found in our imports but was qualified then we need

269280 -- to check whether it's a failed import from a "pseudo" module (created

270281 -- by qualified importing). If that's not the case, then we just need to

src/Language/PureScript/Sugar/Names/Imports.hs+3

@@ -19,6 +19,7 @@

1919module Language.PureScript.Sugar.Names.Imports

2020 ( resolveImports

2121 , resolveModuleImport

22+ , findImports

2223 ) where

2324

2425import Data.List (find)

@@ -40,8 +41,10 @@ import Language.PureScript.Names

4041import Language.PureScript.Errors

4142import Language.PureScript.Sugar.Names.Env

4243

44+-- |

4345-- Finds the imports within a module, mapping the imported module name to an optional set of

4446-- explicitly imported declarations.

47+--

4548findImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [Declaration] -> m (M.Map ModuleName [(Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)])

4649findImports = foldM (go Nothing) M.empty

4750 where