Skip to content

Warn for type constructor aliases w/ suggestions #2932

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
justinwoo wants to merge 1 commit into from
Closed

Warn for type constructor aliases w/ suggestions #2932

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions examples/warning/TypeConstructorAlias.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
-- @shouldWarnWith TypeConstructorAlias
module Main where

type TypeConstructorAlias = String
1 change: 1 addition & 0 deletions purescript.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -616,6 +616,7 @@ extra-source-files:
examples/warning/ShadowedBinderPatternGuard.purs
examples/warning/ShadowedNameParens.purs
examples/warning/ShadowedTypeVar.purs
examples/warning/TypeConstructorAlias.purs
examples/warning/UnnecessaryFFIModule.js
examples/warning/UnnecessaryFFIModule.purs
examples/warning/UnusedDctorExplicitImport.purs
Expand Down
1 change: 1 addition & 0 deletions src/Language/PureScript/AST/Declarations.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -70,6 +70,7 @@ data SimpleErrorMessage
| CannotGetFileInfo FilePath
| CannotReadFile FilePath
| CannotWriteFile FilePath
| TypeConstructorAlias (ProperName 'TypeName) [(Text, Maybe Kind)] Type
| InfiniteType Type
| InfiniteKind Kind
| MultipleValueOpFixities (OpName 'ValueOpName)
Expand Down
4 changes: 4 additions & 0 deletions src/Language/PureScript/Errors.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -84,6 +84,7 @@ errorCode em = case unwrapErrorMessage em of
CannotGetFileInfo{} -> "CannotGetFileInfo"
CannotReadFile{} -> "CannotReadFile"
CannotWriteFile{} -> "CannotWriteFile"
TypeConstructorAlias{} -> "TypeConstructorAlias"

@paf31 paf31 Jun 11, 2017

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

After this is merged, can you please add docs to the docs repo for this error too?

@justinwoo justinwoo Jun 12, 2017

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, definitely needs some docs

InfiniteType{} -> "InfiniteType"
InfiniteKind{} -> "InfiniteKind"
MultipleValueOpFixities{} -> "MultipleValueOpFixities"
Expand Down Expand Up @@ -304,6 +305,7 @@ errorSuggestion err =
HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing
MissingTypeDeclaration ident ty -> suggest $ showIdent ident <> " :: " <> T.pack (prettyPrintSuggestedType ty)
WildcardInferredType ty _ -> suggest $ T.pack (prettyPrintSuggestedType ty)
TypeConstructorAlias name args ty -> suggest $ T.pack (prettyPrintNewtypeForType name args ty)
_ -> Nothing
where
emptySuggestion = Just $ ErrorSuggestion ""
Expand Down Expand Up @@ -481,6 +483,8 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
line "The last statement in a 'do' block must be an expression, but this block ends with a let binding."
renderSimpleErrorMessage OverlappingNamesInLet =
line "The same name was used more than once in a let binding."
renderSimpleErrorMessage (TypeConstructorAlias _ _ _) =
line "This type synonym aliases a type constructor. Consider using a newtype or using the original type instead."
renderSimpleErrorMessage (InfiniteType ty) =
paras [ line "An infinite type was inferred for an expression: "
, markCodeBox $ indent $ typeAsBox ty
Expand Down
12 changes: 12 additions & 0 deletions src/Language/PureScript/Pretty/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ module Language.PureScript.Pretty.Types
, prettyPrintType
, prettyPrintTypeWithUnicode
, prettyPrintSuggestedType
, prettyPrintNewtypeForType
, typeAtomAsBox
, prettyPrintTypeAtom
, prettyPrintRow
Expand Down Expand Up @@ -218,6 +219,17 @@ prettyPrintTypeWithUnicode = prettyPrintType' unicodeOptions
prettyPrintSuggestedType :: Type -> String
prettyPrintSuggestedType = prettyPrintType' suggestingOptions

-- | Generate a pretty-printed string newtype
prettyPrintNewtypeForType :: ProperName 'TypeName -> [(Text, Maybe Kind)] -> Type -> String
prettyPrintNewtypeForType (ProperName name) args ty =
"newtype " ++ name' ++ args' ++ " = " ++ name' ++ " " ++ ctr
where
name' = T.unpack name
args' = (" " ++) . T.unpack . fst =<< args
ctr = case ty of
TypeConstructor (Qualified _ (ProperName tn)) -> T.unpack tn
_ -> error "Type constructor was expected here."

prettyPrintType' :: TypeRenderOptions -> Type -> String
prettyPrintType' tro = render . typeAsBoxImpl tro

Expand Down
11 changes: 11 additions & 0 deletions src/Language/PureScript/TypeChecker.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -163,6 +163,16 @@ addTypeClassDictionaries mn entries =
modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = insertState st } }
where insertState st = M.insertWith (M.unionWith M.union) mn entries (typeClassDictionaries . checkEnv $ st)

checkTypeConstructorAlias
:: (MonadState CheckState m, MonadWriter MultipleErrors m)
=> ProperName 'TypeName
-> [(Text, Maybe Kind)]
-> Type
-> m ()
checkTypeConstructorAlias name args ty@(TypeConstructor _) = do
tell . errorMessage $ TypeConstructorAlias name args ty
checkTypeConstructorAlias _ _ _ = return ()

checkDuplicateTypeArguments
:: (MonadState CheckState m, MonadError MultipleErrors m)
=> [Text]
Expand Down Expand Up @@ -262,6 +272,7 @@ typeCheckAll moduleName _ = traverse go
toDataDecl _ = Nothing
go (TypeSynonymDeclaration name args ty) = do
warnAndRethrow (addHint (ErrorInTypeSynonym name)) $ do
checkTypeConstructorAlias name args ty
checkDuplicateTypeArguments $ map fst args
kind <- kindsOf False moduleName name args [ty]
let args' = args `withKinds` kind
Expand Down