git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1703 from purescript/1669-constraint-parens
6457f30Gary Burgess
examples/passing/UntupledConstraints.pursnew file+17
compare with golang
unifiedsplit
@@ -0,0 +1,17 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console
5+
6+class Show a <= Nonsense a where
7+ method :: a -> a
8+
9+data Box a = Box a
10+
11+instance showBox :: Show a => Show (Box a) where
12+ show (Box a) = "Box " <> show a
13+
14+strangeThing :: forall m. Semigroup (m Unit) => m Unit -> m Unit -> m Unit
15+strangeThing x y = x <> y
16+
17+main = log "Done"
src/Language/PureScript/Parser/Declarations.hs+9−4
@@ -33,6 +33,7 @@ import Language.PureScript.Environment
33import Language.PureScript.Errors
33import Language.PureScript.Errors
34import Language.PureScript.Kinds
34import Language.PureScript.Kinds
35import Language.PureScript.Names
35import Language.PureScript.Names
36+import Language.PureScript.Types
36import Language.PureScript.Parser.Common
37import Language.PureScript.Parser.Common
37import Language.PureScript.Parser.Kinds
38import Language.PureScript.Parser.Kinds
38import Language.PureScript.Parser.Lexer
39import Language.PureScript.Parser.Lexer
@@ -174,9 +175,9 @@ parseDeclarationRef =
174parseTypeClassDeclaration :: TokenParser Declaration
175parseTypeClassDeclaration :: TokenParser Declaration
175parseTypeClassDeclaration = do
176parseTypeClassDeclaration = do
176 reserved "class"
177 reserved "class"
177− implies <- P.option [] $ do
178+ implies <- P.option [] $ P.try $ do
178 indented
179 indented
179− implies <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
180+ implies <- P.try (return <$> parseConstraint) <|> parens (commaSep1 parseConstraint)
180 lfatArrow
181 lfatArrow
181 return implies
182 return implies
182 className <- indented *> properName
183 className <- indented *> properName
@@ -185,13 +186,17 @@ parseTypeClassDeclaration = do
185 indented *> reserved "where"
186 indented *> reserved "where"
186 indented *> mark (P.many (same *> positioned parseTypeDeclaration))
187 indented *> mark (P.many (same *> positioned parseTypeDeclaration))
187 return $ TypeClassDeclaration className idents implies members
188 return $ TypeClassDeclaration className idents implies members
189+ where
190+
191+parseConstraint :: TokenParser Constraint
192+parseConstraint = (,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)
188
193
189parseInstanceDeclaration :: TokenParser (TypeInstanceBody -> Declaration)
194parseInstanceDeclaration :: TokenParser (TypeInstanceBody -> Declaration)
190parseInstanceDeclaration = do
195parseInstanceDeclaration = do
191 reserved "instance"
196 reserved "instance"
192 name <- parseIdent <* indented <* doubleColon
197 name <- parseIdent <* indented <* doubleColon
193− deps <- P.optionMaybe $ do
198+ deps <- P.optionMaybe $ P.try $ do
194− deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
199+ deps <- P.try (return <$> parseConstraint) <|> parens (commaSep1 parseConstraint)
195 indented
200 indented
196 rfatArrow
201 rfatArrow
197 return deps
202 return deps
src/Language/PureScript/Parser/Types.hs+10−22
@@ -1,18 +1,3 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Parser.Types
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Parsers for types
13−--
14−-----------------------------------------------------------------------------
15−
16module Language.PureScript.Parser.Types (
1module Language.PureScript.Parser.Types (
17 parseType,
2 parseType,
18 parsePolyType,
3 parsePolyType,
@@ -70,7 +55,8 @@ parseForAll = mkForAll <$> (P.try (reserved "forall") *> P.many1 (indented *> id
70--
55--
71parseTypeAtom :: TokenParser Type
56parseTypeAtom :: TokenParser Type
72parseTypeAtom = indented *> P.choice (map P.try
57parseTypeAtom = indented *> P.choice (map P.try
58+ [ parseConstrainedType
73− [ parseArray
59+ , parseArray
74 , parseArrayOf
60 , parseArrayOf
75 , parseFunction
61 , parseFunction
76 , parseObject
62 , parseObject
@@ -79,21 +65,23 @@ parseTypeAtom = indented *> P.choice (map P.try
79 , parseTypeConstructor
65 , parseTypeConstructor
80 , parseForAll
66 , parseForAll
81 , parens parseRow
67 , parens parseRow
82− , parseConstrainedType
83 , parens parsePolyType
68 , parens parsePolyType
84 ])
69 ])
85
70
86parseConstrainedType :: TokenParser Type
71parseConstrainedType :: TokenParser Type
87parseConstrainedType = do
72parseConstrainedType = do
88− constraints <- parens . commaSep1 $ do
73+ constraints <- P.try (return <$> parseConstraint) <|> parens (commaSep1 parseConstraint)
89− className <- parseQualified properName
90− indented
91− ty <- P.many parseTypeAtom
92− return (className, ty)
93 _ <- rfatArrow
74 _ <- rfatArrow
94 indented
75 indented
95 ty <- parseType
76 ty <- parseType
96 return $ ConstrainedType constraints ty
77 return $ ConstrainedType constraints ty
78+ where
79+ parseConstraint = do
80+ className <- parseQualified properName
81+ indented
82+ ty <- P.many parseTypeAtom
83+ return (className, ty)
84+
97
85
98parseAnyType :: TokenParser Type
86parseAnyType :: TokenParser Type
99parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable parseTypeAtom) P.<?> "type"
87parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable parseTypeAtom) P.<?> "type"