Improve error when using old-style context (#2773)

src/Language/PureScript/Parser/Types.hs

@@ -9,6 +9,7 @@ import Prelude.Compat
 
 import Control.Monad (when, unless)
 import Control.Applicative ((<|>))
+import Data.Functor (($>))
 import qualified Data.Text as T
 
 import Language.PureScript.AST.SourcePos
@@ -68,28 +69,48 @@ parseTypeAtom = indented *> P.choice
             , ParensInType <$> parens parsePolyType
             ]
 
-parseConstrainedType :: TokenParser Type
+parseConstrainedType :: TokenParser ([Constraint], Type)
 parseConstrainedType = do
-  constraint <- parens parseConstraint <|> parseConstraint
+  constraints <- parens (commaSep1 parseConstraint) <|> pure <$> parseConstraint
   _ <- rfatArrow
   indented
   ty <- parseType
-  return $ ConstrainedType constraint ty
+  return (constraints, ty)
   where
   parseConstraint = do
     className <- parseQualified properName
     indented
     ty <- P.many parseTypeAtom
     return (Constraint className ty Nothing)
 
+-- This is here to improve the error message when the user
+-- tries to use the old style constraint contexts.
+-- TODO: Remove this before 1.0
+typeOrConstrainedType :: TokenParser Type
+typeOrConstrainedType = do
+  e <- P.try (Left <$> parseConstrainedType) <|> Right <$> parseTypeAtom
+  case e of
+    Left ([c], ty) -> pure (ConstrainedType c ty)
+    Left _ ->
+      P.unexpected $
+        unlines [ "comma in constraints."
+                , ""
+                , "Class constraints in type annotations can no longer be grouped in parentheses."
+                , "Each constraint should now be separated by `=>`, for example:"
+                , "    `(Applicative f, Semigroup a) => a -> f a -> f a`"
+                , "  would now be written as:"
+                , "    `Applicative f => Semigroup a => a -> f a -> f a`."
+                ]
+    Right ty -> pure ty
+
 parseAnyType :: TokenParser Type
-parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable (P.try parseConstrainedType <|> parseTypeAtom)) P.<?> "type"
+parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable typeOrConstrainedType) P.<?> "type"
   where
   operators = [ [ P.Infix (return TypeApp) P.AssocLeft ]
               , [ P.Infix (P.try (parseQualified parseOperator) >>= \ident ->
                     return (BinaryNoParensType (TypeOp ident))) P.AssocRight
                 ]
-              , [ P.Infix (rarrow *> return function) P.AssocRight ]
+              , [ P.Infix (rarrow $> function) P.AssocRight ]
               ]
   postfixTable = [ \t -> KindedType t <$> (indented *> doubleColon *> parseKind)
                  ]