@@ -191,23 +191,19 @@ typeCheckAll moduleName _ ds = traverse go ds <* traverse_ checkFixities ds
191191 go :: Declaration -> m Declaration
192192 go (DataDeclaration dtype name args dctors) = do
193193 warnAndRethrow (addHint (ErrorInTypeConstructor name)) $ do
194− when (dtype == Newtype) $ checkNewtype dctors
194+ when (dtype == Newtype) $ checkNewtype name dctors
195195 checkDuplicateTypeArguments $ map fst args
196196 ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)
197197 let args' = args `withKinds` ctorKind
198198 addDataType moduleName dtype name args' dctors ctorKind
199199 return $ DataDeclaration dtype name args dctors
200− where
201− checkNewtype :: [(ProperName 'ConstructorName, [Type])] -> m ()
202− checkNewtype [(_, [_])] = return ()
203− checkNewtype [(_, _)] = throwError . errorMessage $ InvalidNewtype name
204− checkNewtype _ = throwError . errorMessage $ InvalidNewtype name
205200 go (d@(DataBindingGroupDeclaration tys)) = do
206201 warnAndRethrow (addHint ErrorInDataBindingGroup) $ do
207202 let syns = mapMaybe toTypeSynonym tys
208203 let dataDecls = mapMaybe toDataDecl tys
209204 (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(_, name, args, dctors) -> (name, args, concatMap snd dctors)) dataDecls)
210205 for_ (zip dataDecls data_ks) $ \((dtype, name, args, dctors), ctorKind) -> do
206+ when (dtype == Newtype) $ checkNewtype name dctors
211207 checkDuplicateTypeArguments $ map fst args
212208 let args' = args `withKinds` ctorKind
213209 addDataType moduleName dtype name args' dctors ctorKind
@@ -327,6 +323,10 @@ typeCheckAll moduleName _ ds = traverse go ds <* traverse_ checkFixities ds
327323 checkType _ = internalError "Invalid type in instance in checkOrphanInstance"
328324 checkOrphanInstance _ _ _ = internalError "Unqualified class name in checkOrphanInstance"
329325
326+ checkNewtype :: ProperName 'TypeName -> [(ProperName 'ConstructorName, [Type])] -> m ()
327+ checkNewtype _ [(_, [_])] = return ()
328+ checkNewtype name _ = throwError . errorMessage $ InvalidNewtype name
329+
330330 -- |
331331 -- This function adds the argument kinds for a type constructor so that they may appear in the externs file,
332332 -- extracted from the kind of the type constructor itself.