Skip to content

Commit 9314ff8

Browse files
nwolversonnwolverson
committed
Type constructors mark their type used. Show operators properly
1 parent 47c0ffb commit 9314ff8

2 files changed

Lines changed: 22 additions & 12 deletions

File tree

‎src/Language/PureScript/Linter/Imports.hs‎

Lines changed: 20 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ module Language.PureScript.Linter.Imports (findUnusedImports, Name(..), UsedImpo
66

77
import qualified Data.Map as M
88
import Data.Maybe (mapMaybe)
9-
import Data.List ((\\))
9+
import Data.List ((\\), find)
1010
import Control.Monad.Error.Class (MonadError(..))
1111
import Control.Monad.Writer.Class
1212
import Control.Monad(unless,when)
@@ -26,7 +26,7 @@ import Language.PureScript.Sugar.Names.Imports
2626
import qualified Language.PureScript.Constants as C
2727

2828
-- | 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)
3030

3131
-- | Map of module name to list of imported names from that module which have been used.
3232
type UsedImports = M.Map ModuleName [Name]
@@ -35,12 +35,12 @@ type UsedImports = M.Map ModuleName [Name]
3535
-- Find and warn on any unused import statements (qualified or unqualified)
3636
-- or references in an explicit import list.
3737
--
38-
findUnusedImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Module -> Imports -> UsedImports -> m ()
39-
findUnusedImports (Module _ _ _ mdecls _) _ usedImps = do
38+
findUnusedImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Module -> Env -> UsedImports -> m ()
39+
findUnusedImports (Module _ _ _ mdecls _) env usedImps = do
4040
imps <- findImports mdecls
4141
forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` autoIncludes) $
4242
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
4444
case declType of
4545
Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni
4646
Explicit declrefs -> do
@@ -55,14 +55,24 @@ findUnusedImports (Module _ _ _ mdecls _) _ usedImps = do
5555
autoIncludes :: [ ModuleName ]
5656
autoIncludes = [ ModuleName [ProperName C.prim] ]
5757

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
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+
67+
matchName :: (ProperName -> Maybe ProperName) -> Maybe ModuleName -> Name -> Maybe String
68+
matchName _ qual (IdentName (Qualified q x)) | q == qual = Just $ showIdent 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
71+
matchName _ _ _ = Nothing
6272

6373
runDeclRef :: DeclarationRef -> Maybe String
6474
runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref
65-
runDeclRef (ValueRef ident) = Just $ runIdent ident
75+
runDeclRef (ValueRef ident) = Just $ showIdent ident
6676
runDeclRef (TypeRef pn _) = Just $ runProperName pn
6777
runDeclRef _ = Nothing
6878

‎src/Language/PureScript/Sugar/Names.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -108,7 +108,7 @@ desugarImports externs modules = do
108108
warnAndRethrow (addHint (ErrorInModule mn)) $ do
109109
let (_, imps, exps) = fromMaybe (internalError "Module is missing in renameInModule'") $ M.lookup mn env
110110
(m', used) <- flip runStateT M.empty $ renameInModule env imps (elaborateExports exps m)
111-
findUnusedImports m imps used
111+
findUnusedImports m env used
112112
return $ elaborateImports imps m'
113113

114114
-- |
@@ -231,7 +231,7 @@ renameInModule env imports (Module ss coms mn decls exps) =
231231
updateTypeName = update UnknownType (importedTypes imports) (resolveType . exportedTypes) IsProperName
232232

233233
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
235235

236236
updateClassName :: Qualified ProperName -> Maybe SourceSpan -> m (Qualified ProperName)
237237
updateClassName = update UnknownTypeClass (importedTypeClasses imports) (resolve . exportedTypeClasses) IsProperName

0 commit comments

Comments
 (0)