6a894b4 · rowtype-yoga/purescript-native

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

on golang help sign in

Warn on unused data constructors

6a894b4Nicholas Wolverson11 years ago

src/Language/PureScript/Errors.hs+12

compare with golang

unifiedsplit

@@ -139,6 +139,8 @@ data SimpleErrorMessage

139 | ImportHidingModule ModuleName

140 | UnusedImport ModuleName

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+37−6

@@ -8,7 +8,7 @@ import Prelude.Compat

9import qualified Data.Map as M

10import Data.Maybe (mapMaybe)

11−import Data.List ((\\), find)

11+import Data.List ((\\), find, intersect)

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

13import Control.Monad.Writer.Class

14import Control.Monad(unless,when)

@@ -40,8 +40,10 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

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

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

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

43− let usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) $ sugarNames mni ++ 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

44− case declType of

46+ in case declType of

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

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

46 Explicit declrefs -> do

48 Explicit declrefs -> do

47 let idents = mapMaybe runDeclRef declrefs

49 let idents = mapMaybe runDeclRef declrefs

@@ -50,6 +52,17 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

50 (0, _) -> return ()

52 (0, _) -> return ()

51 (n, m) | n == m -> tell $ errorMessage $ UnusedImport mni

53 (n, m) | n == m -> tell $ errorMessage $ UnusedImport mni

52 _ -> 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+ (_, 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+

53 _ -> return ()

66 _ -> return ()

54 where

67 where

55 sugarNames :: ModuleName -> [ Name ]

68 sugarNames :: ModuleName -> [ Name ]

@@ -67,14 +80,23 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

67 qnameUsed (Just qn) = qn `elem` alwaysUsedModules

80 qnameUsed (Just qn) = qn `elem` alwaysUsedModules

68 qnameUsed Nothing = False

81 qnameUsed Nothing = False

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+

70 typeForDCtor :: ModuleName -> ProperName -> Maybe ProperName

93 typeForDCtor :: ModuleName -> ProperName -> Maybe ProperName

71 typeForDCtor mn pn =

94 typeForDCtor mn pn =

72− getTy <$> find matches tys

95+ getTy <$> find matches (dtys mn)

73 where

96 where

74 matches ((_, ctors), _) = pn `elem` ctors

97 matches ((_, ctors), _) = pn `elem` ctors

75 getTy ((ty, _), _) = ty

98 getTy ((ty, _), _) = ty

76− tys :: [((ProperName, [ProperName]), ModuleName)]

99+

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

100

79matchName :: (ProperName -> Maybe ProperName) -> Maybe ModuleName -> Name -> Maybe String

101matchName :: (ProperName -> Maybe ProperName) -> Maybe ModuleName -> Name -> Maybe String

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

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

@@ -82,12 +104,21 @@ matchName _ qual (IsProperName (Qualified q x)) | q == qual = Just $ runProperNa

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

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

83matchName _ _ _ = Nothing

105matchName _ _ _ = Nothing

106

107+matchDctor :: Maybe ModuleName -> Name -> Maybe ProperName

108+matchDctor qual (DctorName (Qualified q x)) | q == qual = Just x

109+matchDctor _ _ = Nothing

110+

85runDeclRef :: DeclarationRef -> Maybe String

111runDeclRef :: DeclarationRef -> Maybe String

86runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref

112runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref

87runDeclRef (ValueRef ident) = Just $ showIdent ident

113runDeclRef (ValueRef ident) = Just $ showIdent ident

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

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

89runDeclRef _ = Nothing

115runDeclRef _ = Nothing

116

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+

91addModuleLocError :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage

122addModuleLocError :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage

92addModuleLocError sp err =

123addModuleLocError sp err =

93 case sp of

124 case sp of