#2418 Also use .hlint.yaml fixity rules when HLINT_ON_LIB_GHC not defined (#2464)

* fix #2418 until upstream hlint change

* remove debug import

* add comment about when ghc-lib-parser-ex dependency can be removed

Co-authored-by: Javier Neira <atreyu.bbb@gmail.com>

Author: eddiemundo

plugins/hls-hlint-plugin/hls-hlint-plugin.cabal

@@ -68,6 +68,10 @@ library
     , text
     , transformers
     , unordered-containers
+    -- can be removed if https://github.com/ndmitchell/hlint/pull/1325#issue-1077062712 is merged
+    -- and https://github.com/haskell/haskell-language-server/pull/2464#issue-1077133441 is updated
+    -- accordingly
+    , ghc-lib-parser-ex
 
   if (flag(hlint33))
     -- This mirrors the logic in hlint.cabal for hlint-3.3

plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

@@ -84,6 +84,7 @@ import           Development.IDE.GHC.Compat.Core                    hiding
 import           Language.Haskell.GHC.ExactPrint.Delta              (deltaOptions)
 import           Language.Haskell.GHC.ExactPrint.Parsers            (postParseTransform)
 import           Language.Haskell.GHC.ExactPrint.Types              (Rigidity (..))
+import           Language.Haskell.GhclibParserEx.Fixity             as GhclibParserEx (applyFixities)
 #endif
 
 import           Ide.Logger
@@ -104,7 +105,8 @@ import           Language.LSP.Types                                 hiding
 import qualified Language.LSP.Types                                 as LSP
 import qualified Language.LSP.Types.Lens                            as LSP
 
-import           GHC.Generics                                       (Generic)
+import           GHC.Generics                                       (Associativity (LeftAssociative, NotAssociative, RightAssociative),
+                                                                     Generic)
 import           Text.Regex.TDFA.Text                               ()
 
 import           Development.IDE.GHC.Compat.Core                    (WarningFlag (Opt_WarnUnrecognisedPragmas),
@@ -251,9 +253,23 @@ getIdeas nfp = do
         moduleEx _flags = do
           mbpm <- getParsedModuleWithComments nfp
           return $ createModule <$> mbpm
-          where createModule pm = Right (createModuleEx anns modu)
+          where
+            createModule pm = Right (createModuleEx anns (applyParseFlagsFixities modu))
                   where anns = pm_annotations pm
                         modu = pm_parsed_source pm
+
+            applyParseFlagsFixities :: ParsedSource -> ParsedSource
+            applyParseFlagsFixities modul = GhclibParserEx.applyFixities (parseFlagsToFixities _flags) modul
+
+            parseFlagsToFixities :: ParseFlags -> [(String, Fixity)]
+            parseFlagsToFixities = map toFixity . Hlint.fixities
+
+            toFixity :: FixityInfo -> (String, Fixity)
+            toFixity (name, dir, i) = (name, Fixity NoSourceText i $ f dir)
+                where
+                    f LeftAssociative  = InfixL
+                    f RightAssociative = InfixR
+                    f NotAssociative   = InfixN
 #else
         moduleEx flags = do
           mbpm <- getParsedModuleWithComments nfp

plugins/hls-hlint-plugin/test/Main.hs

@@ -99,6 +99,10 @@ suggestionsTests =
         contents <- skipManyTill anyMessage $ getDocumentEdit doc
         liftIO $ contents @?= "main = undefined\nfoo = id\n"
 
+    , testCase ".hlint.yaml fixity rules are applied" $ runHlintSession "fixity" $ do
+        doc <- openDoc "FixityUse.hs" "haskell"
+        expectNoMoreDiagnostics 3 doc "hlint"
+
     , testCase "changing document contents updates hlint diagnostics" $ runHlintSession "" $ do
         doc <- openDoc "Base.hs" "haskell"
         testHlintDiagnostics doc

plugins/hls-hlint-plugin/test/testdata/fixity/.hlint.yaml

@@ -0,0 +1 @@
+- fixity: "infixl 3 <!>"

plugins/hls-hlint-plugin/test/testdata/fixity/FixityDef.hs

@@ -0,0 +1,5 @@
+module FixityDef where
+
+infixl 3 <!>
+(<!>) :: Maybe a -> Maybe (Maybe b) -> Maybe String
+(<!>) a b = Nothing

plugins/hls-hlint-plugin/test/testdata/fixity/FixityUse.hs

@@ -0,0 +1,6 @@
+module FixityUse where
+
+import FixityDef
+
+foo :: Char -> Maybe Int -> Maybe String
+foo c mInt = show <$> mInt <!> pure <$> Just c

plugins/hls-hlint-plugin/test/testdata/fixity/hie.yaml

@@ -0,0 +1,6 @@
+cradle:
+  direct:
+    arguments:
+      - "FixityDef"
+      - "FixityUse"
+