Make the Ormolu plugin respect .ormolu fixity files

Author: amesgen

cabal.project

@@ -37,6 +37,13 @@ packages:
          ./plugins/hls-explicit-record-fields-plugin
          ./plugins/hls-refactor-plugin
 
+if impl(ghc >= 9.2)
+   -- https://github.com/tweag/ormolu/pull/976
+  source-repository-package
+    type: git
+    location: https://github.com/amesgen/ormolu
+    tag: 2f58c257819793f2c980adc5869dd761342d6f3c
+
 -- Standard location for temporary packages needed for particular environments
 -- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script
 -- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml

plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal

@@ -15,6 +15,8 @@ build-type:         Simple
 extra-source-files:
   LICENSE
   test/testdata/**/*.hs
+  test/testdata/.ormolu
+  test/testdata/test.cabal
 
 source-repository head
     type:     git
@@ -32,7 +34,7 @@ library
     , hls-plugin-api  ^>=1.3 || ^>=1.4 || ^>= 1.5 || ^>= 1.6
     , lens
     , lsp
-    , ormolu          ^>=0.1.2 || ^>= 0.2 || ^>= 0.3 || ^>= 0.5
+    , ormolu          ^>=0.1.2 || ^>= 0.2 || ^>= 0.3 || ^>= 0.5 || ^>= 0.6
     , text
 
   default-language: Haskell2010
@@ -49,3 +51,4 @@ test-suite tests
     , hls-ormolu-plugin
     , hls-test-utils     ^>=1.5
     , lsp-types
+    , ormolu

plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications  #-}
 
@@ -7,8 +9,10 @@ module Ide.Plugin.Ormolu
   )
 where
 
-import           Control.Exception               (try)
+import           Control.Exception               (Handler (..), IOException,
+                                                  SomeException (..), catches)
 import           Control.Monad.IO.Class          (liftIO)
+import           Data.Functor                    ((<&>))
 import qualified Data.Text                       as T
 import           Development.IDE                 hiding (pluginHandlers)
 import           Development.IDE.GHC.Compat      (hsc_dflags, moduleNameString)
@@ -43,9 +47,26 @@ provider ideState typ contents fp _ = withIndefiniteProgress title Cancellable $
     fullRegion = RegionIndices Nothing Nothing
     rangeRegion s e = RegionIndices (Just $ s + 1) (Just $ e + 1)
     mkConf o region = defaultConfig { cfgDynOptions = o, cfgRegion = region }
-    fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text)
-    fmt cont conf =
-      try @OrmoluException $ ormolu conf (fromNormalizedFilePath fp) $ T.unpack cont
+    fmt :: T.Text -> Config RegionIndices -> IO (Either SomeException T.Text)
+    fmt cont conf = flip catches handlers $ do
+      let fp' = fromNormalizedFilePath fp
+#if MIN_VERSION_ormolu(0,5,3)
+      cabalInfo <- getCabalInfoForSourceFile fp' <&> \case
+        CabalNotFound                -> Nothing
+        CabalDidNotMention cabalInfo -> Just cabalInfo
+        CabalFound cabalInfo         -> Just cabalInfo
+      fixityOverrides <- traverse getFixityOverridesForSourceFile cabalInfo
+      let conf' = refineConfig ModuleSource cabalInfo fixityOverrides conf
+          cont' = cont
+#else
+      let conf' = conf
+          cont' = T.unpack cont
+#endif
+      Right <$> ormolu conf' fp' cont'
+    handlers =
+      [ Handler $ pure . Left . SomeException @OrmoluException
+      , Handler $ pure . Left . SomeException @IOException
+      ]
 
   case typ of
     FormatText -> ret <$> fmt contents (mkConf fileOpts fullRegion)
@@ -54,7 +75,7 @@ provider ideState typ contents fp _ = withIndefiniteProgress title Cancellable $
  where
    title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp)
 
-   ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit)
+   ret :: Either SomeException T.Text -> Either ResponseError (List TextEdit)
    ret (Left err)  = Left . responseError . T.pack $ "ormoluCmd: " ++ show err
    ret (Right new) = Right $ makeDiffTextEdit contents new
 

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Main
   ( main
@@ -20,6 +21,10 @@ tests = testGroup "ormolu"
       formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)
   , goldenWithOrmolu "formats imports correctly" "Ormolu2" "formatted" $ \doc -> do
       formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)
+#if MIN_VERSION_ormolu(0,6,0)
+  , goldenWithOrmolu "formats operators correctly" "Ormolu3" "formatted" $ \doc -> do
+      formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)
+#endif
   ]
 
 goldenWithOrmolu :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree

plugins/hls-ormolu-plugin/test/testdata/.ormolu

@@ -0,0 +1 @@
+infixl 7 .=?

plugins/hls-ormolu-plugin/test/testdata/Ormolu3.expected.hs

@@ -0,0 +1,5 @@
+foo :: String
+foo =
+  "a" .=? "b"
+    <> "c" .=? "d"
+    <> "e" .=? "f"

plugins/hls-ormolu-plugin/test/testdata/Ormolu3.formatted.hs

@@ -0,0 +1,5 @@
+foo :: String
+foo =
+  "a" .=? "b"
+    <> "c" .=? "d"
+    <> "e" .=? "f"

plugins/hls-ormolu-plugin/test/testdata/Ormolu3.hs

@@ -0,0 +1,3 @@
+foo :: String
+foo = "a" .=? "b"
+    <> "c" .=? "d" <> "e" .=? "f"

plugins/hls-ormolu-plugin/test/testdata/test.cabal

@@ -0,0 +1,3 @@
+cabal-version: 3.0
+name: test
+version: 0