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..d1d8565dad 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,20 @@ 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) +import Text.Read (readMaybe) -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 +54,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) @@ -69,33 +70,33 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell 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 - T.hPutStrLn stderr "couldn't get Fourmolu version" + logWith recorder Warning $ NoVersion out pure CLIVersionInfo { noCabal = True } (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 - 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 = @@ -113,7 +114,7 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell defaultConfig { cfgDynOptions = map DynOption fileOpts , cfgRegion = region - , cfgDebug = True + , cfgDebug = False , cfgPrinterOpts = fillMissingPrinterOpts (printerOpts <> lspPrinterOpts) @@ -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 =