git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Warn on unused data constructors
commit6a894b4a8d78e6908441532761c4eb031f18a6af authorNicholas Wolverson <nicholas.wolverson@gmail.com> dateMon 9 Nov 2015, 22:48 (11 years ago) parent3c6e62e
2 files changed+49−6
compare with golang
unifiedsplit
src/Language/PureScript/Errors.hs+12 src/Language/PureScript/Linter/Imports.hs+37−6
src/Language/PureScript/Errors.hs+12
@@ -139,6 +139,8 @@ data SimpleErrorMessage
139139 | ImportHidingModule ModuleName
140140 | UnusedImport ModuleName
141141 | UnusedExplicitImport ModuleName [String]
142+ | UnusedDctorImport ProperName
143+ | UnusedDctorExplicitImport ProperName [ProperName]
142144 deriving (Show)
143145
144146-- | Error message hints, providing more detailed information about failure.
@@ -271,6 +273,9 @@ errorCode em = case unwrapErrorMessage em of
271273 ImportHidingModule{} -> "ImportHidingModule"
272274 UnusedImport{} -> "UnusedImport"
273275 UnusedExplicitImport{} -> "UnusedExplicitImport"
276+ UnusedDctorImport{} -> "UnusedDctorImport"
277+ UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"
278+
274279
275280-- |
276281-- A stack trace for an error
@@ -680,6 +685,13 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
680685 paras [ line $ "The import of module " ++ runModuleName name ++ " contains the following unused references:"
681686 , indent $ paras $ map line names ]
682687
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+
683695 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box
684696 renderHint (ErrorUnifyingTypes t1 t2) detail =
685697 paras [ detail
src/Language/PureScript/Linter/Imports.hs+37−6
@@ -8,7 +8,7 @@ import Prelude.Compat
88
99import qualified Data.Map as M
1010import Data.Maybe (mapMaybe)
11−import Data.List ((\\), find)
11+import Data.List ((\\), find, intersect)
1212import Control.Monad.Error.Class (MonadError(..))
1313import Control.Monad.Writer.Class
1414import Control.Monad(unless,when)
@@ -40,8 +40,10 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do
4040 forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` alwaysUsedModules) $
4141 forM_ decls $ \(ss, declType, qualifierName) ->
4242 censor (onErrorMessages $ addModuleLocError ss) $ unless (qnameUsed qualifierName) $
43− let usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) $ sugarNames mni ++ M.findWithDefault [] mni usedImps in
44− case declType of
43+ let names = sugarNames mni ++ M.findWithDefault [] mni usedImps
44+ usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) names
45+ usedDctors = mapMaybe (matchDctor qualifierName) names
46+ in case declType of
4547 Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni
4648 Explicit declrefs -> do
4749 let idents = mapMaybe runDeclRef declrefs
@@ -50,6 +52,17 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do
5052 (0, _) -> return ()
5153 (n, m) | n == m -> tell $ errorMessage $ UnusedImport mni
5254 _ -> 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+ (_, True) -> tell $ errorMessage $ UnusedDctorImport tn
61+ (Just ctors, False) -> let ddiff = ctors \\ usedDctors
62+ in unless (null ddiff) $ tell $ errorMessage $ UnusedDctorExplicitImport tn ddiff
63+ _ -> return ()
64+ return ()
65+
5366 _ -> return ()
5467 where
5568 sugarNames :: ModuleName -> [ Name ]
@@ -67,14 +80,23 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do
6780 qnameUsed (Just qn) = qn `elem` alwaysUsedModules
6881 qnameUsed Nothing = False
6982
83+ dtys :: ModuleName -> [((ProperName, [ProperName]), ModuleName)]
84+ dtys mn = maybe [] exportedTypes $ envModuleExports <$> mn `M.lookup` env
85+
86+ dctorsForType :: ModuleName -> ProperName -> [ProperName]
87+ dctorsForType mn tn =
88+ maybe [] getDctors (find matches $ dtys mn)
89+ where
90+ matches ((ty, _),_) = ty == tn
91+ getDctors ((_,ctors),_) = ctors
92+
7093 typeForDCtor :: ModuleName -> ProperName -> Maybe ProperName
7194 typeForDCtor mn pn =
72− getTy <$> find matches tys
95+ getTy <$> find matches (dtys mn)
7396 where
7497 matches ((_, ctors), _) = pn `elem` ctors
7598 getTy ((ty, _), _) = ty
76− tys :: [((ProperName, [ProperName]), ModuleName)]
77− tys = maybe [] exportedTypes $ envModuleExports <$> mn `M.lookup` env
99+
78100
79101matchName :: (ProperName -> Maybe ProperName) -> Maybe ModuleName -> Name -> Maybe String
80102matchName _ qual (IdentName (Qualified q x)) | q == qual = Just $ showIdent x
@@ -82,12 +104,21 @@ matchName _ qual (IsProperName (Qualified q x)) | q == qual = Just $ runProperNa
82104matchName lookupDc qual (DctorName (Qualified q x)) | q == qual = runProperName <$> lookupDc x
83105matchName _ _ _ = Nothing
84106
107+matchDctor :: Maybe ModuleName -> Name -> Maybe ProperName
108+matchDctor qual (DctorName (Qualified q x)) | q == qual = Just x
109+matchDctor _ _ = Nothing
110+
85111runDeclRef :: DeclarationRef -> Maybe String
86112runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref
87113runDeclRef (ValueRef ident) = Just $ showIdent ident
88114runDeclRef (TypeRef pn _) = Just $ runProperName pn
89115runDeclRef _ = Nothing
90116
117+getTypeRef :: DeclarationRef -> Maybe (ProperName, Maybe [ProperName])
118+getTypeRef (PositionedDeclarationRef _ _ ref) = getTypeRef ref
119+getTypeRef (TypeRef pn x) = Just (pn, x)
120+getTypeRef _ = Nothing
121+
91122addModuleLocError :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
92123addModuleLocError sp err =
93124 case sp of