From b1e23e7d90dca155fb50141de360f92ade1e6e27 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 15 Jun 2022 20:39:42 +0100 Subject: [PATCH 1/3] Use proper structured logging for Fourmolu Previously we just printed directly to stdout and stderr. --- exe/Plugins.hs | 2 +- .../src/Ide/Plugin/Fourmolu.hs | 49 ++++++++++++------- plugins/hls-fourmolu-plugin/test/Main.hs | 2 +- 3 files changed, 33 insertions(+), 20 deletions(-) diff --git a/exe/Plugins.hs b/exe/Plugins.hs index 5e7bb29ca1..5a5f59d467 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -136,7 +136,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins Floskell.descriptor "floskell" : #endif #if fourmolu - Fourmolu.descriptor "fourmolu" : + Fourmolu.descriptor pluginRecorder "fourmolu" : #endif #if tactic Tactic.descriptor pluginRecorder "tactics" : diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index d3d8c59cea..8c77144417 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -18,10 +18,11 @@ import Control.Monad import Control.Monad.IO.Class import Data.Bifunctor (first) import Data.Maybe +import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.IO as T import Development.IDE hiding (pluginHandlers) -import Development.IDE.GHC.Compat as Compat hiding (Cpp) +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.Properties @@ -29,20 +30,19 @@ import Ide.PluginUtils (makeDiffTextEdit, usePropertyLsp) import Ide.Types import Language.LSP.Server hiding (defaultConfig) -import Language.LSP.Types +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.IO (stderr) import System.Process.Run (cwd, proc) import System.Process.Text (readCreateProcessWithExitCode) -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = +descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState +descriptor recorder plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkFormattingHandlers $ provider plId + { pluginHandlers = mkFormattingHandlers $ provider recorder plId } properties :: Properties '[ 'PropertyKey "external" 'TBoolean] @@ -53,8 +53,8 @@ properties = "Call out to an external \"fourmolu\" executable, rather than using the bundled library" False -provider :: PluginId -> FormattingHandler IdeState -provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do +provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState +provider recorder plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do fileOpts <- maybe [] (convertDynFlags . hsc_dflags . hscEnv) <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp) @@ -75,7 +75,7 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell { noCabal = v >= ["0", "7"] } Nothing -> do - T.hPutStrLn stderr "couldn't get Fourmolu version" + logWith recorder Warning $ NoVersion out pure CLIVersionInfo { noCabal = True } @@ -91,11 +91,12 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell <> map ("-o" <>) fileOpts ){cwd = Just $ takeDirectory fp'} contents - T.hPutStrLn stderr err case exitCode of - ExitSuccess -> + ExitSuccess -> do + logWith recorder Debug $ StdErr err pure . Right $ makeDiffTextEdit contents out - ExitFailure n -> + ExitFailure n -> do + logWith recorder Info $ StdErr err pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n) else do let format fourmoluConfig = @@ -125,13 +126,10 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell } in liftIO (loadConfigFile fp') >>= \case ConfigLoaded file opts -> liftIO $ do - putStrLn $ "Loaded Fourmolu config from: " <> file + logWith recorder Info $ ConfigPath file format opts ConfigNotFound searchDirs -> liftIO $ do - putStrLn - . unlines - $ ("No " ++ show configFileName ++ " found in any of:") : - map (" " ++) searchDirs + logWith recorder Info $ NoConfigPath searchDirs format emptyOptions where emptyOptions = @@ -170,6 +168,21 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell FormatRange (Range (Position sl _) (Position el _)) -> RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1) +data LogEvent + = NoVersion Text + | ConfigPath FilePath + | NoConfigPath [FilePath] + | StdErr Text + deriving (Show) + +instance Pretty LogEvent where + pretty = \case + NoVersion t -> "Couldn't get Fourmolu version:" <> line <> indent 2 (pretty t) + ConfigPath p -> "Loaded Fourmolu config from: " <> pretty (show p) + NoConfigPath ps -> "No " <> pretty configFileName <> " found in any of:" + <> line <> indent 2 (vsep (map (pretty . show) ps)) + StdErr t -> "Fourmolu stderr:" <> line <> indent 2 (pretty t) + convertDynFlags :: DynFlags -> [String] convertDynFlags df = let pp = ["-pgmF=" <> p | not (null p)] diff --git a/plugins/hls-fourmolu-plugin/test/Main.hs b/plugins/hls-fourmolu-plugin/test/Main.hs index f339d716bc..872126f3a2 100644 --- a/plugins/hls-fourmolu-plugin/test/Main.hs +++ b/plugins/hls-fourmolu-plugin/test/Main.hs @@ -16,7 +16,7 @@ main :: IO () main = defaultTestRunner tests fourmoluPlugin :: PluginDescriptor IdeState -fourmoluPlugin = Fourmolu.descriptor "fourmolu" +fourmoluPlugin = Fourmolu.descriptor mempty "fourmolu" tests :: TestTree tests = From 54bd3b46c51d0b0b15abf473eb0e99fc4af5de5f Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 15 Jun 2022 20:48:10 +0100 Subject: [PATCH 2/3] 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. --- plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 8c77144417..da4d08d005 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -82,13 +82,12 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl (exitCode, out, err) <- -- run Fourmolu readCreateProcessWithExitCode ( proc "fourmolu" $ - ["-d"] + map ("-o" <>) fileOpts <> mwhen noCabal ["--no-cabal"] <> catMaybes [ ("--start-line=" <>) . show <$> regionStartLine region , ("--end-line=" <>) . show <$> regionEndLine region ] - <> map ("-o" <>) fileOpts ){cwd = Just $ takeDirectory fp'} contents case exitCode of @@ -114,7 +113,7 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl defaultConfig { cfgDynOptions = map DynOption fileOpts , cfgRegion = region - , cfgDebug = True + , cfgDebug = False , cfgPrinterOpts = fillMissingPrinterOpts (printerOpts <> lspPrinterOpts) From eaa279122f39e283a012d3ef8c26f1efd1d08721 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 15 Jun 2022 20:55:32 +0100 Subject: [PATCH 3/3] Fourmolu: parse strings to integers before comparing versions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Whoever originally wrote this (😳) had clearly had one too many beers the night before: `show @Int` is not monotonic since e.g. "10" < "2". --- plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index da4d08d005..d1d8565dad 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -38,6 +38,7 @@ import System.Exit import System.FilePath import System.Process.Run (cwd, proc) import System.Process.Text (readCreateProcessWithExitCode) +import Text.Read (readMaybe) descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = @@ -69,10 +70,10 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl let version = do guard $ exitCode == ExitSuccess "fourmolu" : v : _ <- pure $ T.words out - pure $ T.splitOn "." v + traverse (readMaybe @Int . T.unpack) $ T.splitOn "." v case version of Just v -> pure CLIVersionInfo - { noCabal = v >= ["0", "7"] + { noCabal = v >= [0, 7] } Nothing -> do logWith recorder Warning $ NoVersion out