git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Type constructors mark their type used. Show operators properly
9314ff8Nicholas Wolverson
src/Language/PureScript/Linter/Imports.hs+20−10
@@ -6,7 +6,7 @@ module Language.PureScript.Linter.Imports (findUnusedImports, Name(..), UsedImpo
6
6
7import qualified Data.Map as M
7import qualified Data.Map as M
8import Data.Maybe (mapMaybe)
8import Data.Maybe (mapMaybe)
9−import Data.List ((\\))
9+import Data.List ((\\), find)
10import Control.Monad.Error.Class (MonadError(..))
10import Control.Monad.Error.Class (MonadError(..))
11import Control.Monad.Writer.Class
11import Control.Monad.Writer.Class
12import Control.Monad(unless,when)
12import Control.Monad(unless,when)
@@ -26,7 +26,7 @@ import Language.PureScript.Sugar.Names.Imports
26import qualified Language.PureScript.Constants as C
26import qualified Language.PureScript.Constants as C
27
27
28-- | Imported name used in some type or expression.
28-- | Imported name used in some type or expression.
29−data Name = IdentName (Qualified Ident) | IsProperName (Qualified ProperName)
29+data Name = IdentName (Qualified Ident) | IsProperName (Qualified ProperName) | DctorName (Qualified ProperName)
30
30
31-- | Map of module name to list of imported names from that module which have been used.
31-- | Map of module name to list of imported names from that module which have been used.
32type UsedImports = M.Map ModuleName [Name]
32type UsedImports = M.Map ModuleName [Name]
@@ -35,12 +35,12 @@ type UsedImports = M.Map ModuleName [Name]
35-- Find and warn on any unused import statements (qualified or unqualified)
35-- Find and warn on any unused import statements (qualified or unqualified)
36-- or references in an explicit import list.
36-- or references in an explicit import list.
37--
37--
38−findUnusedImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Module -> Imports -> UsedImports -> m ()
38+findUnusedImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Module -> Env -> UsedImports -> m ()
39−findUnusedImports (Module _ _ _ mdecls _) _ usedImps = do
39+findUnusedImports (Module _ _ _ mdecls _) env usedImps = do
40 imps <- findImports mdecls
40 imps <- findImports mdecls
41 forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` autoIncludes) $
41 forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` autoIncludes) $
42 forM_ decls $ \(ss, declType, qualifierName) -> censor (onErrorMessages $ addModuleLocError ss) $
42 forM_ decls $ \(ss, declType, qualifierName) -> censor (onErrorMessages $ addModuleLocError ss) $
43− let usedNames = mapMaybe (matchName qualifierName) $ sugarNames ++ M.findWithDefault [] mni usedImps in
43+ let usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) $ sugarNames ++ M.findWithDefault [] mni usedImps in
44 case declType of
44 case declType of
45 Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni
45 Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni
46 Explicit declrefs -> do
46 Explicit declrefs -> do
@@ -55,14 +55,24 @@ findUnusedImports (Module _ _ _ mdecls _) _ usedImps = do
55 autoIncludes :: [ ModuleName ]
55 autoIncludes :: [ ModuleName ]
56 autoIncludes = [ ModuleName [ProperName C.prim] ]
56 autoIncludes = [ ModuleName [ProperName C.prim] ]
57
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+
58−matchName :: Maybe ModuleName -> Name -> Maybe String
67+matchName :: (ProperName -> Maybe ProperName) -> Maybe ModuleName -> Name -> Maybe String
59−matchName qual (IdentName (Qualified q x)) | q == qual = Just $ runIdent x
68+matchName _ qual (IdentName (Qualified q x)) | q == qual = Just $ showIdent x
60−matchName qual (IsProperName (Qualified q x)) | q == qual = Just $ runProperName 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
61−matchName _ _ = Nothing
71+matchName _ _ _ = Nothing
62
72
63runDeclRef :: DeclarationRef -> Maybe String
73runDeclRef :: DeclarationRef -> Maybe String
64runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref
74runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref
65−runDeclRef (ValueRef ident) = Just $ runIdent ident
75+runDeclRef (ValueRef ident) = Just $ showIdent ident
66runDeclRef (TypeRef pn _) = Just $ runProperName pn
76runDeclRef (TypeRef pn _) = Just $ runProperName pn
67runDeclRef _ = Nothing
77runDeclRef _ = Nothing
68
78
src/Language/PureScript/Sugar/Names.hs+2−2
@@ -108,7 +108,7 @@ desugarImports externs modules = do
108 warnAndRethrow (addHint (ErrorInModule mn)) $ do
108 warnAndRethrow (addHint (ErrorInModule mn)) $ do
109 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
110 (m', used) <- flip runStateT M.empty $ renameInModule env imps (elaborateExports exps m)
110 (m', used) <- flip runStateT M.empty $ renameInModule env imps (elaborateExports exps m)
111− findUnusedImports m imps used
111+ findUnusedImports m env used
112 return $ elaborateImports imps m'
112 return $ elaborateImports imps m'
113
113
114-- |
114-- |
@@ -231,7 +231,7 @@ renameInModule env imports (Module ss coms mn decls exps) =
231 updateTypeName = update UnknownType (importedTypes imports) (resolveType . exportedTypes) IsProperName
231 updateTypeName = update UnknownType (importedTypes imports) (resolveType . exportedTypes) IsProperName
232
232
233 updateDataConstructorName :: Qualified ProperName -> Maybe SourceSpan -> m (Qualified ProperName)
233 updateDataConstructorName :: Qualified ProperName -> Maybe SourceSpan -> m (Qualified ProperName)
234− updateDataConstructorName = update (flip UnknownDataConstructor Nothing) (importedDataConstructors imports) (resolveDctor . exportedTypes) IsProperName
234+ updateDataConstructorName = update (flip UnknownDataConstructor Nothing) (importedDataConstructors imports) (resolveDctor . exportedTypes) DctorName
235
235
236 updateClassName :: Qualified ProperName -> Maybe SourceSpan -> m (Qualified ProperName)
236 updateClassName :: Qualified ProperName -> Maybe SourceSpan -> m (Qualified ProperName)
237 updateClassName = update UnknownTypeClass (importedTypeClasses imports) (resolve . exportedTypeClasses) IsProperName
237 updateClassName = update UnknownTypeClass (importedTypeClasses imports) (resolve . exportedTypeClasses) IsProperName