47c0ffb · rowtype-yoga/purescript-native

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

Give warnings on unused imports (implicit and explicit)

47c0ffbNicholas Wolverson11 years ago

CONTRIBUTORS.md+1

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

36- [@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).

37- [@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).

38- [@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).

39- [@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.

40- [@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.

40- [@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).

41- [@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).

41- [@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).

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

108 Language.PureScript.Kinds

109 Language.PureScript.Linter

110 Language.PureScript.Linter.Exhaustive

111+ Language.PureScript.Linter.Imports

111 Language.PureScript.Make

112 Language.PureScript.Make

112 Language.PureScript.ModuleDependencies

113 Language.PureScript.ModuleDependencies

113 Language.PureScript.Names

114 Language.PureScript.Names

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

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

144 | ClassOperator ProperName Ident

145 | MisleadingEmptyTypeImport ModuleName ProperName

146 | ImportHidingModule ModuleName

147+ | UnusedImport ModuleName

148+ | UnusedExplicitImport ModuleName [String]

147− deriving Show

149+ deriving (Show)

148

150

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

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

150data ErrorMessageHint

152data ErrorMessageHint

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

280 ClassOperator{} -> "ClassOperator"

282 ClassOperator{} -> "ClassOperator"

281 MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"

283 MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"

282 ImportHidingModule{} -> "ImportHidingModule"

284 ImportHidingModule{} -> "ImportHidingModule"

285+ UnusedImport{} -> "UnusedImport"

286+ UnusedExplicitImport{} -> "UnusedExplicitImport"

283

287

284-- |

288-- |

285-- A stack trace for an error

289-- A stack trace for an error

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

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

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

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

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

690 ]

694 ]

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 ]

691

701

692 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

702 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

693 renderHint (ErrorUnifyingTypes t1 t2) detail =

703 renderHint (ErrorUnifyingTypes t1 t2) detail =

src/Language/PureScript/Linter.hs+1

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

36import Language.PureScript.Errors

37import Language.PureScript.Types

38import Language.PureScript.Linter.Exhaustive as L

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

40-- | Lint the PureScript AST.

41-- | Lint the PureScript AST.

41-- |

42-- |

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

@@ -0,0 +1,73 @@

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 ((\\))

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)

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 -> Imports -> UsedImports -> m ()

39+findUnusedImports (Module _ _ _ mdecls _) _ 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 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+matchName :: Maybe ModuleName -> Name -> Maybe String

59+matchName qual (IdentName (Qualified q x)) | q == qual = Just $ runIdent x

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

61+matchName _ _ = Nothing

62+

63+runDeclRef :: DeclarationRef -> Maybe String

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

65+runDeclRef (ValueRef ident) = Just $ runIdent ident

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

67+runDeclRef _ = Nothing

68+

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

70+addModuleLocError sp err =

71+ case sp of

72+ Just pos -> withPosition pos err

73+ _ -> err

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

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

28import Control.Monad

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

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

31+import Control.Monad.State.Lazy

32import qualified Data.Map as M

33import qualified Data.Map as M

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

41import Language.PureScript.Sugar.Names.Env

42import Language.PureScript.Sugar.Names.Env

42import Language.PureScript.Sugar.Names.Imports

43import Language.PureScript.Sugar.Names.Imports

43import Language.PureScript.Sugar.Names.Exports

44import Language.PureScript.Sugar.Names.Exports

45+import Language.PureScript.Linter.Imports

45-- |

47-- |

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

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

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

103

105

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

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

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

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

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

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

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

109 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 imps used

112+ return $ elaborateImports imps m'

109

113

110-- |

114-- |

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

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

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

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

147-- qualified names are valid.

151-- qualified names are valid.

148--

152--

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

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

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

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

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

152 where

156 where

157+

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

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

154

159

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

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

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

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

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

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

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

170 updateDecl s d = return (s, d)

175 updateDecl s d = return (s, d)

171−

176+ --

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

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

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

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

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

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

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

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

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

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

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

191 updateValue s v = return (s, v)

196 updateValue s v = return (s, v)

192−

197+ --

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

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

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

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

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

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

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

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

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

202 updateBinder s v =

207 updateBinder s v =

203 return (s, v)

208 return (s, v)

204−

209+ --

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

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

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

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

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

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

208

213

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

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

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

224

229

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

230 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

227

232

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

233 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) IsProperName

230

235

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

236 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

233

238

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

239 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

236

241

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

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

238 -- module of original definition.

243 -- module of original definition.

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

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

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

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

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

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

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

263+ -> (Qualified a -> Name)

258 -> Qualified a

264 -> Qualified a

259 -> Maybe SourceSpan

265 -> Maybe SourceSpan

260 -> m (Qualified a)

266 -> 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 $

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

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

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

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

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

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

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

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

266 -- re-exports.

272 -- re-exports.

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

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

278+ return $ Qualified (Just mnOrig) name

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

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

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

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

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

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

19module Language.PureScript.Sugar.Names.Imports

20 ( resolveImports

21 , resolveModuleImport

22+ , findImports

22 ) where

23 ) where

24import Data.List (find)

25import Data.List (find)

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

40import Language.PureScript.Errors

41import Language.PureScript.Errors

41import Language.PureScript.Sugar.Names.Env

42import Language.PureScript.Sugar.Names.Env

44+-- |

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

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

44-- explicitly imported declarations.

46-- explicitly imported declarations.

47+--

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

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

46findImports = foldM (go Nothing) M.empty

49findImports = foldM (go Nothing) M.empty

47 where

50 where