Add support for multiple cabal formatters

fendor · fendor · commit e5fd0f2b877b · 2024-03-10T15:47:18.000+01:00
In addition, allow different cabal file formatter provider to specify an
explicit file path, instead of searching only on $PATH.
diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs
@@ -178,6 +178,7 @@ instance ToJSON Config where
     object [ "checkParents"                .= checkParents
            , "checkProject"                .= checkProject
            , "formattingProvider"          .= formattingProvider
+           , "cabalFormattingProvider"     .= cabalFormattingProvider
            , "maxCompletions"              .= maxCompletions
            , "plugin"                      .= Map.mapKeysMonotonic (\(PluginId p) -> p) plugins
            ]
@@ -189,7 +190,7 @@ instance Default Config where
     , formattingProvider          = "ormolu"
     -- , formattingProvider          = "floskell"
     -- , formattingProvider          = "stylish-haskell"
-    , cabalFormattingProvider     = "gild"
+    , cabalFormattingProvider     = "cabal-gild"
     -- , cabalFormattingProvider     = "cabal-fmt"
     -- this string value needs to kept in sync with the value provided in HlsPlugins
     , maxCompletions              = 40
diff --git a/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs b/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLabels  #-}
+{-# LANGUAGE DataKinds #-}
 
 module Ide.Plugin.CabalFmt where
 
@@ -19,12 +21,13 @@ import           System.Exit
 import           System.FilePath
 import           System.Process.ListLike
 import qualified System.Process.Text         as Process
+import Ide.Plugin.Properties
 
 data Log
   = LogProcessInvocationFailure Int
   | LogReadCreateProcessInfo T.Text [String]
   | LogInvalidInvocationInfo
-  | LogCabalFmtNotFound
+  | LogFormatterBinNotFound FilePath
   deriving (Show)
 
 instance Pretty Log where
@@ -35,29 +38,39 @@ instance Pretty Log where
         ["Invocation of cabal-fmt with arguments" <+> pretty args]
           ++ ["failed with standard error:" <+> pretty stdErrorOut | not (T.null stdErrorOut)]
     LogInvalidInvocationInfo -> "Invocation of cabal-fmt with range was called but is not supported."
-    LogCabalFmtNotFound -> "Couldn't find executable 'cabal-fmt'"
+    LogFormatterBinNotFound fp -> "Couldn't find formatter executable 'cabal-fmt' at:" <+> pretty fp
 
 descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
 descriptor recorder plId =
   (defaultCabalPluginDescriptor plId "Provides formatting of cabal files with cabal-fmt")
-    { pluginHandlers = mkFormattingHandlers (provider recorder)
+    { pluginHandlers = mkFormattingHandlers (provider recorder plId)
+    , pluginConfigDescriptor = defaultConfigDescriptor{configCustomConfig = mkCustomConfig properties}
     }
 
+properties :: Properties '[ 'PropertyKey "path" 'TString]
+properties =
+    emptyProperties
+        & defineStringProperty
+            #path
+            "Set path to 'cabal-fmt' executable"
+            "cabal-fmt"
+
 -- | Formatter provider of cabal fmt.
 -- Formats the given source in either a given Range or the whole Document.
 -- If the provider fails an error is returned that can be displayed to the user.
-provider :: Recorder (WithPriority Log) -> FormattingHandler IdeState
-provider recorder _ _ (FormatRange _) _ _ _ = do
+provider :: Recorder (WithPriority Log) -> PluginId -> FormattingHandler IdeState
+provider recorder _ _ _ (FormatRange _) _ _ _ = do
   logWith recorder Info LogInvalidInvocationInfo
   throwError $ PluginInvalidParams "You cannot format a text-range using cabal-fmt."
-provider recorder _ide _ FormatText contents nfp opts = do
+provider recorder plId ideState _ FormatText contents nfp opts = do
   let cabalFmtArgs = [ "--indent", show tabularSize]
-  x <- liftIO $ findExecutable "cabal-fmt"
+  cabalFmtExePath <- fmap T.unpack $ liftIO $ runAction "cabal-gild" ideState $ usePropertyAction #path plId properties
+  x <- liftIO $ findExecutable cabalFmtExePath
   case x of
     Just _ -> do
       (exitCode, out, err) <-
         liftIO $ Process.readCreateProcessWithExitCode
-          ( proc "cabal-fmt" cabalFmtArgs
+          ( proc cabalFmtExePath cabalFmtArgs
           )
             { cwd = Just $ takeDirectory fp
             }
@@ -71,8 +84,8 @@ provider recorder _ide _ FormatText contents nfp opts = do
           let fmtDiff = makeDiffTextEdit contents out
           pure $ InL fmtDiff
     Nothing -> do
-      log Error LogCabalFmtNotFound
-      throwError (PluginInternalError "No installation of cabal-fmt could be found. Please install it into your global environment.")
+      log Error $ LogFormatterBinNotFound cabalFmtExePath
+      throwError (PluginInternalError "No installation of cabal-gild could be found. Please install it globally, or provide the full path to the executable")
   where
     fp = fromNormalizedFilePath nfp
     tabularSize = opts ^. L.tabSize
diff --git a/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs b/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLabels  #-}
+{-# LANGUAGE DataKinds #-}
 
 module Ide.Plugin.CabalGild where
 
@@ -17,12 +19,13 @@ import           System.Exit
 import           System.FilePath
 import           System.Process.ListLike
 import qualified System.Process.Text         as Process
+import Ide.Plugin.Properties
 
 data Log
   = LogProcessInvocationFailure Int T.Text
   | LogReadCreateProcessInfo [String]
   | LogInvalidInvocationInfo
-  | LogFormatterBinNotFound
+  | LogFormatterBinNotFound FilePath
   deriving (Show)
 
 instance Pretty Log where
@@ -35,30 +38,41 @@ instance Pretty Log where
     LogReadCreateProcessInfo args ->
       "Formatter invocation: cabal-gild " <+> pretty args
     LogInvalidInvocationInfo -> "Invocation of cabal-gild with range was called but is not supported."
-    LogFormatterBinNotFound -> "Couldn't find executable 'cabal-gild'"
+    LogFormatterBinNotFound fp -> "Couldn't find formatter executable 'cabal-gild' at:" <+> pretty fp
 
 descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
 descriptor recorder plId =
   (defaultCabalPluginDescriptor plId "Provides formatting of cabal files with cabal-gild")
-    { pluginHandlers = mkFormattingHandlers (provider recorder)
+    { pluginHandlers = mkFormattingHandlers (provider recorder plId)
+    , pluginConfigDescriptor = defaultConfigDescriptor{configCustomConfig = mkCustomConfig properties}
     }
 
+properties :: Properties '[ 'PropertyKey "path" 'TString]
+properties =
+    emptyProperties
+        & defineStringProperty
+            #path
+            "Set path to 'cabal-gild' executable"
+            "cabal-gild"
+
 -- | Formatter provider of cabal gild.
 -- Formats the given source in either a given Range or the whole Document.
 -- If the provider fails an error is returned that can be displayed to the user.
-provider :: Recorder (WithPriority Log) -> FormattingHandler IdeState
-provider recorder _ _ (FormatRange _) _ _ _ = do
+provider :: Recorder (WithPriority Log) -> PluginId -> FormattingHandler IdeState
+provider recorder _ _ _ (FormatRange _) _ _ _ = do
   logWith recorder Info LogInvalidInvocationInfo
   throwError $ PluginInvalidParams "You cannot format a text-range using cabal-gild."
-provider recorder _ide _ FormatText contents nfp _ = do
+provider recorder plId ideState _ FormatText contents nfp _ = do
   let cabalGildArgs = ["--stdin=" <> fp, "--input=-"] -- < Read from stdin
-  x <- liftIO $ findExecutable "cabal-gild"
+
+  cabalGildExePath <- fmap T.unpack $ liftIO $ runAction "cabal-gild" ideState $ usePropertyAction #path plId properties
+  x <- liftIO $ findExecutable cabalGildExePath
   case x of
     Just _ -> do
       log Debug $ LogReadCreateProcessInfo cabalGildArgs
       (exitCode, out, err) <-
         liftIO $ Process.readCreateProcessWithExitCode
-          ( proc "cabal-gild" cabalGildArgs
+          ( proc cabalGildExePath cabalGildArgs
           )
             { cwd = Just $ takeDirectory fp
             }
@@ -71,8 +85,8 @@ provider recorder _ide _ FormatText contents nfp _ = do
           let fmtDiff = makeDiffTextEdit contents out
           pure $ InL fmtDiff
     Nothing -> do
-      log Error LogFormatterBinNotFound
-      throwError (PluginInternalError "No installation of cabal-gild could be found. Please install it into your global environment.")
+      log Error $ LogFormatterBinNotFound cabalGildExePath
+      throwError (PluginInternalError "No installation of cabal-gild could be found. Please install it globally, or provide the full path to the executable.")
   where
     fp = fromNormalizedFilePath nfp
     log = logWith recorder
diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json
@@ -12,6 +12,16 @@
             "completionOn": true,
             "diagnosticsOn": true
         },
+        "cabal-fmt": {
+            "config": {
+                "path": "cabal-fmt"
+            }
+        },
+        "cabal-gild": {
+            "config": {
+                "path": "cabal-gild"
+            }
+        },
         "callHierarchy": {
             "globalOn": true
         },
diff --git a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json
@@ -5,6 +5,18 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.cabal-fmt.config.path": {
+        "default": "cabal-fmt",
+        "markdownDescription": "Set path to 'cabal-fmt' executable",
+        "scope": "resource",
+        "type": "string"
+    },
+    "haskell.plugin.cabal-gild.config.path": {
+        "default": "cabal-gild",
+        "markdownDescription": "Set path to 'cabal-gild' executable",
+        "scope": "resource",
+        "type": "string"
+    },
     "haskell.plugin.cabal.codeActionsOn": {
         "default": true,
         "description": "Enables cabal code actions",
diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json
@@ -12,6 +12,16 @@
             "completionOn": true,
             "diagnosticsOn": true
         },
+        "cabal-fmt": {
+            "config": {
+                "path": "cabal-fmt"
+            }
+        },
+        "cabal-gild": {
+            "config": {
+                "path": "cabal-gild"
+            }
+        },
         "callHierarchy": {
             "globalOn": true
         },
diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json
@@ -5,6 +5,18 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.cabal-fmt.config.path": {
+        "default": "cabal-fmt",
+        "markdownDescription": "Set path to 'cabal-fmt' executable",
+        "scope": "resource",
+        "type": "string"
+    },
+    "haskell.plugin.cabal-gild.config.path": {
+        "default": "cabal-gild",
+        "markdownDescription": "Set path to 'cabal-gild' executable",
+        "scope": "resource",
+        "type": "string"
+    },
     "haskell.plugin.cabal.codeActionsOn": {
         "default": true,
         "description": "Enables cabal code actions",
diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json
@@ -1,4 +1,5 @@
 {
+    "cabalFormattingProvider": "cabal-gild",
     "checkParents": "CheckOnSave",
     "checkProject": true,
     "formattingProvider": "ormolu",
@@ -12,6 +13,16 @@
             "completionOn": true,
             "diagnosticsOn": true
         },
+        "cabal-fmt": {
+            "config": {
+                "path": "cabal-fmt"
+            }
+        },
+        "cabal-gild": {
+            "config": {
+                "path": "cabal-gild"
+            }
+        },
         "callHierarchy": {
             "globalOn": true
         },
diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json
@@ -5,6 +5,18 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.cabal-fmt.config.path": {
+        "default": "cabal-fmt",
+        "markdownDescription": "Set path to 'cabal-fmt' executable",
+        "scope": "resource",
+        "type": "string"
+    },
+    "haskell.plugin.cabal-gild.config.path": {
+        "default": "cabal-gild",
+        "markdownDescription": "Set path to 'cabal-gild' executable",
+        "scope": "resource",
+        "type": "string"
+    },
     "haskell.plugin.cabal.codeActionsOn": {
         "default": true,
         "description": "Enables cabal code actions",
diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json
@@ -12,6 +12,16 @@
             "completionOn": true,
             "diagnosticsOn": true
         },
+        "cabal-fmt": {
+            "config": {
+                "path": "cabal-fmt"
+            }
+        },
+        "cabal-gild": {
+            "config": {
+                "path": "cabal-gild"
+            }
+        },
         "callHierarchy": {
             "globalOn": true
         },
diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json
@@ -5,6 +5,18 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.cabal-fmt.config.path": {
+        "default": "cabal-fmt",
+        "markdownDescription": "Set path to 'cabal-fmt' executable",
+        "scope": "resource",
+        "type": "string"
+    },
+    "haskell.plugin.cabal-gild.config.path": {
+        "default": "cabal-gild",
+        "markdownDescription": "Set path to 'cabal-gild' executable",
+        "scope": "resource",
+        "type": "string"
+    },
     "haskell.plugin.cabal.codeActionsOn": {
         "default": true,
         "description": "Enables cabal code actions",
