feat(haskell): highlights improvements

- Consider functions with only one value on the rhs as variables
- Applied composition: `(f . g) <param>` -> `@function.call`
- View patterns
- `@field` in record update expression
- type_tuple and type_list as variables
- quantifier for `exp_apply (<rhs>)+ (variable)`
- type_tuple and type_list as variables
- Treat signatures with only one value on the rhs as variables
  (except for `IO a`) -> Fixes #5505.
- Remove redundant anchors from signature function queries.
- Move signature function queries to give them higher priority
- Scoped function types
- Add signature query to function with parameters query

2 files changed, 142 insertions, 67 deletions

diff --git a/queries/haskell/highlights.scm b/queries/haskell/highlights.scm
index ecd267cc4..bf9692136 100644
--- a/queries/haskell/highlights.scm
+++ b/queries/haskell/highlights.scm
@@ -163,46 +163,6 @@
 
 (signature name: (variable) @function)
 
-((signature name: (variable) @variable)
- . (function 
-    name: (variable) @_name
-    rhs: [
-     (exp_literal)
-     (exp_apply 
-       (exp_name 
-         [(constructor)
-          (variable)
-         ]))
-     (quasiquote)
-     ((exp_name) . (operator))
-    ])
- (#eq? @variable @_name))
-
-((signature name: (variable) @variable)
- . (function 
-    name: (variable) @_name
-    rhs: (exp_infix 
-      [
-       (exp_literal)
-       (exp_apply 
-         (exp_name 
-           [(constructor)
-            (variable)
-           ]))
-       (quasiquote)
-       ((exp_name) . (operator))
-      ]))
- (#eq? @variable @_name))
-
-((signature name: (variable) @function)
- . (function 
-    name: (variable) @_name
-    patterns: (patterns))
- (#eq? @function @_name))
-
-;; For some reason, `(signature name: (variable) type: (fun))` doesn't work here
-(signature (variable) @function . (fun))
-
 (function name: (variable) @function)
 
 (function 
@@ -231,18 +191,40 @@
    ((exp_name) . (operator))
   ]))
 
+;; Consider signatures (and accompanying functions)
+;; with only one value on the rhs as variables
+(signature . (variable) @variable . (_) . )
+((signature . (variable) @_name . (_) . )
+ . (function name: (variable) @variable)
+ (#eq? @_name @variable))
+;; but consider a type that involves 'IO' a function
+(signature name: (variable) @function 
+  . (type_apply (type_name) @_type)
+    (#eq? @_type "IO"))
+((signature name: (variable) @_name 
+  . (type_apply (type_name) @_type)
+    (#eq? @_type "IO"))
+ . (function name: (variable) @function)
+   (#eq? @_name @function))
+
+;; functions with parameters
+;; + accompanying signatures
 (function
   name: (variable) @function
   patterns: (patterns))
+((signature) @function
+ . (function
+    name: (variable) @function
+    patterns: (patterns)))
 (function
   name: (variable) @function
   rhs: (exp_lambda))
-((signature (variable) @function (fun)) . (function (variable)))
-((signature (variable) @_type (fun)) . (function (variable) @function) (#eq? @function @_type))
-((signature (variable) @function (context (fun))) . (function (variable)))
-((signature (variable) @_type (context (fun))) . (function (variable) @function) (#eq? @function @_type))
-((signature (variable) @function (forall (context (fun)))) . (function (variable)))
-((signature (variable) @_type (forall (context (fun)))) . (function (variable) @function) (#eq? @function @_type))
+
+; view patterns
+(pat_view (exp_name [
+  ((variable) @function.call)
+  (qualified_variable (variable) @function.call)
+]))
 
 ; consider infix functions as operators
 (exp_infix [
@@ -253,11 +235,11 @@
 (exp_section_right [
   ((variable) @operator)
   (qualified_variable (variable) @operator)
-  ]) 
+]) 
 (exp_section_left [
   ((variable) @operator)
   (qualified_variable (variable) @operator)
-  ])
+])
 
 ; function calls with an infix operator
 ; e.g. func <$> a <*> b
@@ -272,9 +254,15 @@
   . (operator))
 ; infix operators applied to variables
 ((exp_name (variable) @variable) . (operator))
-((operator) . (exp_name (variable) @variable))
+((operator) . (exp_name [
+  ((variable) @variable)
+  (qualified_variable (variable) @variable)
+]))
 ; function calls with infix operators
-((exp_name (variable) @function.call) . (operator) @_op
+((exp_name [
+    ((variable) @function.call)
+    (qualified_variable (variable) @function.call)
+  ]) . (operator) @_op
  (#any-of? @_op "$" "<$>" ">>=" "=<<"))
 ; right hand side of infix operator
 ((exp_infix 
@@ -284,7 +272,7 @@
       (qualified_variable (variable) @function.call)
     ])) . (operator) @_op
  (#any-of? @_op "$" "<$>" "=<<"))
-; function composition, arrows, monadic composition (rhs)
+; function composition, arrows, monadic composition (lhs)
 ((exp_name [
   ((variable) @function)
   (qualified_variable (variable) @function)
@@ -310,22 +298,57 @@
     ((variable) @function.call)
     (qualified_variable (variable) @function.call)
   ]))
-(exp_apply [
-    (exp_name [
-      (variable)
-      (qualified_variable (variable))
-      (constructor)
-      (qualified_constructor (constructor))
-    ])
-    (exp_type_application)
-    (exp_parens)
-    (exp_record)
-  ]
+
+; function compositions, in parentheses, applied
+; lhs
+(exp_apply 
+  . (exp_parens (exp_infix
+    (exp_name [((variable) @function.call) (qualified_variable (variable) @function.call)])
+    . (operator))))
+; rhs
+(exp_apply 
+  . (exp_parens (exp_infix
+    (operator) 
+    . (exp_name [((variable) @function.call) (qualified_variable (variable) @function.call)])))
+      )
+
+;; variables being passed to a function call
+(exp_apply (_)+
   . (exp_name [
     ((variable) @variable)
     (qualified_variable (variable) @variable)
   ]))
 
+;; Consider functions with only one value on the rhs
+;; as variables, e.g. x = Rec {} or x = foo
+(function
+  . (variable) @variable
+  . [
+     (exp_record)
+     (exp_name (variable))
+     (exp_list)
+     (exp_tuple)
+     (exp_cond)
+    ] . )
+
+;; main is always a function
+;; (this prevents `main = undefined` from being highlighted as a variable)
+(function name: (variable) @function (#eq? @function "main"))
+
+;; scoped function types (func :: a -> b)
+(pat_typed 
+  pattern: (pat_name (variable) @function)
+  type: (fun))
+
+;; signatures that have a function type
+;; + functions that follow them
+((signature (variable) @function (fun)))
+((signature (variable) @_type (fun)) . (function (variable) @function) (#eq? @function @_type))
+((signature (variable) @function (context (fun))))
+((signature (variable) @_type (context (fun))) . (function (variable) @function) (#eq? @function @_type))
+((signature (variable) @function (forall (context (fun)))) . (function (variable)))
+((signature (variable) @_type (forall (context (fun)))) . (function (variable) @function) (#eq? @function @_type))
+
 ;; ----------------------------------------------------------------------------
 ;; Types
 
@@ -417,6 +440,7 @@
 (pat_field (variable) @field)
 (exp_projection field: (variable) @field)
 (import_item (type) . (import_con_names (variable) @field))
+(exp_field field: [((variable) @field) (qualified_variable (variable) @field)])
 
 
 ;; ----------------------------------------------------------------------------
diff --git a/tests/query/highlights/haskell/test.hs b/tests/query/highlights/haskell/test.hs
index 84d41769c..cd5db435e 100644
--- a/tests/query/highlights/haskell/test.hs
+++ b/tests/query/highlights/haskell/test.hs
@@ -26,6 +26,9 @@ import qualified Chronos as C
 import FooMod (BarTy (barField))
                       -- ^ @field
 
+x = mempty { field = 5 }
+           -- ^ @field
+
 data ADT
 -- ^ @keyword
   = A Int
@@ -70,6 +73,7 @@ recordWildCard Rec { field } = field
 recordDotSyntax rec = rec.field
                         -- ^ @field
 
+
 main :: IO ()
 -- ^ @function
   -- ^ @operator
@@ -111,15 +115,26 @@ someInfix x = fromIntegral x `myAdd` floatVal
              -- ^ @variable
                  -- ^ @variable
     floatVal :: Double
+    -- ^ @variable
     floatVal = 5.5
     -- ^ @variable
             -- ^ @float
     intVal :: Int
+    -- ^ @variable
     intVal = getInt 5
     -- ^ @variable
     boolVal :: Bool
+    -- ^ @variable
     boolVal = bool False True $ 1 + 2 == 3
     -- ^ @variable
+    refVal = boolVal
+    -- ^ @variable
+    namespacedRecord = NS.Rec { field = bar }
+    -- ^ @variable
+    record = Rec { field = bar }
+    -- ^ @variable
+    constructorRef = A
+    -- ^ @function
     isInt :: Either Double Int -> Bool
     -- ^ @function
     isInt eith@Left{} = False
@@ -132,7 +147,6 @@ someInfix x = fromIntegral x `myAdd` floatVal
     isInt (Right _) = True
     -- ^ @function
 
-
 someIOaction :: IO ()
 -- ^ @function
 someIOaction = do
@@ -175,10 +189,30 @@ intFun :: Int -> Int
 intFun = 5
 -- ^ @function
 
+undefinedFun :: Int -> Int
+undefinedFun = undefined
+-- ^ @function
+
 mbInt :: Maybe Int
+-- ^ @variable
 mbInt = Just 5
 -- ^ @variable
 
+tupleVal :: (a, b)
+-- ^@variable
+tupleVal = (1, "x")
+-- ^@variable
+
+listVal :: [a]
+-- ^@variable
+listVal = [1, 2]
+-- ^@variable
+-- ^@variable
+condVal = if otherwise
+-- ^@variable
+            then False
+            else True
+
 getLambda x = \y -> x `SomeModule.someInfix` y
             -- ^ @parameter
                       -- ^ @namespace
@@ -227,7 +261,12 @@ assertNonEmpty xs = xs `shouldSatisfy` not . null
                  -- ^ @variable
                                      -- ^ @function
                                             -- ^ @function
-
+appliedComposition f g var = (f . g) var
+                           -- ^ @function.call
+                               -- ^ @function.call
+appliedComposition f g var = (NS.f . NS.g) var
+                              -- ^ @function.call
+                                     -- ^ @function.call
 param1 |*| param2 = Qu $ param1 * param2
 -- ^ @parameter
          -- ^ @parameter
@@ -271,6 +310,18 @@ typeApplication x y = someFun @ty x y
 encrypt key pass = encrypt (defaultOAEPParams SHA1) key pass
                                                  -- ^ @variable
                                                       -- ^ @variable
-recordUpdate x y rec = someFun rec {field = 5} x y
-                                            -- ^ @variable
-                                              -- ^ @variable
+recordUpdate x y rec = someFun rec {field = 5} (x, x) y
+                                             -- ^ @variable
+                                                   -- ^ @variable
+viewPattern (func -> var) = 5
+           -- ^ @function.call
+                   -- ^ @parameter
+g (func :: a -> b) x = func y
+  -- ^ @parameter
+  -- ^ @function
+lambdaAlias :: LambdaAlias
+lambdaAlias _ _ _ = undefined
+  -- ^ @function
+spec :: Spec
+spec = describe "test ns" $ it "test case" pending
+-- ^ @variable