5a61b93 · rowtype-yoga/purescript-native

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

Improve errors for invalid newtype declarations

commit5a61b9394df6ea6ec19cd6626ddee478f3ae2f02 authorGary Burgess <gary.burgess@gmail.com> dateSat 26 Jul 2014, 18:27 (12 years ago) parentc3b56cf

3 files changed+8−15

compare with golang

unifiedsplit

examples/failing/NewtypeMultiParams.purs−3 src/Language/PureScript/Parser/Declarations.hs+2−12 src/Language/PureScript/TypeChecker.hs+6

examples/failing/NewtypeMultiParams.pursdeleted−3

@@ -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

4848

4949parseDataDeclaration :: P.Parsec String ParseState Declaration

5050parseDataDeclaration = do

51− reserved "data"

51+ dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)

5252 name <- indented *> properName

5353 tyArgs <- many (indented *> identifier)

5454 ctors <- P.option [] $ do

5555 _ <- lexeme $ indented *> P.char '='

5656 sepBy1 ((,) <$> properName <*> P.many (indented *> parseTypeAtom)) pipe

57− return $ DataDeclaration Data 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]

57+ return $ DataDeclaration dtype name tyArgs ctors

6758

6859parseTypeDeclaration :: P.Parsec String ParseState Declaration

6960parseTypeDeclaration =

@@ -190,7 +181,6 @@ positioned d = PositionedDeclaration <$> sourcePos <*> d

190181parseDeclaration :: P.Parsec String ParseState Declaration

191182parseDeclaration = positioned (P.choice

192183 [ parseDataDeclaration

193− , parseNewtypeDeclaration

194184 , parseTypeDeclaration

195185 , parseTypeSynonymDeclaration

196186 , parseValueDeclaration

src/Language/PureScript/TypeChecker.hs+6

@@ -113,10 +113,16 @@ typeCheckAll :: Maybe ModuleName -> ModuleName -> [Declaration] -> Check [Declar

113113typeCheckAll _ _ [] = return []

114114typeCheckAll mainModuleName moduleName (d@(DataDeclaration dtype name args dctors) : rest) = do

115115 rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do

116+ when (dtype == Newtype) $ checkNewtype dctors

116117 ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)

117118 addDataType moduleName dtype name args dctors ctorKind

118119 ds <- typeCheckAll mainModuleName moduleName rest

119120 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"

120126typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do

121127 rethrow (strMsg "Error in data binding group" <>) $ do

122128 let syns = mapMaybe toTypeSynonym tys