From 867170b39a53fe89e823eb4def8e36326eae540a Mon Sep 17 00:00:00 2001
From: Rick Winfrey <rewinfrey@github.com>
Date: Fri, 8 Jun 2018 10:13:24 -0700
Subject: [PATCH] Assign primitive constructor identifiers

---
 src/Language/Haskell/Assignment.hs                |  6 +++++-
 .../corpus/algebraic-datatype-declarations.A.hs   |  2 ++
 .../corpus/algebraic-datatype-declarations.B.hs   |  3 +++
 .../algebraic-datatype-declarations.diffA-B.txt   | 15 +++++++++++++++
 .../algebraic-datatype-declarations.diffB-A.txt   | 15 +++++++++++++++
 .../algebraic-datatype-declarations.parseA.txt    | 13 +++++++++++++
 .../algebraic-datatype-declarations.parseB.txt    | 13 +++++++++++++
 7 files changed, 66 insertions(+), 1 deletion(-)

diff --git a/src/Language/Haskell/Assignment.hs b/src/Language/Haskell/Assignment.hs
index 8daa36dd6..876b1d884 100644
--- a/src/Language/Haskell/Assignment.hs
+++ b/src/Language/Haskell/Assignment.hs
@@ -174,6 +174,7 @@ expressionChoices = [
                     , operator
                     , parenthesizedTypePattern
                     , pragma
+                    , primitiveConstructorIdentifier
                     , qualifiedModuleIdentifier
                     , qualifiedTypeConstructorIdentifier
                     , quotedName
@@ -316,6 +317,9 @@ parenthesizedTypePattern = symbol ParenthesizedTypePattern *> children expressio
 pragma :: Assignment
 pragma = makeTerm <$> symbol Pragma <*> (Syntax.Pragma <$> source)
 
+primitiveConstructorIdentifier :: Assignment
+primitiveConstructorIdentifier = makeTerm <$> symbol PrimitiveConstructorIdentifier <*> (Syntax.Identifier . Name.name <$> source)
+
 qualifiedModuleIdentifier :: Assignment
 qualifiedModuleIdentifier = makeTerm <$> symbol QualifiedModuleIdentifier <*> children (Syntax.QualifiedModuleIdentifier <$> someTerm' expression)
 
@@ -335,7 +339,7 @@ strictType :: Assignment
 strictType = makeTerm'
           <$> symbol StrictType
           <*> children (  (inject <$> (Syntax.StrictType <$> typeConstructor <*> typeParameters))
-                      <|> (inject <$> (Syntax.StrictTypeVariable <$> typeVariableIdentifier)))
+                      <|> (inject <$> (Syntax.StrictTypeVariable <$> expression)))
 
 string :: Assignment
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
diff --git a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.A.hs b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.A.hs
index 0496329da..d3140d0ea 100644
--- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.A.hs
+++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.A.hs
@@ -26,3 +26,5 @@ data (Eq (f a), Functor f) => N f a = N f a
 
 data Foo bar = HasCallStack => Foo bar
 data Baz foo = Show foo => Baz foo
+
+data Foo = Foo !Double#
diff --git a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.B.hs b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.B.hs
index d870e1525..609b21b69 100644
--- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.B.hs
+++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.B.hs
@@ -26,3 +26,6 @@ data (Eq (f a), Applicative f) => N f a = N f a
 
 data Foo bar = HasCallStack => Wiz bar
 data Baz a = Show a => Baz a
+
+
+data Bar = Bar !Double#
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 9c76f340f..abb7e7221 100644
--- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt
+++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt
@@ -423,4 +423,19 @@
         (TypeParameters
         { (Identifier)
         ->(Identifier) }))
+      (Empty))
+    (Datatype
+      (Empty)
+      (Type
+      { (Identifier)
+      ->(Identifier) }
+        (TypeParameters)
+        (Empty))
+      (Constructor
+        (Empty)
+      { (Identifier)
+      ->(Identifier) }
+        (TypeParameters
+          (StrictTypeVariable
+            (Identifier))))
       (Empty))))
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 6e1cf626b..cd68a7f78 100644
--- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt
+++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt
@@ -420,4 +420,19 @@
         (TypeParameters
         { (Identifier)
         ->(Identifier) }))
+      (Empty))
+    (Datatype
+      (Empty)
+      (Type
+      { (Identifier)
+      ->(Identifier) }
+        (TypeParameters)
+        (Empty))
+      (Constructor
+        (Empty)
+      { (Identifier)
+      ->(Identifier) }
+        (TypeParameters
+          (StrictTypeVariable
+            (Identifier))))
       (Empty))))
diff --git a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.parseA.txt b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.parseA.txt
index 3e9fba65b..8f0e74bc4 100644
--- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.parseA.txt
+++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.parseA.txt
@@ -354,4 +354,17 @@
         (Identifier)
         (TypeParameters
           (Identifier)))
+      (Empty))
+    (Datatype
+      (Empty)
+      (Type
+        (Identifier)
+        (TypeParameters)
+        (Empty))
+      (Constructor
+        (Empty)
+        (Identifier)
+        (TypeParameters
+          (StrictTypeVariable
+            (Identifier))))
       (Empty))))
diff --git a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.parseB.txt b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.parseB.txt
index 3e9fba65b..8f0e74bc4 100644
--- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.parseB.txt
+++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.parseB.txt
@@ -354,4 +354,17 @@
         (Identifier)
         (TypeParameters
           (Identifier)))
+      (Empty))
+    (Datatype
+      (Empty)
+      (Type
+        (Identifier)
+        (TypeParameters)
+        (Empty))
+      (Constructor
+        (Empty)
+        (Identifier)
+        (TypeParameters
+          (StrictTypeVariable
+            (Identifier))))
       (Empty))))