git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Improve errors for invalid newtype declarations
5a61b93Gary Burgess
examples/failing/NewtypeMultiParams.pursdeleted−3
compare with golang
unifiedsplit
@@ -1,3 +0,0 @@
1−module Main where
2−
3−newtype Thing a b = Thing a b
src/Language/PureScript/Parser/Declarations.hs+2−12
@@ -48,22 +48,13 @@ sourcePos = toSourcePos <$> P.getPosition
48
48
49parseDataDeclaration :: P.Parsec String ParseState Declaration
49parseDataDeclaration :: P.Parsec String ParseState Declaration
50parseDataDeclaration = do
50parseDataDeclaration = do
51− reserved "data"
51+ dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)
52 name <- indented *> properName
52 name <- indented *> properName
53 tyArgs <- many (indented *> identifier)
53 tyArgs <- many (indented *> identifier)
54 ctors <- P.option [] $ do
54 ctors <- P.option [] $ do
55 _ <- lexeme $ indented *> P.char '='
55 _ <- lexeme $ indented *> P.char '='
56 sepBy1 ((,) <$> properName <*> P.many (indented *> parseTypeAtom)) pipe
56 sepBy1 ((,) <$> properName <*> P.many (indented *> parseTypeAtom)) pipe
57− return $ DataDeclaration Data name tyArgs ctors
57+ return $ DataDeclaration dtype name tyArgs ctors
58−
59−parseNewtypeDeclaration :: P.Parsec String ParseState Declaration
60−parseNewtypeDeclaration = do
61− reserved "newtype"
62− name <- indented *> properName
63− tyArg <- P.option [] $ return <$> (indented *> identifier)
64− _ <- lexeme $ indented *> P.char '='
65− ctor <- (,) <$> properName <*> (return <$> (indented *> parseTypeAtom))
66− return $ DataDeclaration Newtype name tyArg [ctor]
67
58
68parseTypeDeclaration :: P.Parsec String ParseState Declaration
59parseTypeDeclaration :: P.Parsec String ParseState Declaration
69parseTypeDeclaration =
60parseTypeDeclaration =
@@ -190,7 +181,6 @@ positioned d = PositionedDeclaration <$> sourcePos <*> d
190parseDeclaration :: P.Parsec String ParseState Declaration
181parseDeclaration :: P.Parsec String ParseState Declaration
191parseDeclaration = positioned (P.choice
182parseDeclaration = positioned (P.choice
192 [ parseDataDeclaration
183 [ parseDataDeclaration
193− , parseNewtypeDeclaration
194 , parseTypeDeclaration
184 , parseTypeDeclaration
195 , parseTypeSynonymDeclaration
185 , parseTypeSynonymDeclaration
196 , parseValueDeclaration
186 , parseValueDeclaration
src/Language/PureScript/TypeChecker.hs+6
@@ -113,10 +113,16 @@ typeCheckAll :: Maybe ModuleName -> ModuleName -> [Declaration] -> Check [Declar
113typeCheckAll _ _ [] = return []
113typeCheckAll _ _ [] = return []
114typeCheckAll mainModuleName moduleName (d@(DataDeclaration dtype name args dctors) : rest) = do
114typeCheckAll mainModuleName moduleName (d@(DataDeclaration dtype name args dctors) : rest) = do
115 rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do
115 rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do
116+ when (dtype == Newtype) $ checkNewtype dctors
116 ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)
117 ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)
117 addDataType moduleName dtype name args dctors ctorKind
118 addDataType moduleName dtype name args dctors ctorKind
118 ds <- typeCheckAll mainModuleName moduleName rest
119 ds <- typeCheckAll mainModuleName moduleName rest
119 return $ d : ds
120 return $ d : ds
121+ where
122+ checkNewtype :: [(ProperName, [Type])] -> Check ()
123+ checkNewtype [(_, [ty])] = return ()
124+ checkNewtype [(_, _)] = throwError . strMsg $ "newtypes constructors must have a single argument"
125+ checkNewtype _ = throwError . strMsg $ "newtypes must have a single constructor"
120typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
126typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
121 rethrow (strMsg "Error in data binding group" <>) $ do
127 rethrow (strMsg "Error in data binding group" <>) $ do
122 let syns = mapMaybe toTypeSynonym tys
128 let syns = mapMaybe toTypeSynonym tys