Skip to content

Commit 4b344d3

Browse files
Add support for Fourmolu 0.16 (#4314)
1 parent 426b068 commit 4b344d3

File tree

4 files changed

+65
-42
lines changed

4 files changed

+65
-42
lines changed

.github/workflows/test.yml

+1-2
Original file line numberDiff line numberDiff line change
@@ -177,8 +177,7 @@ jobs:
177177
name: Test hls-ormolu-plugin
178178
run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests
179179

180-
# TODO enable when it supports 9.10
181-
- if: matrix.test && matrix.ghc != '9.10'
180+
- if: matrix.test
182181
name: Test hls-fourmolu-plugin
183182
run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests
184183

cabal.project

+2-3
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ packages:
77
./hls-plugin-api
88
./hls-test-utils
99

10-
index-state: 2024-06-10T12:08:58Z
10+
index-state: 2024-06-13T17:12:34Z
1111

1212
tests: True
1313
test-show-details: direct
@@ -49,10 +49,9 @@ if impl(ghc >= 9.9)
4949
lens >= 5.3.2,
5050
-- See
5151
-- https://github.com/haskell/stylish-haskell/issues/479
52-
-- https://github.com/fourmolu/fourmolu/issues/412
5352
-- https://github.com/ennocramer/floskell/pull/82
5453
-- https://github.com/ndmitchell/hlint/pull/1594
55-
haskell-language-server -stylishHaskell -fourmolu -hlint -retrie -splice -floskell,
54+
haskell-language-server -stylishHaskell -hlint -retrie -splice -floskell,
5655
allow-newer:
5756
entropy:base,
5857
entropy:directory,

haskell-language-server.cabal

+2-2
Original file line numberDiff line numberDiff line change
@@ -1460,7 +1460,7 @@ library hls-fourmolu-plugin
14601460
build-depends:
14611461
, base >=4.12 && <5
14621462
, filepath
1463-
, fourmolu ^>= 0.14 || ^>= 0.15
1463+
, fourmolu ^>= 0.14 || ^>= 0.15 || ^>= 0.16
14641464
, ghc-boot-th
14651465
, ghcide == 2.8.0.0
14661466
, hls-plugin-api == 2.8.0.0
@@ -1470,7 +1470,7 @@ library hls-fourmolu-plugin
14701470
, process-extras >= 0.7.1
14711471
, text
14721472
, transformers
1473-
1473+
, yaml
14741474

14751475
test-suite hls-fourmolu-plugin-tests
14761476
import: defaults, pedantic, test-defaults, warnings

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

+60-35
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import Data.List (intercalate)
2323
import Data.Maybe (catMaybes)
2424
import Data.Text (Text)
2525
import qualified Data.Text as T
26+
import Data.Version (showVersion)
2627
import Development.IDE hiding (pluginHandlers)
2728
import Development.IDE.GHC.Compat as Compat hiding (Cpp, Warning,
2829
hang, vcat)
@@ -38,20 +39,25 @@ import Language.LSP.Protocol.Types
3839
import Language.LSP.Server hiding (defaultConfig)
3940
import Ormolu
4041
import Ormolu.Config
42+
import qualified Paths_fourmolu as Fourmolu
4143
import System.Exit
4244
import System.FilePath
4345
import System.Process.Run (cwd, proc)
4446
import System.Process.Text (readCreateProcessWithExitCode)
4547
import Text.Read (readMaybe)
4648

49+
#if MIN_VERSION_fourmolu(0,16,0)
50+
import qualified Data.Yaml as Yaml
51+
#endif
52+
4753
descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState
4854
descriptor recorder plId =
4955
(defaultPluginDescriptor plId desc)
5056
{ pluginHandlers = mkFormattingHandlers $ provider recorder plId
5157
, pluginConfigDescriptor = defaultConfigDescriptor{configCustomConfig = mkCustomConfig properties}
5258
}
5359
where
54-
desc = "Provides formatting of Haskell files via fourmolu. Built with fourmolu-" <> VERSION_fourmolu
60+
desc = T.pack $ "Provides formatting of Haskell files via fourmolu. Built with fourmolu-" <> showVersion Fourmolu.version
5561

5662
properties :: Properties '[ 'PropertyKey "external" 'TBoolean, 'PropertyKey "path" 'TString]
5763
properties =
@@ -77,36 +83,17 @@ provider recorder plId ideState token typ contents fp fo = ExceptT $ pluginWithI
7783
handle @IOException (pure . Left . PluginInternalError . T.pack . show) $
7884
runExceptT (cliHandler fourmoluExePath fileOpts)
7985
else do
80-
logWith recorder Debug $ LogCompiledInVersion VERSION_fourmolu
81-
FourmoluConfig{..} <-
82-
liftIO (loadConfigFile fp') >>= \case
83-
ConfigLoaded file opts -> do
84-
logWith recorder Info $ ConfigPath file
85-
pure opts
86-
ConfigNotFound searchDirs -> do
87-
logWith recorder Info $ NoConfigPath searchDirs
88-
pure emptyConfig
89-
ConfigParseError f err -> do
90-
lift $ pluginSendNotification SMethod_WindowShowMessage $
91-
ShowMessageParams
92-
{ _type_ = MessageType_Error
93-
, _message = errorMessage
94-
}
95-
throwError $ PluginInternalError errorMessage
96-
where
97-
errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (show err)
98-
86+
logWith recorder Debug $ LogCompiledInVersion (showVersion Fourmolu.version)
87+
FourmoluConfig{..} <- loadConfig recorder fp'
9988
let config =
100-
#if MIN_VERSION_fourmolu(0,13,0)
101-
refineConfig ModuleSource Nothing Nothing Nothing
102-
#endif
103-
defaultConfig
104-
{ cfgDynOptions = map DynOption fileOpts
105-
, cfgFixityOverrides = cfgFileFixities
106-
, cfgRegion = region
107-
, cfgDebug = False
108-
, cfgPrinterOpts = resolvePrinterOpts [lspPrinterOpts, cfgFilePrinterOpts]
109-
}
89+
refineConfig ModuleSource Nothing Nothing Nothing $
90+
defaultConfig
91+
{ cfgDynOptions = map DynOption fileOpts
92+
, cfgFixityOverrides = cfgFileFixities
93+
, cfgRegion = region
94+
, cfgDebug = False
95+
, cfgPrinterOpts = resolvePrinterOpts [lspPrinterOpts, cfgFilePrinterOpts]
96+
}
11097
ExceptT . liftIO $
11198
bimap (PluginInternalError . T.pack . show) (InL . makeDiffTextEdit contents)
11299
<$> try @OrmoluException (ormolu config fp' contents)
@@ -158,6 +145,49 @@ provider recorder plId ideState token typ contents fp fo = ExceptT $ pluginWithI
158145
logWith recorder Info $ StdErr err
159146
throwError $ PluginInternalError $ "Fourmolu failed with exit code " <> T.pack (show n)
160147

148+
loadConfig ::
149+
Recorder (WithPriority LogEvent) ->
150+
FilePath ->
151+
ExceptT PluginError (HandlerM Ide.Types.Config) FourmoluConfig
152+
#if MIN_VERSION_fourmolu(0,16,0)
153+
loadConfig recorder fp = do
154+
liftIO (findConfigFile fp) >>= \case
155+
Left (ConfigNotFound searchDirs) -> do
156+
logWith recorder Info $ NoConfigPath searchDirs
157+
pure emptyConfig
158+
Right file -> do
159+
logWith recorder Info $ ConfigPath file
160+
liftIO (Yaml.decodeFileEither file) >>= \case
161+
Left err -> do
162+
let errorMessage = "Failed to load " <> T.pack file <> ": " <> T.pack (show err)
163+
lift $ pluginSendNotification SMethod_WindowShowMessage $
164+
ShowMessageParams
165+
{ _type_ = MessageType_Error
166+
, _message = errorMessage
167+
}
168+
throwError $ PluginInternalError errorMessage
169+
Right cfg -> do
170+
pure cfg
171+
#else
172+
loadConfig recorder fp = do
173+
liftIO (loadConfigFile fp) >>= \case
174+
ConfigLoaded file opts -> do
175+
logWith recorder Info $ ConfigPath file
176+
pure opts
177+
ConfigNotFound searchDirs -> do
178+
logWith recorder Info $ NoConfigPath searchDirs
179+
pure emptyConfig
180+
ConfigParseError f err -> do
181+
lift $ pluginSendNotification SMethod_WindowShowMessage $
182+
ShowMessageParams
183+
{ _type_ = MessageType_Error
184+
, _message = errorMessage
185+
}
186+
throwError $ PluginInternalError errorMessage
187+
where
188+
errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (show err)
189+
#endif
190+
161191
data LogEvent
162192
= NoVersion Text
163193
| ConfigPath FilePath
@@ -197,8 +227,3 @@ newtype CLIVersionInfo = CLIVersionInfo
197227

198228
mwhen :: Monoid a => Bool -> a -> a
199229
mwhen b x = if b then x else mempty
200-
201-
#if !MIN_VERSION_fourmolu(0,14,0)
202-
resolvePrinterOpts :: [PrinterOptsPartial] -> PrinterOptsTotal
203-
resolvePrinterOpts = foldr fillMissingPrinterOpts defaultPrinterOpts
204-
#endif

0 commit comments

Comments
 (0)