feat(haskell): highlights improvements + tests (#5466)

queries/haskell/highlights.scm

@@ -116,7 +116,8 @@
 
 
 (module) @namespace
-(qualified_module (module) @constructor)
+((qualified_module (module) @constructor)
+ . (module))
 (qualified_type (module) @namespace)
 (qualified_variable (module) @namespace)
 (import (module) @namespace)
@@ -152,7 +153,24 @@
 
 (variable) @variable
 (pat_wildcard) @variable
-(signature name: (variable) @variable)
+(signature name: (variable) @function)
+((signature name: (variable) @variable)
+ (function 
+  name: (variable) @_name
+  rhs: [
+   (exp_literal)
+   (exp_apply (exp_name (constructor)))
+   (quasiquote)
+  ])
+ (#eq? @variable @_name))
+(function name: (variable) @function)
+(function 
+  name: (variable) @variable
+  rhs: [
+   (exp_literal)
+   (exp_apply (exp_name (constructor)))
+   (quasiquote)
+  ])
 
 (function
   name: (variable) @function
@@ -167,14 +185,61 @@
 ((signature (variable) @function (forall (context (fun)))) . (function (variable)))
 ((signature (variable) @_type (forall (context (fun)))) . (function (variable) @function) (#eq? @function @_type))
 
-(exp_infix (variable) @operator)  ; consider infix functions as operators
-(exp_section_right (variable) @operator) ; partially applied infix functions (sections) also get highlighted as operators
+; consider infix functions as operators
+(exp_infix (variable) @operator)  
+(exp_infix (qualified_variable (variable) @operator))
+; partially applied infix functions (sections) also get highlighted as operators
+(exp_section_right (variable) @operator) 
+(exp_section_right (qualified_variable (variable) @operator)) 
 (exp_section_left (variable) @operator)
+(exp_section_left (qualified_variable (variable) @operator))
 
-(exp_infix (exp_name) @function.call (#set! "priority" 101))
+; function calls with an infix operator
+; e.g. func <$> a <*> b
+(exp_infix (exp_name) @function.call . (operator))
+; qualified function calls with an infix operator
+(exp_infix (exp_name 
+  (qualified_variable (
+      (module) @namespace
+      (variable) @function.call))) . (operator))
+; infix operators applied to variables
+((exp_name (variable) @variable) . (operator))
+((operator) . (exp_name (variable) @variable))
+; function calls with infix operators
+((exp_name (variable) @function.call) . (operator) @_op
+ (#any-of? @_op "$" "<$>" ">>="))
+; function composition, arrows
+((exp_name (variable) @function) . (operator) @_op
+ (#any-of? @_op "." ">>>"))
+((operator) @_op (exp_name (variable) @function)
+ (#any-of? @_op "." ">>>"))
+        
+        
 (exp_apply . (exp_name (variable) @function.call))
 (exp_apply . (exp_name (qualified_variable (variable) @function.call)))
 
+; let/where bindings
+(_ (decls (function name: (variable) @variable)))
+(_ (decls 
+  (function 
+    name: (variable) @function
+    patterns: (patterns (pat_name) @parameter))))
+
+; higher-order function parameters
+(function
+  patterns: (patterns (pat_name (variable) @function))
+  rhs: (exp_apply (exp_name (variable) @_name) . (exp_name)+)
+  (#eq? @function @_name))
+(function
+  patterns: (patterns (pat_name (variable) @function))
+  rhs: (_ (operator) @_op (exp_name (variable))
+ (#any-of? @_op "." ">>>")))
+(function
+  patterns: (patterns (pat_name (variable) @function))
+  rhs: (_ (exp_name (variable)) . (operator) @_op)
+ (#any-of? @_op "$" "<$>" ">>=" "." ">>>"))
+
+
 ;; ----------------------------------------------------------------------------
 ;; Types
 
@@ -254,12 +319,11 @@
 
 
 ;; ----------------------------------------------------------------------------
-;; Record fields
-(record_fields (field (variable) @field))
+;; Fields
+(field (variable) @field)
 
 
 ;; ----------------------------------------------------------------------------
 ;; Spell checking
 
 (comment) @spell
-

tests/query/highlights/haskell/test.hs

@@ -0,0 +1,161 @@
+{-# LANGUAGE QuasiQuotes #-}
+-- ^ @preproc
+
+module Main 
+-- ^ @include
+     -- ^ @namespace
+  ( main
+  ) where
+   -- ^ @keyword
+
+import Prelude hiding (show)
+-- ^ @include
+      -- ^ @namespace
+              -- ^ @keyword
+                      -- ^ @variable
+import Data.Map (fromList)
+      -- ^ @namespace
+import qualified Data.Map as Map
+                -- ^ @constructor
+                           -- ^ @namespace
+import qualified Chronos
+                -- ^ @namespace
+
+data ADT
+-- ^ @keyword
+  = A Int
+ -- ^ @constructor
+    -- ^ @type
+  | B
+ -- ^ @constructor
+  deriving (Eq, Show)
+  -- ^ @keyword
+         -- ^ @type
+               -- ^ @type
+
+class Ord a => PartialOrd a
+    -- ^ @type
+       -- ^ @type
+                -- ^ @type
+                       -- ^ @type
+
+instance Ord ADT where
+      -- ^ @type
+          -- ^ @type
+
+newtype Rec
+-- ^ @keyword
+     -- ^ @type
+  = Rec
+  -- ^ @constructor
+    { field :: Double
+ -- ^ @punctuation.bracket
+    -- ^ @field
+              -- ^ @type
+    }
+ -- ^ @punctuation.bracket
+    deriving Eq
+           -- ^ @type
+
+main :: IO ()
+-- ^ @function
+  -- ^ @operator
+     -- ^ @type
+         -- ^ @symbol
+main = undefined
+-- ^ @function
+      -- ^ @exception
+
+someFunc0 :: Int -> Int
+              -- ^ @operator
+someFunc0 x = someFunc1 x
+       -- ^ @parameter
+            -- ^ @function.call
+  where
+  -- ^ @keyword
+    someFunc1 _ = 5
+    -- ^ @function
+               -- ^ @number
+
+someInfix :: Integral a => a -> Double
+            -- ^ @type
+                   -- ^ @type
+                      -- ^ @operator
+                        -- ^ @type
+someInfix x = fromIntegral x `myAdd` floatVal
+                -- ^ @function.call
+                        -- ^ @variable
+                             -- ^ @operator
+                                    -- ^ @variable
+  where
+    myAdd x y = x + y
+             -- ^ @variable
+                 -- ^ @variable
+    floatVal = 5.5
+    -- ^ @variable
+            -- ^ @float
+
+someIOaction :: IO ()
+-- ^ @function
+someIOaction = do
+            -- ^ @keyword
+  foo <- SomeModule.someFun <$> getArgs
+-- ^ @variable
+            -- ^ @namespace
+                   -- ^ @function.call
+                          -- ^ @operator
+  let bar = SomeModule.doSomething $ "a" "b"
+    -- ^ @variable
+            -- ^ @namespace
+                        -- ^ @function.call
+                                -- ^ @operator
+      func x y = x + y - 7
+    -- ^ @function
+        -- ^ @parameter
+              -- ^ @variable
+                  -- ^ @variable
+  pure $ func 1 2
+  -- ^ @function.call
+        -- ^ @function.call
+
+intVal :: Int
+-- ^ @variable
+intVal = 5
+-- ^ @variable
+
+mbInt :: Maybe Int
+-- ^ @variable
+mbInt = Just 5
+-- ^ @variable
+
+getLambda x = \y -> x `SomeModule.someInfix` y
+            -- ^ @parameter
+                      -- ^ @namespace
+                                  -- ^ @operator
+
+isVowel = (`elem` "AEIOU")
+          -- ^ @operator
+isVowelQualified = (`SomeModule.elem` "AEIOU")
+                      -- ^ @namespace
+                              -- ^ @operator
+
+hasVowels = ("AEIOU" `elem`)
+                   -- ^ @operator
+hasVowelsQualified = ("AEIOU" `SomeModule.elem`)
+                            -- ^ @namespace
+                                       -- ^ @operator
+
+quasiQuotedString = [qq|Some string|]
+-- ^ @variable
+                   -- ^ @function.call
+                      -- ^ @string
+
+higherOrderFn f x = f x
+           -- ^ @function
+             -- ^ @variable
+
+composition f g = f . g
+         -- ^ @function
+           -- ^ @function
+               -- ^ @function
+                   -- ^ @function