Improvements to multiline type/data declarations

JustusAdam · May 1, 2020 · 1ff05c1 · 1ff05c1
1 parent 0f38766
commit 1ff05c1
Show file tree

Hide file tree

Showing 17 changed files with 404 additions and 58 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -21,6 +21,8 @@
 - Improve support for promotion ticks ([#136](https://github.com/JustusAdam/language-haskell/issues/136)).
 - Support record syntax in GADTs.
 - Address regression in LiquidHaskell highlighting ([#131](https://github.com/JustusAdam/language-haskell/issues/136)).
+- Fixed several issues involving multi-line type/data declarations,
+  including allowing intervening comments ([#147](https://github.com/JustusAdam/language-haskell/pull/147)).
 
 ## 3.0.0 - 26.04.2020
 

diff --git a/syntaxes/haskell.YAML-tmLanguage b/syntaxes/haskell.YAML-tmLanguage
@@ -54,7 +54,7 @@ patterns:
       - {include: '#type_signature'}
   - begin: >-
       (?x)
-        ^(\s)*\b(data)
+        ^(\s*)\b(?:(?:(data)\s+(instance))|(data))
         \s+
         (
           [\p{Lu}\p{Lt}][\w\p{Nd}_']*                   # named type
@@ -64,25 +64,28 @@ patterns:
         \b(where(?:\b(?!')))
     beginCaptures:
       '2': {name: keyword.other.data.haskell}
-      '3': {name: storage.type.haskell}
-      '4':
+      '3': {name: keyword.other.instance.haskell}
+      '4': {name: keyword.other.data.haskell}
+      '5': {name: storage.type.haskell}
+      '6':
         patterns:
           - include: '#type_signature'
-      '5': {name: keyword.other.where.haskell}
+      '7': {name: keyword.other.where.haskell}
     name: meta.declaration.type.gadt.haskell
     end: | 
       (?x)
         (?=\bderiving\b)
-        |^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/implementation
+        | ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
     patterns:
       - include: '#deriving'
+      - include: '#comments'
       - begin: '^(\s*)(\b[\p{Lu}\p{Lt}][\p{Ll}_\p{Lu}\p{Lt}\p{Nd}'']*)\b'
         beginCaptures:
           '2': {name: constant.other.haskell}
           '3': {name: keyword.operator.double-colon.haskell}
         end: |
           (?x)
-            ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/implementation
+            ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
         patterns:
           - include: '#double_colon'
           - include: '#record_decl'
@@ -96,7 +99,7 @@ patterns:
           - include: '#type_signature'
   - begin: >-
       (?x)
-        ^(\s)*\b(newtype)
+        ^(\s*)\b(?:(?:(newtype)\s+(instance))|(newtype))
         \s+
         (
           [\p{Lu}\p{Lt}][\w\p{Nd}_']*                   # named type
@@ -106,19 +109,22 @@ patterns:
         (?:(=)|$)
     beginCaptures:
       '2': {name: keyword.other.newtype.haskell}
-      '3': {name: storage.type.haskell}
-      '4':
+      '3': {name: keyword.other.instance.haskell}
+      '4': {name: keyword.other.newtype.haskell}
+      '5': {name: storage.type.haskell}
+      '6':
         patterns:
           - include: '#type_signature'
-      '5': {name: keyword.other.eq.haskell}
+      '7': {name: keyword.operator.eq.haskell}
     name: meta.declaration.newtype.haskell
     end: | 
       (?x)
-        ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/*
+        ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
     patterns:
       - include: '#existential'
       - include: '#record_decl'
       - include: '#deriving'
+      - include: '#comments'
       - begin: '^(\s*)(=)?\s*(\b[\p{Lu}\p{Lt}][\p{Ll}_\p{Lu}\p{Lt}\p{Nd}'']*)'
         beginCaptures:
           '2': {name: keyword.operator.eq.haskell}
@@ -127,7 +133,7 @@ patterns:
         end: |
           (?x)
               (?=\||\bderiving\b)
-            | ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/implementation
+            | ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
         patterns:
           - include: '#record_decl' 
           - include: '#type_signature'
@@ -143,7 +149,7 @@ patterns:
           - include: '#type_signature'
   - begin: >-
       (?x)
-        ^(\s)*\b(data)
+        ^(\s*)\b(?:(?:(data)\s+(instance))|(data))
         \s+
         (
           [\p{Lu}\p{Lt}][\w\p{Nd}_']*                   # named type
@@ -153,19 +159,22 @@ patterns:
         (?:(=)|$)
     beginCaptures:
       '2': {name: keyword.other.data.haskell}
-      '3': {name: storage.type.haskell}
-      '4':
+      '3': {name: keyword.other.instance.haskell}
+      '4': {name: keyword.other.data.haskell}
+      '5': {name: storage.type.haskell}
+      '6':
         patterns:
           - include: '#type_signature'
-      '5': {name: keyword.operator.eq.haskell}
+      '7': {name: keyword.operator.eq.haskell}
     end: | 
       (?x)
-        ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/*
+        ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
     name: meta.declaration.adt.haskell
     patterns:
       - include: '#existential'
       - include: '#record_decl'
       - include: '#deriving'
+      - include: '#comments'
       - begin: '^(\s*)(?:(\|)|(=))\s*(\b[\p{Lu}\p{Lt}][\p{Ll}_\p{Lu}\p{Lt}\p{Nd}'']*)'
         beginCaptures:
           '2': {name: keyword.operator.pipe.haskell}
@@ -174,7 +183,7 @@ patterns:
         end: |
           (?x)
               (?=\||\bderiving\b)
-            | ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/implementation
+            | ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
         patterns:
           - include: '#record_decl' 
           - include: '#type_signature'
@@ -198,21 +207,21 @@ patterns:
       '4': {name: keyword.operator.double-colon.haskell}
     end: | 
       (?x)
-        ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/implementation
+        ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
     patterns:
       - include: '#type_signature'
-  - match: '^\s*(?:(type\s+family)|(type\s+instance)|(data\s+family)|(data\s+instance)|(newtype\s+instance)|(type\s+role)|(pattern))'
+  - match: '^\s*(?:(?:(type)\s+(family))|(?:(data)\s+(family))|(?:(type)\s+(role))|(pattern))'
     captures:
-      '1': {name: keyword.other.type-family.haskell}
-      '2': {name: keyword.other.type-instance.haskell}
-      '3': {name: keyword.other.data-family.haskell}
-      '4': {name: keyword.other.data-instance.haskell}
-      '5': {name: keyword.other.newtype-instance.haskell}
-      '6': {name: keyword.other.type-role.haskell}
+      '1': {name: keyword.other.type.haskell}
+      '2': {name: keyword.other.family.haskell}
+      '3': {name: keyword.other.data.haskell}
+      '4': {name: keyword.other.family.haskell}
+      '5': {name: keyword.other.type.haskell}
+      '6': {name: keyword.other.role.haskell}
       '7': {name: keyword.other.pattern.haskell}
   - begin: >-
       (?x)
-        ^(\s*)\b(type)
+        ^(\s*)\b(?:(?:(type)\s+(instance))|(type))
           \s+
           ([^=]*)
           (?:
@@ -222,25 +231,32 @@ patterns:
           )?\s*$
     beginCaptures:
       '2': {name: keyword.other.type.haskell}
-      '3':
+      '3': {name: keyword.other.instance.haskell}
+      '4': {name: keyword.other.type.haskell}
+      '5':
         patterns:
           - include: '#type_signature'
-      '4': {name: keyword.operator.eq.haskell}
-      '5':
+      '6': {name: keyword.operator.eq.haskell}
+      '7':
         patterns:
           - include: '#type_signature'
-    patterns:
-      - include: '#type_signature'
     end: | 
       (?x)
-        ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/implementation
+        ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
+    endCaptures:
+      '1': {name: keyword.operator.eq.haskell}
+    patterns:
+      - include: '#type_signature'
+      - match: '^(?:\s*(=))'
+        captures:
+          '1': {name: keyword.operator.eq.haskell}
   - begin: '^(\s*)\b(instance)(\b(?!''))'
     beginCaptures:
       '2': {name: keyword.other.instance.haskell}
     end: |
       (?x)
         \b(where)\b(?!')
-        | ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/implementation
+        | ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
     endCaptures:
       '1': {name: keyword.other.where.haskell}
     name: meta.declaration.instance.haskell
@@ -527,10 +543,10 @@ repository:
       \b[\p{Lu}\p{Lt}][\p{Ll}_\p{Lu}\p{Lt}\p{Nd}']*(?=\.)\b
     name: meta.import.qualifier.haskell
   record_decl:
-    begin: '{'
-    end: '}'
+    begin: '{(?!-)'
+    end: '(?<!-)}'
     name: meta.record.definition.haskell
-    patterns: 
+    patterns:
       - begin: >-
           (?x)
           ([\p{Ll}_][\p{Ll}_\p{Lu}\p{Lt}\p{Nd}']*)
@@ -569,13 +585,14 @@ repository:
     name: meta.function.type-declaration.haskell
     patterns:
       - include: '#type_signature'
+      - include: '#comments'
     end: |
       (?x)
         (?=               # we look ahead, but we do not want to consume
           (<\-)           # we are the left side of a `x :: Type <- expr` bind statement
           | }             # A block closed? Maybe this should also include `;`, because non-indentation based `do`
         )
-        | ^(?!\1\s+\S|\s*$)    # at least one, no-further indented, non-whitespace character. I.e. a same-level declaration/implementation
+        | ^(?!\1\s+\S|\s*$|\s*\{-|\s*-*--(?![\p{S}\p{P}&&[^(),;\[\]`{}_"']]).*$) # at least one, no-further indented, non-commented non-whitespace character. I.e. a same-level declaration/implementation
   type_signature:
     patterns:
       - match: '\(\s*\)'
@@ -603,7 +620,7 @@ repository:
   double_colon:
     match: '(::|∷)(?![\p{S}\p{P}&&[^(),;\[\]`{}_"'']])'
     captures:
-      '1': {name: keyword.other.double-colon.haskell}
+      '1': {name: keyword.operator.double-colon.haskell}
   namespace:
     match: '\b[\p{Lu}\p{Lt}][\p{Ll}_\p{Lu}\p{Lt}\p{Nd}'']*\.'
     name: entity.name.namespace.haskell

diff --git a/test/test.sh b/test/test.sh
@@ -9,14 +9,13 @@ tickets=($PWD/tickets/*)
 
 # Arrays containing filenames of broken tests.
 namedBroken=(
-  "Comments.hs"
   "Exports.hs"
   "Haddocks.hs"
   "InvalidClosingBlockComment.hs"
-  "Keywords.hs"
   "MultiLineTypeSignatures.hs"
   "QualifiedInfix.hs"
   "TypeSigs.hs"
+  "TypeVsData.hs"
 )
 ticketsBroken=(
   "T0028b.hs"
@@ -29,7 +28,6 @@ ticketsBroken=(
   "T0072c.hs"
   "T0071.hs"
   "T0073.hs"
-  "T0091.hs"
   "T0121.hs"
   "T0132.hs"
 )

diff --git a/test/tests/BlockComments.hs b/test/tests/BlockComments.hs
@@ -0,0 +1,44 @@
+-- SYNTAX TEST "source.haskell" "Intervening block comments shouldn't affect highlighting"
+
+
+  data A
+--     ^ storage.type.haskell
+{- comment line not gobbled up by the preprocessor
+  over multiple lines -}
+-- <~~---------------------- comment.block.haskell
+    = A
+--    ^ constant.other.haskell
+
+  newtype B =
+--        ^ storage.type.haskell
+{- comment line not gobbled up by the preprocessor -}
+-- <~~----------------------------------------------------- comment.block.haskell
+    B
+--  ^ constant.other.haskell
+
+  data Foo where
+{- comment line not gobbled up by the preprocessor
+over multiple lines  -}
+-- <---------------------- comment.block.haskell
+      MkFoo :: Foo
+--    ^^^^^^^^^^^^ meta.declaration.type.gadt.haskell
+--    ^^^^^ constant.other.haskell
+--             ^^^ storage.type.haskell
+
+  dbPageWrapper :: (DashBoardPage p, Monad m) =>
+{- comment line not gobbled up by the preprocessor
+ over
+ multiple
+ lines   -}
+-- <~----------- comment.block.haskell
+      T.Text -> p -> HtmlT m a -> HtmlT m b -> HtmlT m b
+--    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ meta.function.type-declaration.haskell
+--                                ^^^^^ storage.type.haskell
+
+  type T a
+        {- comment line not gobbled up by the preprocessor
+over multiple
+lines -}
+-- <-------- comment.block.haskell
+    = Int
+--    ^^^ storage.type.haskell
diff --git a/test/tests/Comments.hs b/test/tests/Comments.hs
@@ -1,19 +1,37 @@
 -- SYNTAX TEST "source.haskell" "Intervening comments shouldn't affect highlighting"
 
-data Foo where
-{- comment line not gobbled up by the preprocessor -}
-    MkFoo :: Foo
---  ^^^^^^^^^^^^ meta.declaration.type.gadt.haskell
---  ^^^^^ constant.other.haskell
---           ^^^ storage.type.haskell
 
-dbPageWrapper :: (DashBoardPage p, Monad m) =>
-{- comment line not gobbled up by the preprocessor -}
-    T.Text -> p -> HtmlT m a -> HtmlT m b -> HtmlT m b
---  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ meta.function.type-declaration.haskell
---                              ^^^^^ storage.type.haskell
+  data A
+--     ^ storage.type.haskell
+  -- comment line not gobbled up by the preprocessor
+-- <~~-------------------------------------------------- comment.line.double-dash.haskell
+    = A
+--    ^ constant.other.haskell
 
-type T a
-{- comment line not gobbled up by the preprocessor -}
-  = Int
---  ^^^ storage.type.haskell
+  newtype B =
+--        ^ storage.type.haskell
+  -- comment line not gobbled up by the preprocessor
+-- <~~-------------------------------------------------- comment.line.double-dash.haskell
+    B
+--  ^ constant.other.haskell
+
+  data Foo where
+  -- comment line not gobbled up by the preprocessor
+-- <~~-------------------------------------------------- comment.line.double-dash.haskell
+      MkFoo :: Foo
+--    ^^^^^^^^^^^^ meta.declaration.type.gadt.haskell
+--    ^^^^^ constant.other.haskell
+--             ^^^ storage.type.haskell
+
+  dbPageWrapper :: (DashBoardPage p, Monad m) =>
+  -- comment line not gobbled up by the preprocessor
+-- <~~-------------------------------------------------- comment.line.double-dash.haskell
+      T.Text -> p -> HtmlT m a -> HtmlT m b -> HtmlT m b
+--    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ meta.function.type-declaration.haskell
+--                                ^^^^^ storage.type.haskell
+
+  type T a
+  -- comment line not gobbled up by the preprocessor
+-- <~~-------------------------------------------------- comment.line.double-dash.haskell
+    = Int
+--    ^^^ storage.type.haskell
diff --git a/test/tests/Data1.hs b/test/tests/Data1.hs
@@ -0,0 +1,18 @@
+-- SYNTAX TEST "source.haskell" "Indented data declarations"
+
+        data T = C T 
+
+      data T = C T
+--    ^^^^ keyword.other.data.haskell
+--           ^ keyword.operator.eq.haskell
+--             ^ constant.other.haskell
+--         ^     ^ storage.type.haskell
+
+
+    data instance T = C T
+--  ^^^^ keyword.other.data.haskell
+--       ^^^^^^^^ keyword.other.instance.haskell
+--                  ^ keyword.operator.eq.haskell
+--                    ^ constant.other.haskell
+--                ^     ^ storage.type.haskell
+