Skip to content

Commit 16912cc

Browse files
fendorfendor
authored
Add cabal-gild as a cabal file formatter plugin (#4101)
* Add cabal-gild as a cabal file formatter plugin * Add support for multiple cabal formatters In addition, allow different cabal file formatter provider to specify an explicit file path, instead of searching only on $PATH. * Fix cabal formatter test flags
1 parent 03d418c commit 16912cc

26 files changed

+482
-18
lines changed

‎.github/workflows/test.yml

+4
Original file line numberDiff line numberDiff line change
@@ -230,6 +230,10 @@ jobs:
230230
name: Test hls-cabal-fmt-plugin test suite
231231
run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests
232232

233+
- if: matrix.test
234+
name: Test hls-cabal-gild-plugin test suite
235+
run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests || cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests
236+
233237
- if: matrix.test
234238
name: Test hls-cabal-plugin test suite
235239
run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests

‎CODEOWNERS

+4-3
Original file line numberDiff line numberDiff line change
@@ -14,10 +14,11 @@
1414
# Plugins
1515
/plugins/hls-alternate-number-format-plugin @drsooch
1616
/plugins/hls-cabal-fmt-plugin @VeryMilkyJoe @fendor
17+
/plugins/hls-cabal-gild-plugin @fendor
1718
/plugins/hls-cabal-plugin @fendor
1819
/plugins/hls-call-hierarchy-plugin @July541
1920
/plugins/hls-change-type-signature-plugin
20-
/plugins/hls-class-plugin
21+
/plugins/hls-class-plugin
2122
/plugins/hls-code-range-plugin @kokobd
2223
/plugins/hls-eval-plugin
2324
/plugins/hls-explicit-fixity-plugin
@@ -34,7 +35,7 @@
3435
/plugins/hls-pragmas-plugin @eddiemundo
3536
/plugins/hls-qualify-imported-names-plugin @eddiemundo
3637
/plugins/hls-refactor-plugin @santiweight
37-
/plugins/hls-rename-plugin
38+
/plugins/hls-rename-plugin
3839
/plugins/hls-retrie-plugin @pepeiborra
3940
/plugins/hls-semantic-tokens-plugin @soulomoon
4041
/plugins/hls-splice-plugin @konn
@@ -49,7 +50,7 @@
4950
/docs @michaelpj
5051

5152
# CI
52-
/.circleci
53+
/.circleci
5354
/.github @michaelpj @fendor
5455

5556
# Build

‎haskell-language-server.cabal

+53
Original file line numberDiff line numberDiff line change
@@ -146,6 +146,58 @@ test-suite hls-cabal-fmt-plugin-tests
146146

147147
if flag(isolateCabalfmtTests)
148148
build-tool-depends: cabal-fmt:cabal-fmt ^>=0.1.6
149+
cpp-options: -Dhls_isolate_cabalfmt_tests
150+
151+
-----------------------------
152+
-- cabal-gild plugin
153+
-----------------------------
154+
155+
flag cabalgild
156+
description: Enable cabal-gild plugin
157+
default: True
158+
manual: True
159+
160+
common cabalgild
161+
if flag(cabalgild)
162+
build-depends: haskell-language-server:hls-cabal-gild-plugin
163+
cpp-options: -Dhls_cabalgild
164+
165+
flag isolateCabalGildTests
166+
description: Should tests search for 'cabal-gild' on the $PATH or shall we install it via build-tool-depends?
167+
-- By default, search on the PATH
168+
default: False
169+
manual: True
170+
171+
library hls-cabal-gild-plugin
172+
import: defaults, pedantic, warnings
173+
exposed-modules: Ide.Plugin.CabalGild
174+
hs-source-dirs: plugins/hls-cabal-gild-plugin/src
175+
build-depends:
176+
, base >=4.12 && <5
177+
, directory
178+
, filepath
179+
, ghcide == 2.7.0.0
180+
, hls-plugin-api == 2.7.0.0
181+
, lsp-types
182+
, text
183+
, mtl
184+
, process-extras
185+
186+
test-suite hls-cabal-gild-plugin-tests
187+
import: defaults, pedantic, test-defaults, warnings
188+
type: exitcode-stdio-1.0
189+
hs-source-dirs: plugins/hls-cabal-gild-plugin/test
190+
main-is: Main.hs
191+
build-depends:
192+
, base
193+
, directory
194+
, filepath
195+
, haskell-language-server:hls-cabal-gild-plugin
196+
, hls-test-utils == 2.7.0.0
197+
198+
if flag(isolateCabalGildTests)
199+
build-tool-depends: cabal-gild:cabal-gild ^>=1.1
200+
cpp-options: -Dhls_isolate_cabalgild_tests
149201

150202
-----------------------------
151203
-- cabal plugin
@@ -1699,6 +1751,7 @@ library
16991751
, cabal
17001752
, callHierarchy
17011753
, cabalfmt
1754+
, cabalgild
17021755
, changeTypeSignature
17031756
, class
17041757
, eval

‎hls-plugin-api/src/Ide/Types.hs

+3-1
Original file line numberDiff line numberDiff line change
@@ -178,6 +178,7 @@ instance ToJSON Config where
178178
object [ "checkParents" .= checkParents
179179
, "checkProject" .= checkProject
180180
, "formattingProvider" .= formattingProvider
181+
, "cabalFormattingProvider" .= cabalFormattingProvider
181182
, "maxCompletions" .= maxCompletions
182183
, "plugin" .= Map.mapKeysMonotonic (\(PluginId p) -> p) plugins
183184
]
@@ -189,7 +190,8 @@ instance Default Config where
189190
, formattingProvider = "ormolu"
190191
-- , formattingProvider = "floskell"
191192
-- , formattingProvider = "stylish-haskell"
192-
, cabalFormattingProvider = "cabal-fmt"
193+
, cabalFormattingProvider = "cabal-gild"
194+
-- , cabalFormattingProvider = "cabal-fmt"
193195
-- this string value needs to kept in sync with the value provided in HlsPlugins
194196
, maxCompletions = 40
195197
, plugins = mempty

‎plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs

+23-10
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,6 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE LambdaCase #-}
3+
{-# LANGUAGE OverloadedLabels #-}
24
{-# LANGUAGE OverloadedStrings #-}
35

46
module Ide.Plugin.CabalFmt where
@@ -9,6 +11,7 @@ import Control.Monad.IO.Class
911
import qualified Data.Text as T
1012
import Development.IDE hiding (pluginHandlers)
1113
import Ide.Plugin.Error (PluginError (PluginInternalError, PluginInvalidParams))
14+
import Ide.Plugin.Properties
1215
import Ide.PluginUtils
1316
import Ide.Types
1417
import qualified Language.LSP.Protocol.Lens as L
@@ -24,7 +27,7 @@ data Log
2427
= LogProcessInvocationFailure Int
2528
| LogReadCreateProcessInfo T.Text [String]
2629
| LogInvalidInvocationInfo
27-
| LogCabalFmtNotFound
30+
| LogFormatterBinNotFound FilePath
2831
deriving (Show)
2932

3033
instance Pretty Log where
@@ -35,29 +38,39 @@ instance Pretty Log where
3538
["Invocation of cabal-fmt with arguments" <+> pretty args]
3639
++ ["failed with standard error:" <+> pretty stdErrorOut | not (T.null stdErrorOut)]
3740
LogInvalidInvocationInfo -> "Invocation of cabal-fmt with range was called but is not supported."
38-
LogCabalFmtNotFound -> "Couldn't find executable 'cabal-fmt'"
41+
LogFormatterBinNotFound fp -> "Couldn't find formatter executable 'cabal-fmt' at:" <+> pretty fp
3942

4043
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
4144
descriptor recorder plId =
4245
(defaultCabalPluginDescriptor plId "Provides formatting of cabal files with cabal-fmt")
43-
{ pluginHandlers = mkFormattingHandlers (provider recorder)
46+
{ pluginHandlers = mkFormattingHandlers (provider recorder plId)
47+
, pluginConfigDescriptor = defaultConfigDescriptor{configCustomConfig = mkCustomConfig properties}
4448
}
4549

50+
properties :: Properties '[ 'PropertyKey "path" 'TString]
51+
properties =
52+
emptyProperties
53+
& defineStringProperty
54+
#path
55+
"Set path to 'cabal-fmt' executable"
56+
"cabal-fmt"
57+
4658
-- | Formatter provider of cabal fmt.
4759
-- Formats the given source in either a given Range or the whole Document.
4860
-- If the provider fails an error is returned that can be displayed to the user.
49-
provider :: Recorder (WithPriority Log) -> FormattingHandler IdeState
50-
provider recorder _ _ (FormatRange _) _ _ _ = do
61+
provider :: Recorder (WithPriority Log) -> PluginId -> FormattingHandler IdeState
62+
provider recorder _ _ _ (FormatRange _) _ _ _ = do
5163
logWith recorder Info LogInvalidInvocationInfo
5264
throwError $ PluginInvalidParams "You cannot format a text-range using cabal-fmt."
53-
provider recorder _ide _ FormatText contents nfp opts = do
65+
provider recorder plId ideState _ FormatText contents nfp opts = do
5466
let cabalFmtArgs = [ "--indent", show tabularSize]
55-
x <- liftIO $ findExecutable "cabal-fmt"
67+
cabalFmtExePath <- fmap T.unpack $ liftIO $ runAction "cabal-gild" ideState $ usePropertyAction #path plId properties
68+
x <- liftIO $ findExecutable cabalFmtExePath
5669
case x of
5770
Just _ -> do
5871
(exitCode, out, err) <-
5972
liftIO $ Process.readCreateProcessWithExitCode
60-
( proc "cabal-fmt" cabalFmtArgs
73+
( proc cabalFmtExePath cabalFmtArgs
6174
)
6275
{ cwd = Just $ takeDirectory fp
6376
}
@@ -71,8 +84,8 @@ provider recorder _ide _ FormatText contents nfp opts = do
7184
let fmtDiff = makeDiffTextEdit contents out
7285
pure $ InL fmtDiff
7386
Nothing -> do
74-
log Error LogCabalFmtNotFound
75-
throwError (PluginInternalError "No installation of cabal-fmt could be found. Please install it into your global environment.")
87+
log Error $ LogFormatterBinNotFound cabalFmtExePath
88+
throwError (PluginInternalError "No installation of cabal-gild could be found. Please install it globally, or provide the full path to the executable")
7689
where
7790
fp = fromNormalizedFilePath nfp
7891
tabularSize = opts ^. L.tabSize

‎plugins/hls-cabal-fmt-plugin/test/Main.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import Test.Hls
1212
data CabalFmtFound = Found | NotFound
1313

1414
isTestIsolated :: Bool
15-
#if isolateTests
15+
#if hls_isolate_cabalfmt_tests
1616
isTestIsolated = True
1717
#else
1818
isTestIsolated = False
@@ -21,7 +21,7 @@ isTestIsolated = False
2121
isCabalFmtFound :: IO CabalFmtFound
2222
isCabalFmtFound = case isTestIsolated of
2323
True -> pure Found
24-
False-> do
24+
False -> do
2525
cabalFmt <- findExecutable "cabal-fmt"
2626
pure $ maybe NotFound (const Found) cabalFmt
2727

@@ -51,7 +51,7 @@ cabalFmtGolden :: CabalFmtFound -> TestName -> FilePath -> FilePath -> (TextDocu
5151
cabalFmtGolden NotFound title _ _ _ =
5252
testCase title $
5353
assertFailure $ "Couldn't find cabal-fmt on PATH or this is not an isolated run. "
54-
<> "Use cabal flag 'isolateTests' to make it isolated or install cabal-fmt locally."
54+
<> "Use cabal flag 'isolateCabalFmtTests' to make it isolated or install cabal-fmt locally."
5555
cabalFmtGolden Found title path desc act = goldenWithCabalDocFormatter def cabalFmtPlugin "cabal-fmt" conf title testDataDir path desc "cabal" act
5656
where
5757
conf = def

‎plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs

+92
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE LambdaCase #-}
3+
{-# LANGUAGE OverloadedLabels #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
6+
module Ide.Plugin.CabalGild where
7+
8+
import Control.Monad.Except (throwError)
9+
import Control.Monad.IO.Class
10+
import qualified Data.Text as T
11+
import Development.IDE hiding (pluginHandlers)
12+
import Ide.Plugin.Error (PluginError (PluginInternalError, PluginInvalidParams))
13+
import Ide.Plugin.Properties
14+
import Ide.PluginUtils
15+
import Ide.Types
16+
import Language.LSP.Protocol.Types
17+
import Prelude hiding (log)
18+
import System.Directory
19+
import System.Exit
20+
import System.FilePath
21+
import System.Process.ListLike
22+
import qualified System.Process.Text as Process
23+
24+
data Log
25+
= LogProcessInvocationFailure Int T.Text
26+
| LogReadCreateProcessInfo [String]
27+
| LogInvalidInvocationInfo
28+
| LogFormatterBinNotFound FilePath
29+
deriving (Show)
30+
31+
instance Pretty Log where
32+
pretty = \case
33+
LogProcessInvocationFailure exitCode err ->
34+
vcat
35+
[ "Invocation of cabal-gild failed with code" <+> pretty exitCode
36+
, "Stderr:" <+> pretty err
37+
]
38+
LogReadCreateProcessInfo args ->
39+
"Formatter invocation: cabal-gild " <+> pretty args
40+
LogInvalidInvocationInfo -> "Invocation of cabal-gild with range was called but is not supported."
41+
LogFormatterBinNotFound fp -> "Couldn't find formatter executable 'cabal-gild' at:" <+> pretty fp
42+
43+
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
44+
descriptor recorder plId =
45+
(defaultCabalPluginDescriptor plId "Provides formatting of cabal files with cabal-gild")
46+
{ pluginHandlers = mkFormattingHandlers (provider recorder plId)
47+
, pluginConfigDescriptor = defaultConfigDescriptor{configCustomConfig = mkCustomConfig properties}
48+
}
49+
50+
properties :: Properties '[ 'PropertyKey "path" 'TString]
51+
properties =
52+
emptyProperties
53+
& defineStringProperty
54+
#path
55+
"Set path to 'cabal-gild' executable"
56+
"cabal-gild"
57+
58+
-- | Formatter provider of cabal gild.
59+
-- Formats the given source in either a given Range or the whole Document.
60+
-- If the provider fails an error is returned that can be displayed to the user.
61+
provider :: Recorder (WithPriority Log) -> PluginId -> FormattingHandler IdeState
62+
provider recorder _ _ _ (FormatRange _) _ _ _ = do
63+
logWith recorder Info LogInvalidInvocationInfo
64+
throwError $ PluginInvalidParams "You cannot format a text-range using cabal-gild."
65+
provider recorder plId ideState _ FormatText contents nfp _ = do
66+
let cabalGildArgs = ["--stdin=" <> fp, "--input=-"] -- < Read from stdin
67+
68+
cabalGildExePath <- fmap T.unpack $ liftIO $ runAction "cabal-gild" ideState $ usePropertyAction #path plId properties
69+
x <- liftIO $ findExecutable cabalGildExePath
70+
case x of
71+
Just _ -> do
72+
log Debug $ LogReadCreateProcessInfo cabalGildArgs
73+
(exitCode, out, err) <-
74+
liftIO $ Process.readCreateProcessWithExitCode
75+
( proc cabalGildExePath cabalGildArgs
76+
)
77+
{ cwd = Just $ takeDirectory fp
78+
}
79+
contents
80+
case exitCode of
81+
ExitFailure code -> do
82+
log Error $ LogProcessInvocationFailure code err
83+
throwError (PluginInternalError "Failed to invoke cabal-gild")
84+
ExitSuccess -> do
85+
let fmtDiff = makeDiffTextEdit contents out
86+
pure $ InL fmtDiff
87+
Nothing -> do
88+
log Error $ LogFormatterBinNotFound cabalGildExePath
89+
throwError (PluginInternalError "No installation of cabal-gild could be found. Please install it globally, or provide the full path to the executable.")
90+
where
91+
fp = fromNormalizedFilePath nfp
92+
log = logWith recorder

‎plugins/hls-cabal-gild-plugin/test/Main.hs

+58
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
module Main
4+
( main
5+
) where
6+
7+
import qualified Ide.Plugin.CabalGild as CabalGild
8+
import System.Directory (findExecutable)
9+
import System.FilePath
10+
import Test.Hls
11+
12+
data CabalGildFound = Found | NotFound
13+
14+
isTestIsolated :: Bool
15+
#if hls_isolate_cabalgild_tests
16+
isTestIsolated = True
17+
#else
18+
isTestIsolated = False
19+
#endif
20+
21+
isCabalFmtFound :: IO CabalGildFound
22+
isCabalFmtFound = case isTestIsolated of
23+
True -> pure Found
24+
False -> do
25+
cabalGild <- findExecutable "cabal-gild"
26+
pure $ maybe NotFound (const Found) cabalGild
27+
28+
main :: IO ()
29+
main = do
30+
foundCabalFmt <- isCabalFmtFound
31+
defaultTestRunner (tests foundCabalFmt)
32+
33+
cabalGildPlugin :: PluginTestDescriptor CabalGild.Log
34+
cabalGildPlugin = mkPluginTestDescriptor CabalGild.descriptor "cabal-gild"
35+
36+
tests :: CabalGildFound -> TestTree
37+
tests found = testGroup "cabal-gild"
38+
[ cabalGildGolden found "formats a simple document" "simple_testdata" "formatted_document" $ \doc -> do
39+
formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing)
40+
41+
, cabalGildGolden found "formats a document with expand:src comment" "commented_testdata" "formatted_document" $ \doc -> do
42+
formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing)
43+
44+
, cabalGildGolden found "formats a document with lib information" "lib_testdata" "formatted_document" $ \doc -> do
45+
formatDoc doc (FormattingOptions 10 True Nothing Nothing Nothing)
46+
]
47+
48+
cabalGildGolden :: CabalGildFound -> TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
49+
cabalGildGolden NotFound title _ _ _ =
50+
testCase title $
51+
assertFailure $ "Couldn't find cabal-gild on PATH or this is not an isolated run. "
52+
<> "Use cabal flag 'isolateCabalGildTests' to make it isolated or install cabal-gild locally."
53+
cabalGildGolden Found title path desc act = goldenWithCabalDocFormatter def cabalGildPlugin "cabal-gild" conf title testDataDir path desc "cabal" act
54+
where
55+
conf = def
56+
57+
testDataDir :: FilePath
58+
testDataDir = "plugins" </> "hls-cabal-gild-plugin" </> "test" </> "testdata"

0 commit comments

Comments
 (0)