Assign equality constraints

src/Language/Haskell/Assignment.hs

@@ -45,6 +45,7 @@ type Syntax = '[
   , Syntax.Deriving
   , Syntax.Empty
   , Syntax.Error
+  , Syntax.EqualityConstraint
   , Syntax.Export
   , Syntax.Field
   , Syntax.FunctionConstructor
@@ -128,10 +129,10 @@ constructorSymbol :: Assignment
 constructorSymbol = makeTerm <$> symbol ConstructorSymbol <*> (Syntax.Identifier . Name.name <$> source)
 
 context' :: Assignment
-context' = makeTerm <$> symbol Context <*> children (Syntax.Context' <$> manyTerm (type' <|> contextPattern))
+context' = makeTerm <$> symbol Context <*> children (Syntax.Context' <$> manyTerm expression)
 
 contextPattern :: Assignment
-contextPattern = symbol ContextPattern *> children type'
+contextPattern = makeTerm <$> symbol ContextPattern <*> children (manyTerm expression)
 
 defaultDeclaration :: Assignment
 defaultDeclaration = makeTerm <$> symbol DefaultDeclaration <*> children (Syntax.DefaultDeclaration <$> manyTerm expression)
@@ -139,6 +140,12 @@ defaultDeclaration = makeTerm <$> symbol DefaultDeclaration <*> children (Syntax
 derivingClause :: Assignment
 derivingClause = makeTerm <$> symbol Deriving <*> children (Syntax.Deriving <$> manyTerm typeConstructor)
 
+equalityConstraint :: Assignment
+equalityConstraint = makeTerm <$> symbol EqualityConstraint <*> children (Syntax.EqualityConstraint <$> equalityLhs <*> equalityRhs)
+  where
+    equalityLhs = symbol EqualityLhs *> children expression
+    equalityRhs = symbol EqualityRhs *> children expression
+
 export :: Assignment
 export = makeTerm <$> symbol Export <*> children (Syntax.Export <$> expressions)
 
@@ -156,11 +163,13 @@ expressionChoices = [
                     , character
                     , comment
                     , context'
+                    , contextPattern
                     , constructorIdentifier
                     , constructorOperator
                     , constructorSymbol
                     , defaultDeclaration
                     , derivingClause
+                    , equalityConstraint
                     , float
                     , functionConstructor
                     , functionDeclaration

src/Language/Haskell/Syntax.hs

@@ -361,3 +361,13 @@ instance Ord1 DefaultDeclaration where liftCompare = genericLiftCompare
 instance Show1 DefaultDeclaration where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable DefaultDeclaration
+
+data EqualityConstraint a = EqualityConstraint { equalityConstraintLeft :: a, equalityConstraintRight :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 EqualityConstraint where liftEq = genericLiftEq
+instance Ord1 EqualityConstraint where liftCompare = genericLiftCompare
+instance Show1 EqualityConstraint where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable EqualityConstraint
+

test/fixtures/haskell/corpus/type-signatures.A.hs

@@ -1,3 +1,12 @@
 bar :: a -> b -> c -> Int -> Maybe Int
 bar :: a -> b -> c -> [Int] -> Maybe Int
 factorial :: Num a => Show a => a -> a
+
+f :: Ex -> Ex
+f :: [Int] -> Int
+f :: (Int, Int) -> Maybe Int
+f :: a -> B c (D (E g ': h)) -> I [J k] (L m (N (O p ': q)))
+
+f :: forall a. [a] -> [a]
+f :: forall a b. (a, b) -> [a]
+apply :: proxy c -> (forall g . c g => g a -> b) -> Union fs a -> b

test/fixtures/haskell/corpus/type-signatures.B.hs

@@ -1,2 +1,11 @@
 foo :: a -> b -> c -> Int -> Maybe Int
 factorial :: Num a => a -> a
+
+g :: Ex -> Foo
+g :: [Double] -> Int
+g :: (Double, Int) -> Maybe Double
+g :: b -> B a (D (E g ': h)) -> I [J k] (L m (O (N p ': q)))
+
+g :: forall a. [a] -> [a]
+g :: forall a b. (a, b) -> [a]
+apply :: proxy d -> (forall g . d g => g a -> b) -> Union fs a -> b