Improved type family highlighting

CHANGELOG.md

@@ -46,6 +46,7 @@
 - Support for role annotation keywords (nominal/representational/phantom).
 - Fix regression in highlighting subsequent lines in a multi-line type signature
   when the initial `::` appears appears first on a line.
+- Correct highlighting of types in type families.
 
 ## 3.0.0 - 26.04.2020
 

syntaxes/haskell.YAML-tmLanguage

@@ -98,11 +98,55 @@ patterns:
       - include: '#comment_like'
       - include: '#deriving'
       - include: '#gadt_constructor'
+  - include: '#role_annotation'
+  - name: 'meta.declaration.pattern.type.haskell'
+    begin: '(\s*)(pattern)\s+(.*?)\s+(::|∷)(?![\p{S}\p{P}&&[^(),;\[\]`{}_"'']])'
+    beginCaptures:
+      '2': {name: keyword.other.pattern.haskell}
+      '3': 
+        patterns:
+          - include: '#comma'
+          - include: '#data_constructor'
+      '4': {name: keyword.operator.double-colon.haskell}
+    end: | 
+      (?x) # Detect end of pattern type definition by decreasing indentation:
+        (?=\}|;)       # Explicit indentation
+        |^(?!          # Implicit indentation: end match on newline *unless* the new line is either:
+            \1\s+\S    # - more indented, or
+          | \s*        # - starts with whitespace, followed by:
+            (?: $      #   - the end of the line (i.e. empty line), or
+            |\{-[^@]   #   - the start of a block comment, or
+            |--+       #   - the start of a single-line comment.
+               (?![\p{S}\p{P}&&[^(),;\[\]{}`_"']]).*$) # non-symbol
+                       # The double dash may not be followed by other operator characters
+                       # (then it would be an operator, not a comment)
+          )
+    patterns:
+      - include: '#type_signature'
+  - name: 'meta.declaration.pattern.haskell'
+    begin: '^\s*(pattern)\b(?!'')'
+    captures:
+      '1': {name: keyword.other.pattern.haskell}
+    end: | 
+      (?x) # Detect end of pattern type definition by decreasing indentation:
+        (?=\}|;)       # Explicit indentation
+        |^(?!          # Implicit indentation: end match on newline *unless* the new line is either:
+            \1\s+\S    # - more indented, or
+          | \s*        # - starts with whitespace, followed by:
+            (?: $      #   - the end of the line (i.e. empty line), or
+            |\{-[^@]   #   - the start of a block comment, or
+            |--+       #   - the start of a single-line comment.
+               (?![\p{S}\p{P}&&[^(),;\[\]{}`_"']]).*$) # non-symbol
+                       # The double dash may not be followed by other operator characters
+                       # (then it would be an operator, not a comment)
+          )
+    patterns:
+      - include: '$self'
   # ADT declaration (no "where" keyword on the same line)
   - begin: >-
       (?x)
         # Data declaration
-        ^(\s*)(data|newtype)(?:\s+(instance))?\s+
+        ^(\s*)(data|newtype)(?:\s+(family|instance))?\s+
         # Keep consuming characters until:
         (((?!
         # the equals symbol or the start of a single-line comment, or
@@ -119,7 +163,7 @@ patterns:
         ).)*)
     beginCaptures:
       '2': {name: keyword.other.$2.haskell}
-      '3': {name: keyword.other.instance.haskell}
+      '3': {name: keyword.other.$3.haskell}
       '4':
         patterns:
           - include: '#type_signature'
@@ -146,16 +190,45 @@ patterns:
       - include: '#context'
       - include: '#record_decl'
       - include: '#type_signature'
-  - begin: '(\s*)(pattern)\s+(.*?)\s+(::|∷)(?![\p{S}\p{P}&&[^(),;\[\]`{}_"'']])'
+  - name: 'meta.declaration.type.family.haskell'
+    begin: >-
+      (?x)
+        # Type family
+        ^(\s*)(type)\s+(family)\b(?!')
+        # Keep consuming characters until:
+        (((?!
+        # the equals symbol or the start of a single-line comment, or
+          (?: 
+            (?<![\p{S}\p{P}&&[^(),;\[\]`{}_"']]) # non-symbol
+            (?:=|--+)
+            (?![\p{S}\p{P}&&[^(),;\[\]`{}_"']])  # non-symbol
+          )
+        # the "where" keyword, or
+        | \bwhere\b(?!')
+        # the start of a block comment.
+        | {-
+        #
+        ).)*)
     beginCaptures:
-      '2': {name: keyword.other.pattern.haskell}
-      '3': 
+      '2': {name: keyword.other.type.haskell}
+      '3': {name: keyword.other.family.haskell}
+      '4':
         patterns:
-          - include: '#comma'
-          - include: '#data_constructor'
-      '4': {name: keyword.operator.double-colon.haskell}
+          - include: "#comment_like"
+          - match: >-
+             (?x)
+               (?<![\p{S}\p{P}&&[^(),;\[\]`{}_"']]) # non-symbol
+               (?:(=)|(\|))
+               (?![\p{S}\p{P}&&[^(),;\[\]`{}_"']])  # non-symbol
+            captures:
+              '1': {name: keyword.operator.eq.haskell}
+              '2': {name: keyword.operator.pipe.type.haskell}
+          - match: '\b(where)\b(?!'')'
+            captures:
+              '1': {name: keyword.other.where.haskell}
+          - include: '#type_signature'
     end: | 
-      (?x) # Detect end of pattern type definition by decreasing indentation:
+      (?x) # Detect end of type family by decreasing indentation:
         (?=\}|;)       # Explicit indentation
         |^(?!          # Implicit indentation: end match on newline *unless* the new line is either:
             \1\s+\S    # - more indented, or
@@ -168,16 +241,19 @@ patterns:
                        # (then it would be an operator, not a comment)
           )
     patterns:
+      - match: '\b(where)\b(?!'')'
+        name: keyword.other.where.haskell
+      - match: >-
+          (?x)
+            (?<![\p{S}\p{P}&&[^(),;\[\]`{}_"']]) # non-symbol
+            (?:(=)|(\|))
+            (?![\p{S}\p{P}&&[^(),;\[\]`{}_"']])  # non-symbol
+        captures:
+          '1': {name: keyword.operator.eq.haskell}
+          '2': {name: keyword.operator.pipe.type.haskell}
       - include: '#type_signature'
-  - include: '#role_annotation'
-  - match: '^\s*(?:(?:(type)\s+(family))|(?:(data)\s+(family))|(pattern))'
-    captures:
-      '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.pattern.haskell}
-  - begin: >-
+  - name: 'meta.declaration.type.haskell'
+    begin: >-
       (?x)
         # Type declaration
         ^(\s*)(type)(?:\s+(instance))?\s+
@@ -655,6 +731,7 @@ repository:
           )
   adt_constructor:
     patterns:
+      - include: '#comment_like'
       - begin: >-
           (?x)
             (?<![\p{S}\p{P}&&[^(),;\[\]`{}_"']]) # non-symbol

test/test.sh

@@ -14,8 +14,6 @@ namedBroken=(
 ticketsBroken=(
   "T0028c.hs"
   "T0072b3.hs"
-  "T0072c.hs"
-  "T0132.hs"
   "T0150b.hs"
 )
 

test/tickets/T0072a.hs

@@ -10,12 +10,13 @@ import M ( pattern Q )
 --                 ^ constant.other.haskell
 
 
-pattern A :: Type
+pattern A :: T
 -- <------- keyword.other.pattern.haskell
 --      ^ constant.other.haskell
-pattern (A b) = c
+--           ^ storage.type.haskell
+pattern (A b) = C
 -- <------- keyword.other.pattern.haskell
---       ^ constant.other.haskell
+--       ^      ^ constant.other.haskell
 
 pattern B :: A -> B
 -- <------- keyword.other.pattern.haskell
@@ -24,6 +25,7 @@ pattern B :: A -> B
           -> C
 --           ^ storage.type.haskell
 
-pattern A, B :: Type
+pattern A, B :: T
 -- <------- keyword.other.pattern.haskell
 --      ^  ^ constant.other.haskell
+--              ^ storage.type.haskell

test/tickets/T0072c.hs

@@ -1,44 +1,79 @@
 -- SYNTAX TEST "source.haskell" "Type/data families and instances"
 
 type family CTF1 a b where
--- <----------- keyword.other.type-family.haskell
+-- <---- keyword.other.type.haskell
+--   ^^^^^^ keyword.other.family.haskell
 --          ^^^^ storage.type.haskell
---               ^ ^ ^ variable.other.generic-type.haskell
+--               ^ ^ variable.other.generic-type.haskell
     CTF1 a b = D a
 --  ^^^^       ^ storage.type.haskell
 --       ^ ^     ^ variable.other.generic-type.haskell
 type family CTF2 (a :: k) :: B where
--- <----------- keyword.other.type-family.haskell
---          ^^^^             ^ storage.type.haskell
+-- <---- keyword.other.type.haskell
+--   ^^^^^^ keyword.other.family.haskell
 --                ^    ^ variable.other.generic-type.haskell
+--          ^^^^             ^ storage.type.haskell
+
 type family CTF3 (a :: A) = (r :: A) | r -> a where
--- <----------- keyword.other.type-family.haskell
---                ^          ^         ^    ^ variable.other.generic-type.haskell
+-- <---- keyword.other.type.haskell
+--   ^^^^^^ keyword.other.family.haskell
+--                        ^ keyword.operator.eq.haskell
 --                     ^          ^ storage.type.haskell
+--                                   ^ keyword.operator.pipe.type.haskell
+--                ^          ^         ^    ^ variable.other.generic-type.haskell
+--                                            ^^^^^ keyword.other.where.haskell
+
+type family CTF4
+-- <---- keyword.other.type.haskell
+--   ^^^^^^ keyword.other.family.haskell
+              (a :: A)
+--             ^ variable.other.generic-type.haskell
+--                  ^ storage.type.haskell
+              (b :: B)
+--             ^ variable.other.generic-type.haskell
+--                  ^ storage.type.haskell
+            = (r :: A)
+--          ^ keyword.operator.eq.haskell
+--             ^ variable.other.generic-type.haskell
+--                  ^ storage.type.haskell
+            | r -> a b
+--            ^    ^ ^ variable.other.generic-type.haskell
+--          ^ keyword.operator.pipe.type.haskell
+            where
+--          ^^^^^ keyword.other.where.haskell
 
 type family   OTF a b
--- <----------- keyword.other.type-family.haskell
+-- <---- keyword.other.type.haskell
+--   ^^^^^^ keyword.other.family.haskell
 --            ^^^ storage.type.haskell
 --                ^ ^ variable.other.generic-type.haskell
 type instance OTF (a,a) c = (a,c)
--- <------------- keyword.other.type-instance.haskell
+-- <---- keyword.other.type.haskell
+--   ^^^^^^^^ keyword.other.instance.haskell
 --            ^^^ storage.type.haskell
 --                 ^ ^  ^    ^ ^ variable.other.generic-type.haskell
 type instance
--- <------------- keyword.other.type-instance.haskell
+-- <---- keyword.other.type.haskell
+--   ^^^^^^^^ keyword.other.instance.haskell
     OTF (Int, Bool) = Char
 --  ^^^  ^^^  ^^^^    ^^^^ storage.type.haskell
+--                  ^ keyword.operator.eq.haskell
 
 data   family DF (x :: Bool)
--- <------------- keyword.other.data-family.haskell
+-- <---- keyword.other.data.haskell
+--     ^^^^^^ keyword.other.family.haskell
 --                ^ variable.other.generic-type.haskell
 --                     ^^^^ storage.type.haskell
 newtype instance DF 'True = DCTrue Int
--- <---------------- keyword.other.newtype-instance.haskell
---            ^^ storage.type.haskell
---                       ^^^^^^ constant.other.haskell
+-- <------- keyword.other.newtype.haskell
+--      ^^^^^^^^ keyword.other.instance.haskell
+--               ^^ storage.type.haskell
+--                          ^^^^^^ constant.other.haskell
+--                                 ^^^ storage.type.haskell
 data instance DF 'False where
--- <------------- keyword.other.data-instance.haskell
---            ^^ storage.type.haskell
+-- <---- keyword.other.data.haskell
+--   ^^^^^^^^ keyword.other.instance.haskell
+--            ^^  ^^^^^ storage.type.haskell
     DCFalse :: Float -> DF 'False
 --  ^^^^^^^ constant.other.haskell
+--             ^^^^^    ^^  ^^^^^ storage.type.haskell

test/tickets/T0132.hs

@@ -7,39 +7,39 @@ data C a b = C a b
 
 data a `D` b = a `D` b
 -- <---- keyword.other.data.haskell
---      ^ storage.type.haskell
+--      ^ storage.type.infix.haskell
 --                ^ constant.other.haskell
 
 data a `E` b where
 -- <---- keyword.other.data.haskell
---      ^ storage.type.haskell
+--      ^ storage.type.infix.haskell
 
 data (:>) a b = (:>) a b
 -- <---- keyword.other.data.haskell
---    ^^ storage.type.haskell
---               ^^ constant.other.haskell
+--    ^^ storage.type.operator.haskell
+--               ^^ constant.other.operator.haskell
 
 data a :< b = a :< b
 -- <---- keyword.other.data.haskell
---     ^^ storage.type.haskell
---              ^^ constant.other.haskell
+--     ^^ storage.type.operator.infix.haskell
+--              ^^ constant.other.operator.haskell
 --     ^^       ^^ - keyword.operator.haskell
 
 data a := b = a := b
 -- <---- keyword.other.data.haskell
---     ^^ storage.type.haskell
---              ^^ constant.other.haskell
+--     ^^ storage.type.operator.infix.haskell
+--              ^^ constant.other.operator.haskell
 --     ^^       ^^ - keyword.operator.haskell
 
 data (:<>) a b where
 -- <---- keyword.other.data.haskell
   (:<>) :: a -> b -> (:<>) a b
--- ^^^ constant.other.haskell
---                    ^^^ storage.type.haskell
+-- ^^^ constant.other.operator.haskell
+--                    ^^^ storage.type.operator.haskell
 
 data a :>< b where
 -- <---- keyword.other.data.haskell
---     ^^^ storage.type.haskell
+--     ^^^ storage.type.operator.infix.haskell
 
 
 type F a b = C a b
@@ -48,21 +48,23 @@ type F a b = C a b
 
 type a `G` b = a `D` b
 -- <---- keyword.other.type.haskell
---      ^         ^ storage.type.haskell
+--      ^         ^ storage.type.infix.haskell
 
 type (<<) a b = a <> b
 -- <---- keyword.other.type.haskell
---    ^^          ^^ storage.type.haskell
+--    ^^ storage.type.operator.haskell
+--                ^^ storage.type.operator.infix.haskell
 
 type (:>>) a b = a :> b
 -- <---- keyword.other.type.haskell
---    ^^^          ^^ storage.type.haskell
+--    ^^^ storage.type.operator.haskell         
+--                 ^^ storage.type.operator.infix.haskell
 
 type a :<< b = a :< b
 -- <---- keyword.other.type.haskell
---     ^^^       ^^ storage.type.haskell
+--     ^^^       ^^ storage.type.operator.infix.haskell
 
 type a :== b = a := b
 -- <---- keyword.other.type.haskell
---     ^^^       ^^ storage.type.haskell
+--     ^^^       ^^ storage.type.operator.infix.haskell
 --     ^^^       ^^ - keyword.operator.haskell