Merge pull request #3078 from brandonchinn178/fourmolu-0.8

Add support for Fourmolu 0.8

Author: georgefst

plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal

@@ -23,13 +23,15 @@ source-repository head
   location: git://github.com/haskell/haskell-language-server.git
 
 library
-  exposed-modules:  Ide.Plugin.Fourmolu
+  exposed-modules:
+      Ide.Plugin.Fourmolu
+    , Ide.Plugin.Fourmolu.Shim
   hs-source-dirs:   src
   ghc-options:      -Wall
   build-depends:
     , base            >=4.12 && <5
     , filepath
-    , fourmolu        ^>=0.3 || ^>=0.4 || ^>= 0.6 || ^>= 0.7
+    , fourmolu        ^>=0.3 || ^>=0.4 || ^>= 0.6 || ^>= 0.7 || ^>= 0.8
     , ghc
     , ghc-boot-th
     , ghcide          ^>=1.7

plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP                      #-}
 {-# LANGUAGE DataKinds                #-}
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE LambdaCase               #-}
@@ -16,7 +15,7 @@ import           Control.Exception               (IOException, try)
 import           Control.Lens                    ((^.))
 import           Control.Monad
 import           Control.Monad.IO.Class
-import           Data.Bifunctor                  (first)
+import           Data.Bifunctor                  (bimap, first)
 import           Data.Maybe
 import           Data.Text                       (Text)
 import qualified Data.Text                       as T
@@ -25,6 +24,7 @@ import           Development.IDE.GHC.Compat      as Compat hiding (Cpp, Warning,
                                                             hang, vcat)
 import qualified Development.IDE.GHC.Compat.Util as S
 import           GHC.LanguageExtensions.Type     (Extension (Cpp))
+import           Ide.Plugin.Fourmolu.Shim
 import           Ide.Plugin.Properties
 import           Ide.PluginUtils                 (makeDiffTextEdit,
                                                   usePropertyLsp)
@@ -33,7 +33,6 @@ import           Language.LSP.Server             hiding (defaultConfig)
 import           Language.LSP.Types              hiding (line)
 import           Language.LSP.Types.Lens         (HasTabSize (tabSize))
 import           Ormolu
-import           Ormolu.Config
 import           System.Exit
 import           System.FilePath
 import           System.Process.Run              (cwd, proc)
@@ -100,17 +99,12 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl
                         pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n)
         else do
             let format fourmoluConfig =
-                    first (mkError . show)
-                        <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents))
+                    bimap (mkError . show) (makeDiffTextEdit contents)
+                        <$> try @OrmoluException (ormolu config fp' (T.unpack contents))
                   where
-                    printerOpts =
-#if MIN_VERSION_fourmolu(0,7,0)
-                        cfgFilePrinterOpts fourmoluConfig
-#else
-                        fourmoluConfig
-
-#endif
+                    printerOpts = cfgFilePrinterOpts fourmoluConfig
                     config =
+                        addFixityOverrides (cfgFileFixities fourmoluConfig) $
                         defaultConfig
                             { cfgDynOptions = map DynOption fileOpts
                             , cfgRegion = region
@@ -119,29 +113,14 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl
                                 fillMissingPrinterOpts
                                     (printerOpts <> lspPrinterOpts)
                                     defaultPrinterOpts
-#if MIN_VERSION_fourmolu(0,7,0)
-                            , cfgFixityOverrides =
-                                cfgFileFixities fourmoluConfig
-#endif
                             }
              in liftIO (loadConfigFile fp') >>= \case
                     ConfigLoaded file opts -> liftIO $ do
                         logWith recorder Info $ ConfigPath file
                         format opts
                     ConfigNotFound searchDirs -> liftIO $ do
                         logWith recorder Info $ NoConfigPath searchDirs
-                        format emptyOptions
-                      where
-                        emptyOptions =
-#if MIN_VERSION_fourmolu(0,7,0)
-                            FourmoluConfig
-                                { cfgFilePrinterOpts = mempty
-                                , cfgFileFixities = mempty
-                                }
-#else
-                            mempty
-#endif
-
+                        format emptyConfig
                     ConfigParseError f err -> do
                         sendNotification SWindowShowMessage $
                             ShowMessageParams
@@ -150,13 +129,7 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl
                                 }
                         return . Left $ responseError errorMessage
                       where
-                        errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (convertErr err)
-                        convertErr =
-#if MIN_VERSION_fourmolu(0,7,0)
-                            show
-#else
-                            snd
-#endif
+                        errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (showParseError err)
   where
     fp' = fromNormalizedFilePath fp
     title = "Formatting " <> T.pack (takeFileName fp')

plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu/Shim.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE CPP #-}
+
+module Ide.Plugin.Fourmolu.Shim (
+  -- * FourmoluConfig
+  cfgFilePrinterOpts,
+  cfgFileFixities,
+  emptyConfig,
+
+  -- * FixityMap
+  addFixityOverrides,
+
+  -- * ConfigParseError
+  showParseError,
+) where
+
+import           Ormolu.Config
+
+#if MIN_VERSION_fourmolu(0,7,0)
+import           Ormolu.Fixity
+#endif
+
+{-- Backport FourmoluConfig --}
+
+#if !MIN_VERSION_fourmolu(0,7,0)
+type FourmoluConfig = PrinterOptsPartial
+
+cfgFilePrinterOpts :: FourmoluConfig -> PrinterOptsPartial
+cfgFilePrinterOpts = id
+
+cfgFileFixities :: FourmoluConfig -> FixityMap
+cfgFileFixities _ = mempty
+#endif
+
+#if MIN_VERSION_fourmolu(0,7,0)
+emptyConfig :: FourmoluConfig
+emptyConfig =
+  FourmoluConfig
+    { cfgFilePrinterOpts = mempty
+    , cfgFileFixities = mempty
+    }
+#else
+emptyConfig :: FourmoluConfig
+emptyConfig = mempty
+#endif
+
+{-- Backport FixityMap --}
+
+#if MIN_VERSION_fourmolu(0,7,0)
+addFixityOverrides :: FixityMap -> Config region -> Config region
+addFixityOverrides fixities cfg = cfg{cfgFixityOverrides = fixities}
+#else
+type FixityMap = ()
+
+addFixityOverrides :: FixityMap -> Config region -> Config region
+addFixityOverrides _ = id
+#endif
+
+{-- Backport ConfigParseError --}
+
+#if MIN_VERSION_fourmolu(0,7,0)
+showParseError :: Show parseException => parseException -> String
+showParseError = show
+#else
+showParseError :: (pos, String) -> String
+showParseError = snd
+#endif