From 97c71544ea71124117a3ee3e286e488a370f50f2 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 5 Jun 2018 12:26:42 -0700 Subject: [PATCH] Assign GADT declarations without constructors --- src/Language/Haskell/Assignment.hs | 18 +- src/Language/Haskell/Syntax.hs | 9 + ...lgebraic-datatype-declarations.diffA-B.txt | 290 +++++++----------- ...lgebraic-datatype-declarations.diffB-A.txt | 277 ++++++----------- .../haskell/corpus/gadt-declarations.A.hs | 1 + .../haskell/corpus/gadt-declarations.B.hs | 1 + .../corpus/gadt-declarations.diffA-B.txt | 12 + .../corpus/gadt-declarations.diffB-A.txt | 12 + .../corpus/gadt-declarations.parseA.txt | 11 + .../corpus/gadt-declarations.parseB.txt | 11 + 10 files changed, 280 insertions(+), 362 deletions(-) create mode 100644 test/fixtures/haskell/corpus/gadt-declarations.A.hs create mode 100644 test/fixtures/haskell/corpus/gadt-declarations.B.hs create mode 100644 test/fixtures/haskell/corpus/gadt-declarations.diffA-B.txt create mode 100644 test/fixtures/haskell/corpus/gadt-declarations.diffB-A.txt create mode 100644 test/fixtures/haskell/corpus/gadt-declarations.parseA.txt create mode 100644 test/fixtures/haskell/corpus/gadt-declarations.parseB.txt diff --git a/src/Language/Haskell/Assignment.hs b/src/Language/Haskell/Assignment.hs index b15f1f716..cc24bc24f 100644 --- a/src/Language/Haskell/Assignment.hs +++ b/src/Language/Haskell/Assignment.hs @@ -41,6 +41,7 @@ type Syntax = '[ , Syntax.Error , Syntax.Field , Syntax.FunctionConstructor + , Syntax.GADT , Syntax.Identifier , Syntax.ListConstructor , Syntax.Module @@ -86,6 +87,7 @@ expressionChoices = [ , float , functionConstructor , functionDeclaration + , gadtDeclaration , integer , listConstructor , listExpression @@ -180,6 +182,16 @@ functionDeclaration = makeTerm <*> (manyTermsTill expression (symbol FunctionBody) <|> pure []) <*> functionBody) +gadtDeclaration :: Assignment +gadtDeclaration = makeTerm + <$> symbol GadtDeclaration + <*> children (Syntax.GADT + <$> (context' <|> emptyTerm) + <*> (makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParameters')) + <*> where') + where + typeParameters' = makeTerm <$> location <*> (manyTermsTill expression (symbol Where')) + integer :: Assignment integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source) @@ -203,8 +215,10 @@ parenthesizedTypePattern :: Assignment parenthesizedTypePattern = symbol ParenthesizedTypePattern *> children typeParameters strictType :: Assignment -strictType = makeTerm' <$> symbol StrictType <*> children ((inject <$> (Syntax.StrictType <$> typeConstructor <*> typeParameters)) - <|> (inject <$> (Syntax.StrictTypeVariable <$> typeVariableIdentifier))) +strictType = makeTerm' + <$> symbol StrictType + <*> children ( (inject <$> (Syntax.StrictType <$> typeConstructor <*> typeParameters)) + <|> (inject <$> (Syntax.StrictTypeVariable <$> typeVariableIdentifier))) tuplingConstructor :: Assignment tuplingConstructor = makeTerm <$> symbol TuplingConstructor <*> (tupleWithArity <$> rawSource) diff --git a/src/Language/Haskell/Syntax.hs b/src/Language/Haskell/Syntax.hs index 1459c0a36..a215a1041 100644 --- a/src/Language/Haskell/Syntax.hs +++ b/src/Language/Haskell/Syntax.hs @@ -144,3 +144,12 @@ instance Ord1 Class where liftCompare = genericLiftCompare instance Show1 Class where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Class + +data GADT a = GADT { gadtContext :: a, gadtName :: a, gadtConstructors :: a } + deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable) + +instance Eq1 GADT where liftEq = genericLiftEq +instance Ord1 GADT where liftCompare = genericLiftCompare +instance Show1 GADT where liftShowsPrec = genericLiftShowsPrec + +instance Evaluatable GADT diff --git a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt index ffee4ef04..5a1531a9a 100644 --- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt +++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt @@ -60,191 +60,113 @@ { (Identifier) ->(Identifier) } (TypeParameters)) - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Empty)) + (Datatype + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (RecordDataConstructor + { (Identifier) + ->(Identifier) } + (Statements + (Field + (Statements + (Identifier)) + (Identifier)))) + (Empty)) + (Datatype + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (RecordDataConstructor + { (Identifier) + ->(Identifier) } + (Statements + (Field + (Statements + (Identifier) + (Identifier)) + (Identifier)))) + (Empty)) + (Datatype + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (RecordDataConstructor + { (Identifier) + ->(Identifier) } + (Statements + (Field + (Statements + (Identifier)) + (StrictType + (Identifier) + (TypeParameters))) + (Field + (Statements + (Identifier)) + (Identifier)))) + (Empty)) + (Datatype + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (RecordDataConstructor + { (Identifier) + ->(Identifier) } + (Statements + (Field + (Statements + (Identifier) + (Identifier)) + (Context + (Pragma) + (StrictType + (Identifier) + (TypeParameters)))) + (Field + (Statements + (Identifier)) + (Identifier)))) (Empty)) - {+(Datatype - {+(Empty)+} - {+(Type - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(RecordDataConstructor - {+(Identifier)+} - {+(Statements - {+(Field - {+(Statements - {+(Identifier)+})+} - {+(Identifier)+})+})+})+} - {+(Empty)+})+} - {+(Datatype - {+(Empty)+} - {+(Type - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(RecordDataConstructor - {+(Identifier)+} - {+(Statements - {+(Field - {+(Statements - {+(Identifier)+} - {+(Identifier)+})+} - {+(Identifier)+})+})+})+} - {+(Empty)+})+} - {+(Datatype - {+(Empty)+} - {+(Type - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(RecordDataConstructor - {+(Identifier)+} - {+(Statements - {+(Field - {+(Statements - {+(Identifier)+})+} - {+(StrictType - {+(Identifier)+} - {+(TypeParameters)+})+})+} - {+(Field - {+(Statements - {+(Identifier)+})+} - {+(Identifier)+})+})+})+} - {+(Empty)+})+} - {+(Datatype - {+(Empty)+} - {+(Type - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(RecordDataConstructor - {+(Identifier)+} - {+(Statements - {+(Field - {+(Statements - {+(Identifier)+} - {+(Identifier)+})+} - {+(Context - {+(Pragma)+} - {+(StrictType - {+(Identifier)+} - {+(TypeParameters)+})+})+})+} - {+(Field - {+(Statements - {+(Identifier)+})+} - {+(Identifier)+})+})+})+} - {+(Empty)+})+} - {-(Datatype - {-(Empty)-} - {-(Type - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(RecordDataConstructor - {-(Identifier)-} - {-(Statements - {-(Field - {-(Statements - {-(Identifier)-})-} - {-(Identifier)-})-})-})-} - {-(Empty)-})-} - {-(Datatype - {-(Empty)-} - {-(Type - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(RecordDataConstructor - {-(Identifier)-} - {-(Statements - {-(Field - {-(Statements - {-(Identifier)-} - {-(Identifier)-})-} - {-(Identifier)-})-})-})-} - {-(Empty)-})-} - {-(Datatype - {-(Empty)-} - {-(Type - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(RecordDataConstructor - {-(Identifier)-} - {-(Statements - {-(Field - {-(Statements - {-(Identifier)-})-} - {-(StrictType - {-(Identifier)-} - {-(TypeParameters)-})-})-} - {-(Field - {-(Statements - {-(Identifier)-})-} - {-(Identifier)-})-})-})-} - {-(Empty)-})-} - {-(Datatype - {-(Empty)-} - {-(Type - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(RecordDataConstructor - {-(Identifier)-} - {-(Statements - {-(Field - {-(Statements - {-(Identifier)-} - {-(Identifier)-})-} - {-(Context - {-(Pragma)-} - {-(StrictType - {-(Identifier)-} - {-(TypeParameters)-})-})-})-} - {-(Field - {-(Statements - {-(Identifier)-})-} - {-(Identifier)-})-})-})-} - {-(Empty)-})-} {-(Datatype {-(Empty)-} {-(Type diff --git a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt index 2ea0e2b66..dc109a703 100644 --- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt +++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt @@ -60,120 +60,113 @@ { (Identifier) ->(Identifier) } (TypeParameters)) - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} (Constructor (Empty) { (Identifier) ->(Identifier) } (TypeParameters)) - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(Constructor - {+(Empty)+} - {+(Identifier)+} - {+(TypeParameters)+})+} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(Constructor - {-(Empty)-} - {-(Identifier)-} - {-(TypeParameters)-})-} + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Constructor + (Empty) + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (Empty)) + (Datatype + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (RecordDataConstructor + { (Identifier) + ->(Identifier) } + (Statements + (Field + (Statements + (Identifier)) + (Identifier)))) + (Empty)) + (Datatype + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (RecordDataConstructor + { (Identifier) + ->(Identifier) } + (Statements + (Field + (Statements + (Identifier) + (Identifier)) + (Identifier)))) + (Empty)) + (Datatype + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (RecordDataConstructor + { (Identifier) + ->(Identifier) } + (Statements + (Field + (Statements + (Identifier)) + (StrictType + (Identifier) + (TypeParameters))) + (Field + (Statements + (Identifier)) + (Identifier)))) + (Empty)) + (Datatype + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (TypeParameters)) + (RecordDataConstructor + { (Identifier) + ->(Identifier) } + (Statements + (Field + (Statements + (Identifier) + (Identifier)) + (Context + (Pragma) + (StrictType + (Identifier) + (TypeParameters)))) + (Field + (Statements + (Identifier)) + (Identifier)))) (Empty)) - {+(Datatype - {+(Empty)+} - {+(Type - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(RecordDataConstructor - {+(Identifier)+} - {+(Statements - {+(Field - {+(Statements - {+(Identifier)+})+} - {+(Identifier)+})+})+})+} - {+(Empty)+})+} - {+(Datatype - {+(Empty)+} - {+(Type - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(RecordDataConstructor - {+(Identifier)+} - {+(Statements - {+(Field - {+(Statements - {+(Identifier)+} - {+(Identifier)+})+} - {+(Identifier)+})+})+})+} - {+(Empty)+})+} - {+(Datatype - {+(Empty)+} - {+(Type - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(RecordDataConstructor - {+(Identifier)+} - {+(Statements - {+(Field - {+(Statements - {+(Identifier)+})+} - {+(StrictType - {+(Identifier)+} - {+(TypeParameters)+})+})+} - {+(Field - {+(Statements - {+(Identifier)+})+} - {+(Identifier)+})+})+})+} - {+(Empty)+})+} - {+(Datatype - {+(Empty)+} - {+(Type - {+(Identifier)+} - {+(TypeParameters)+})+} - {+(RecordDataConstructor - {+(Identifier)+} - {+(Statements - {+(Field - {+(Statements - {+(Identifier)+} - {+(Identifier)+})+} - {+(Context - {+(Pragma)+} - {+(StrictType - {+(Identifier)+} - {+(TypeParameters)+})+})+})+} - {+(Field - {+(Statements - {+(Identifier)+})+} - {+(Identifier)+})+})+})+} - {+(Empty)+})+} {+(Datatype {+(Empty)+} {+(Type @@ -194,74 +187,6 @@ {+(Identifier)+})+} {+(Identifier)+})+})+})+} {+(Empty)+})+} - {-(Datatype - {-(Empty)-} - {-(Type - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(RecordDataConstructor - {-(Identifier)-} - {-(Statements - {-(Field - {-(Statements - {-(Identifier)-})-} - {-(Identifier)-})-})-})-} - {-(Empty)-})-} - {-(Datatype - {-(Empty)-} - {-(Type - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(RecordDataConstructor - {-(Identifier)-} - {-(Statements - {-(Field - {-(Statements - {-(Identifier)-} - {-(Identifier)-})-} - {-(Identifier)-})-})-})-} - {-(Empty)-})-} - {-(Datatype - {-(Empty)-} - {-(Type - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(RecordDataConstructor - {-(Identifier)-} - {-(Statements - {-(Field - {-(Statements - {-(Identifier)-})-} - {-(StrictType - {-(Identifier)-} - {-(TypeParameters)-})-})-} - {-(Field - {-(Statements - {-(Identifier)-})-} - {-(Identifier)-})-})-})-} - {-(Empty)-})-} - {-(Datatype - {-(Empty)-} - {-(Type - {-(Identifier)-} - {-(TypeParameters)-})-} - {-(RecordDataConstructor - {-(Identifier)-} - {-(Statements - {-(Field - {-(Statements - {-(Identifier)-} - {-(Identifier)-})-} - {-(Context - {-(Pragma)-} - {-(StrictType - {-(Identifier)-} - {-(TypeParameters)-})-})-})-} - {-(Field - {-(Statements - {-(Identifier)-})-} - {-(Identifier)-})-})-})-} - {-(Empty)-})-} (Datatype (Empty) (Type diff --git a/test/fixtures/haskell/corpus/gadt-declarations.A.hs b/test/fixtures/haskell/corpus/gadt-declarations.A.hs new file mode 100644 index 000000000..0aa0ddc21 --- /dev/null +++ b/test/fixtures/haskell/corpus/gadt-declarations.A.hs @@ -0,0 +1 @@ +data Foo a b c where diff --git a/test/fixtures/haskell/corpus/gadt-declarations.B.hs b/test/fixtures/haskell/corpus/gadt-declarations.B.hs new file mode 100644 index 000000000..ddcc525f4 --- /dev/null +++ b/test/fixtures/haskell/corpus/gadt-declarations.B.hs @@ -0,0 +1 @@ +data Bar a b c where diff --git a/test/fixtures/haskell/corpus/gadt-declarations.diffA-B.txt b/test/fixtures/haskell/corpus/gadt-declarations.diffA-B.txt new file mode 100644 index 000000000..ec0d6b7dc --- /dev/null +++ b/test/fixtures/haskell/corpus/gadt-declarations.diffA-B.txt @@ -0,0 +1,12 @@ +(Module + (Empty) + (GADT + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (Statements + (Identifier) + (Identifier) + (Identifier))) + (Statements))) diff --git a/test/fixtures/haskell/corpus/gadt-declarations.diffB-A.txt b/test/fixtures/haskell/corpus/gadt-declarations.diffB-A.txt new file mode 100644 index 000000000..ec0d6b7dc --- /dev/null +++ b/test/fixtures/haskell/corpus/gadt-declarations.diffB-A.txt @@ -0,0 +1,12 @@ +(Module + (Empty) + (GADT + (Empty) + (Type + { (Identifier) + ->(Identifier) } + (Statements + (Identifier) + (Identifier) + (Identifier))) + (Statements))) diff --git a/test/fixtures/haskell/corpus/gadt-declarations.parseA.txt b/test/fixtures/haskell/corpus/gadt-declarations.parseA.txt new file mode 100644 index 000000000..fff54d58c --- /dev/null +++ b/test/fixtures/haskell/corpus/gadt-declarations.parseA.txt @@ -0,0 +1,11 @@ +(Module + (Empty) + (GADT + (Empty) + (Type + (Identifier) + (Statements + (Identifier) + (Identifier) + (Identifier))) + (Statements))) diff --git a/test/fixtures/haskell/corpus/gadt-declarations.parseB.txt b/test/fixtures/haskell/corpus/gadt-declarations.parseB.txt new file mode 100644 index 000000000..fff54d58c --- /dev/null +++ b/test/fixtures/haskell/corpus/gadt-declarations.parseB.txt @@ -0,0 +1,11 @@ +(Module + (Empty) + (GADT + (Empty) + (Type + (Identifier) + (Statements + (Identifier) + (Identifier) + (Identifier))) + (Statements)))