git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1600 from nwolverson/unused-imports-2
367ff16Gary Burgess
src/Language/PureScript/Errors.hs+12
compare with golang
unifiedsplit
@@ -139,6 +139,8 @@ data SimpleErrorMessage
139 | ImportHidingModule ModuleName
139 | ImportHidingModule ModuleName
140 | UnusedImport ModuleName
140 | UnusedImport ModuleName
141 | UnusedExplicitImport ModuleName [String]
141 | UnusedExplicitImport ModuleName [String]
142+ | UnusedDctorImport ProperName
143+ | UnusedDctorExplicitImport ProperName [ProperName]
142 deriving (Show)
144 deriving (Show)
143
145
144-- | Error message hints, providing more detailed information about failure.
146-- | Error message hints, providing more detailed information about failure.
@@ -271,6 +273,9 @@ errorCode em = case unwrapErrorMessage em of
271 ImportHidingModule{} -> "ImportHidingModule"
273 ImportHidingModule{} -> "ImportHidingModule"
272 UnusedImport{} -> "UnusedImport"
274 UnusedImport{} -> "UnusedImport"
273 UnusedExplicitImport{} -> "UnusedExplicitImport"
275 UnusedExplicitImport{} -> "UnusedExplicitImport"
276+ UnusedDctorImport{} -> "UnusedDctorImport"
277+ UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"
278+
274
279
275-- |
280-- |
276-- A stack trace for an error
281-- A stack trace for an error
@@ -680,6 +685,13 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
680 paras [ line $ "The import of module " ++ runModuleName name ++ " contains the following unused references:"
685 paras [ line $ "The import of module " ++ runModuleName name ++ " contains the following unused references:"
681 , indent $ paras $ map line names ]
686 , indent $ paras $ map line names ]
682
687
688+ renderSimpleErrorMessage (UnusedDctorImport name) =
689+ line $ "The import of type " ++ runProperName name ++ " includes data constructors but only the type is used"
690+
691+ renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =
692+ paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"
693+ , indent $ paras $ map (line .runProperName) names ]
694+
683 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box
695 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box
684 renderHint (ErrorUnifyingTypes t1 t2) detail =
696 renderHint (ErrorUnifyingTypes t1 t2) detail =
685 paras [ detail
697 paras [ detail
src/Language/PureScript/Linter/Imports.hs+65−19
@@ -8,7 +8,7 @@ import Prelude.Compat
8
8
9import qualified Data.Map as M
9import qualified Data.Map as M
10import Data.Maybe (mapMaybe)
10import Data.Maybe (mapMaybe)
11−import Data.List ((\\), find)
11+import Data.List ((\\), find, intersect)
12import Control.Monad.Error.Class (MonadError(..))
12import Control.Monad.Error.Class (MonadError(..))
13import Control.Monad.Writer.Class
13import Control.Monad.Writer.Class
14import Control.Monad(unless,when)
14import Control.Monad(unless,when)
@@ -35,33 +35,70 @@ type UsedImports = M.Map ModuleName [Name]
35-- or references in an explicit import list.
35-- or references in an explicit import list.
36--
36--
37findUnusedImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Module -> Env -> UsedImports -> m ()
37findUnusedImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Module -> Env -> UsedImports -> m ()
38−findUnusedImports (Module _ _ _ mdecls _) env usedImps = do
38+findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do
39 imps <- findImports mdecls
39 imps <- findImports mdecls
40− forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` autoIncludes) $
40+ forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` alwaysUsedModules) $
41− forM_ decls $ \(ss, declType, qualifierName) -> censor (onErrorMessages $ addModuleLocError ss) $
41+ forM_ decls $ \(ss, declType, qualifierName) ->
42+ censor (onErrorMessages $ addModuleLocError ss) $ unless (qnameUsed qualifierName) $
42− let usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) $ sugarNames ++ M.findWithDefault [] mni usedImps in
43+ let names = sugarNames mni ++ M.findWithDefault [] mni usedImps
44+ usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) names
45+ usedDctors = mapMaybe (matchDctor qualifierName) names
43− case declType of
46+ in case declType of
44− Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni
47+ Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni
45− Explicit declrefs -> do
48+ Explicit declrefs -> do
46− let idents = mapMaybe runDeclRef declrefs
49+ let idents = mapMaybe runDeclRef declrefs
47− let diff = idents \\ usedNames
50+ let diff = idents \\ usedNames
51+ case (length diff, length idents) of
52+ (0, _) -> return ()
53+ (n, m) | n == m -> tell $ errorMessage $ UnusedImport mni
48− unless (null diff) $ tell $ errorMessage $ UnusedExplicitImport mni diff
54+ _ -> tell $ errorMessage $ UnusedExplicitImport mni diff
55+
56+ -- If we've not already warned a type is unused, check its data constructors
57+ forM_ (mapMaybe getTypeRef declrefs) $ \(tn, c) -> do
58+ let allCtors = dctorsForType mni tn
59+ when (runProperName tn `elem` usedNames) $ case (c, null $ usedDctors `intersect` allCtors) of
60+ (Nothing, True) -> tell $ errorMessage $ UnusedDctorImport tn
61+ (Just (_:_), True) -> tell $ errorMessage $ UnusedDctorImport tn
62+ (Just ctors, _) ->
63+ let ddiff = ctors \\ usedDctors
64+ in unless (null ddiff) $ tell $ errorMessage $ UnusedDctorExplicitImport tn ddiff
65+ _ -> return ()
66+ return ()
67+
49− _ -> return ()
68+ _ -> return ()
50 where
69 where
51− sugarNames :: [ Name ]
70+ sugarNames :: ModuleName -> [ Name ]
52− sugarNames = [ IdentName $ Qualified Nothing (Ident C.bind) ]
71+ sugarNames (ModuleName [ProperName n]) | n == C.prelude = [ IdentName $ Qualified Nothing (Ident C.bind) ]
72+ sugarNames _ = []
73+
74+ -- rely on exports being elaborated by this point
75+ alwaysUsedModules :: [ ModuleName ]
76+ alwaysUsedModules = ModuleName [ProperName C.prim] : maybe [] (mapMaybe isExport) mexports
77+ where
78+ isExport (ModuleRef mn) = Just mn
79+ isExport _ = Nothing
80+
81+ qnameUsed :: Maybe ModuleName -> Bool
82+ qnameUsed (Just qn) = qn `elem` alwaysUsedModules
83+ qnameUsed Nothing = False
53
84
54− autoIncludes :: [ ModuleName ]
85+ dtys :: ModuleName -> [((ProperName, [ProperName]), ModuleName)]
55− autoIncludes = [ ModuleName [ProperName C.prim] ]
86+ dtys mn = maybe [] exportedTypes $ envModuleExports <$> mn `M.lookup` env
87+
88+ dctorsForType :: ModuleName -> ProperName -> [ProperName]
89+ dctorsForType mn tn =
90+ maybe [] getDctors (find matches $ dtys mn)
91+ where
92+ matches ((ty, _),_) = ty == tn
93+ getDctors ((_,ctors),_) = ctors
56
94
57 typeForDCtor :: ModuleName -> ProperName -> Maybe ProperName
95 typeForDCtor :: ModuleName -> ProperName -> Maybe ProperName
58 typeForDCtor mn pn =
96 typeForDCtor mn pn =
59− getTy <$> find matches tys
97+ getTy <$> find matches (dtys mn)
60 where
98 where
61 matches ((_, ctors), _) = pn `elem` ctors
99 matches ((_, ctors), _) = pn `elem` ctors
62 getTy ((ty, _), _) = ty
100 getTy ((ty, _), _) = ty
63− tys :: [((ProperName, [ProperName]), ModuleName)]
101+
64− tys = maybe [] exportedTypes $ envModuleExports <$> mn `M.lookup` env
65
102
66matchName :: (ProperName -> Maybe ProperName) -> Maybe ModuleName -> Name -> Maybe String
103matchName :: (ProperName -> Maybe ProperName) -> Maybe ModuleName -> Name -> Maybe String
67matchName _ qual (IdentName (Qualified q x)) | q == qual = Just $ showIdent x
104matchName _ qual (IdentName (Qualified q x)) | q == qual = Just $ showIdent x
@@ -69,12 +106,21 @@ matchName _ qual (IsProperName (Qualified q x)) | q == qual = Just $ runProperNa
69matchName lookupDc qual (DctorName (Qualified q x)) | q == qual = runProperName <$> lookupDc x
106matchName lookupDc qual (DctorName (Qualified q x)) | q == qual = runProperName <$> lookupDc x
70matchName _ _ _ = Nothing
107matchName _ _ _ = Nothing
71
108
109+matchDctor :: Maybe ModuleName -> Name -> Maybe ProperName
110+matchDctor qual (DctorName (Qualified q x)) | q == qual = Just x
111+matchDctor _ _ = Nothing
112+
72runDeclRef :: DeclarationRef -> Maybe String
113runDeclRef :: DeclarationRef -> Maybe String
73runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref
114runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref
74runDeclRef (ValueRef ident) = Just $ showIdent ident
115runDeclRef (ValueRef ident) = Just $ showIdent ident
75runDeclRef (TypeRef pn _) = Just $ runProperName pn
116runDeclRef (TypeRef pn _) = Just $ runProperName pn
76runDeclRef _ = Nothing
117runDeclRef _ = Nothing
77
118
119+getTypeRef :: DeclarationRef -> Maybe (ProperName, Maybe [ProperName])
120+getTypeRef (PositionedDeclarationRef _ _ ref) = getTypeRef ref
121+getTypeRef (TypeRef pn x) = Just (pn, x)
122+getTypeRef _ = Nothing
123+
78addModuleLocError :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
124addModuleLocError :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
79addModuleLocError sp err =
125addModuleLocError sp err =
80 case sp of
126 case sp of