Skip to content

Commit 09968a1

Browse files
georgefstgeorgefst
authored
More Fourmolu improvements (#2959)
* Use proper structured logging for Fourmolu Previously we just printed directly to stdout and stderr. * Don't run Fourmolu in debug mode It prints to stderr, due to uses of `traceM`, and it's not nice to work around this downstream. It's of questionable utility anyway. The fact that it mostly prints information about extensions, and does so in a hard-to-read format (a string displayed as a list!) indicates that it probably isn't widely used. * Fourmolu: parse strings to integers before comparing versions Whoever originally wrote this (😳) had clearly had one too many beers the night before: `show @Int` is not monotonic since e.g. "10" < "2".
1 parent e64b61e commit 09968a1

File tree

3 files changed

+38
-25
lines changed

3 files changed

+38
-25
lines changed

Diff for: ‎exe/Plugins.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -136,7 +136,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
136136
Floskell.descriptor "floskell" :
137137
#endif
138138
#if fourmolu
139-
Fourmolu.descriptor "fourmolu" :
139+
Fourmolu.descriptor pluginRecorder "fourmolu" :
140140
#endif
141141
#if tactic
142142
Tactic.descriptor pluginRecorder "tactics" :

Diff for: ‎plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs

+36-23
Original file line numberDiff line numberDiff line change
@@ -18,31 +18,32 @@ import Control.Monad
1818
import Control.Monad.IO.Class
1919
import Data.Bifunctor (first)
2020
import Data.Maybe
21+
import Data.Text (Text)
2122
import qualified Data.Text as T
22-
import qualified Data.Text.IO as T
2323
import Development.IDE hiding (pluginHandlers)
24-
import Development.IDE.GHC.Compat as Compat hiding (Cpp)
24+
import Development.IDE.GHC.Compat as Compat hiding (Cpp, Warning,
25+
hang, vcat)
2526
import qualified Development.IDE.GHC.Compat.Util as S
2627
import GHC.LanguageExtensions.Type (Extension (Cpp))
2728
import Ide.Plugin.Properties
2829
import Ide.PluginUtils (makeDiffTextEdit,
2930
usePropertyLsp)
3031
import Ide.Types
3132
import Language.LSP.Server hiding (defaultConfig)
32-
import Language.LSP.Types
33+
import Language.LSP.Types hiding (line)
3334
import Language.LSP.Types.Lens (HasTabSize (tabSize))
3435
import Ormolu
3536
import Ormolu.Config
3637
import System.Exit
3738
import System.FilePath
38-
import System.IO (stderr)
3939
import System.Process.Run (cwd, proc)
4040
import System.Process.Text (readCreateProcessWithExitCode)
41+
import Text.Read (readMaybe)
4142

42-
descriptor :: PluginId -> PluginDescriptor IdeState
43-
descriptor plId =
43+
descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState
44+
descriptor recorder plId =
4445
(defaultPluginDescriptor plId)
45-
{ pluginHandlers = mkFormattingHandlers $ provider plId
46+
{ pluginHandlers = mkFormattingHandlers $ provider recorder plId
4647
}
4748

4849
properties :: Properties '[ 'PropertyKey "external" 'TBoolean]
@@ -53,8 +54,8 @@ properties =
5354
"Call out to an external \"fourmolu\" executable, rather than using the bundled library"
5455
False
5556

56-
provider :: PluginId -> FormattingHandler IdeState
57-
provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do
57+
provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState
58+
provider recorder plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do
5859
fileOpts <-
5960
maybe [] (convertDynFlags . hsc_dflags . hscEnv)
6061
<$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp)
@@ -69,33 +70,33 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
6970
let version = do
7071
guard $ exitCode == ExitSuccess
7172
"fourmolu" : v : _ <- pure $ T.words out
72-
pure $ T.splitOn "." v
73+
traverse (readMaybe @Int . T.unpack) $ T.splitOn "." v
7374
case version of
7475
Just v -> pure CLIVersionInfo
75-
{ noCabal = v >= ["0", "7"]
76+
{ noCabal = v >= [0, 7]
7677
}
7778
Nothing -> do
78-
T.hPutStrLn stderr "couldn't get Fourmolu version"
79+
logWith recorder Warning $ NoVersion out
7980
pure CLIVersionInfo
8081
{ noCabal = True
8182
}
8283
(exitCode, out, err) <- -- run Fourmolu
8384
readCreateProcessWithExitCode
8485
( proc "fourmolu" $
85-
["-d"]
86+
map ("-o" <>) fileOpts
8687
<> mwhen noCabal ["--no-cabal"]
8788
<> catMaybes
8889
[ ("--start-line=" <>) . show <$> regionStartLine region
8990
, ("--end-line=" <>) . show <$> regionEndLine region
9091
]
91-
<> map ("-o" <>) fileOpts
9292
){cwd = Just $ takeDirectory fp'}
9393
contents
94-
T.hPutStrLn stderr err
9594
case exitCode of
96-
ExitSuccess ->
95+
ExitSuccess -> do
96+
logWith recorder Debug $ StdErr err
9797
pure . Right $ makeDiffTextEdit contents out
98-
ExitFailure n ->
98+
ExitFailure n -> do
99+
logWith recorder Info $ StdErr err
99100
pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n)
100101
else do
101102
let format fourmoluConfig =
@@ -113,7 +114,7 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
113114
defaultConfig
114115
{ cfgDynOptions = map DynOption fileOpts
115116
, cfgRegion = region
116-
, cfgDebug = True
117+
, cfgDebug = False
117118
, cfgPrinterOpts =
118119
fillMissingPrinterOpts
119120
(printerOpts <> lspPrinterOpts)
@@ -125,13 +126,10 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
125126
}
126127
in liftIO (loadConfigFile fp') >>= \case
127128
ConfigLoaded file opts -> liftIO $ do
128-
putStrLn $ "Loaded Fourmolu config from: " <> file
129+
logWith recorder Info $ ConfigPath file
129130
format opts
130131
ConfigNotFound searchDirs -> liftIO $ do
131-
putStrLn
132-
. unlines
133-
$ ("No " ++ show configFileName ++ " found in any of:") :
134-
map (" " ++) searchDirs
132+
logWith recorder Info $ NoConfigPath searchDirs
135133
format emptyOptions
136134
where
137135
emptyOptions =
@@ -170,6 +168,21 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
170168
FormatRange (Range (Position sl _) (Position el _)) ->
171169
RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1)
172170

171+
data LogEvent
172+
= NoVersion Text
173+
| ConfigPath FilePath
174+
| NoConfigPath [FilePath]
175+
| StdErr Text
176+
deriving (Show)
177+
178+
instance Pretty LogEvent where
179+
pretty = \case
180+
NoVersion t -> "Couldn't get Fourmolu version:" <> line <> indent 2 (pretty t)
181+
ConfigPath p -> "Loaded Fourmolu config from: " <> pretty (show p)
182+
NoConfigPath ps -> "No " <> pretty configFileName <> " found in any of:"
183+
<> line <> indent 2 (vsep (map (pretty . show) ps))
184+
StdErr t -> "Fourmolu stderr:" <> line <> indent 2 (pretty t)
185+
173186
convertDynFlags :: DynFlags -> [String]
174187
convertDynFlags df =
175188
let pp = ["-pgmF=" <> p | not (null p)]

Diff for: ‎plugins/hls-fourmolu-plugin/test/Main.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ main :: IO ()
1616
main = defaultTestRunner tests
1717

1818
fourmoluPlugin :: PluginDescriptor IdeState
19-
fourmoluPlugin = Fourmolu.descriptor "fourmolu"
19+
fourmoluPlugin = Fourmolu.descriptor mempty "fourmolu"
2020

2121
tests :: TestTree
2222
tests =

0 commit comments

Comments
 (0)