From 9392fb425bf26d772ace5416c23fa735eca9c1f9 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Fri, 4 Mar 2022 13:32:33 +0000 Subject: [PATCH 01/12] Minor refactor --- plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 6f8a32553a..884d284838 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -43,12 +43,12 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable Just df -> liftIO $ convertDynFlags df let format printerOpts = - first (responseError . ("Fourmolu: " <>) . T.pack . show) + first (mkError . show) <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents)) where config = defaultConfig - { cfgDynOptions = fileOpts + { cfgDynOptions = map DynOption fileOpts , cfgRegion = region , cfgDebug = True , cfgPrinterOpts = @@ -79,6 +79,7 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable where fp' = fromNormalizedFilePath fp title = "Formatting " <> T.pack (takeFileName fp') + mkError = responseError . ("Fourmolu: " <>) . T.pack lspPrinterOpts = mempty{poIndentation = Just $ fromIntegral $ fo ^. tabSize} region = case typ of FormatText -> @@ -86,7 +87,7 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable FormatRange (Range (Position sl _) (Position el _)) -> RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1) -convertDynFlags :: DynFlags -> IO [DynOption] +convertDynFlags :: Monad m => DynFlags -> m [String] convertDynFlags df = let pp = ["-pgmF=" <> p | not (null p)] p = sPgm_F $ Compat.settings df @@ -95,4 +96,4 @@ convertDynFlags df = showExtension = \case Cpp -> "-XCPP" x -> "-X" ++ show x - in return $ map DynOption $ pp <> pm <> ex + in return $ pp <> pm <> ex From 0c21b0d194e648fa4f506f236138faca8aeb4559 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Fri, 4 Mar 2022 14:49:57 +0000 Subject: [PATCH 02/12] Reformat --- .../src/Ide/Plugin/Fourmolu.hs | 69 +++++++++---------- 1 file changed, 34 insertions(+), 35 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 884d284838..43581e6f34 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -41,41 +41,40 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable fileOpts <- case hsc_dflags . hscEnv <$> ghc of Nothing -> return [] Just df -> liftIO $ convertDynFlags df - - let format printerOpts = - first (mkError . show) - <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents)) - where - config = - defaultConfig - { cfgDynOptions = map DynOption fileOpts - , cfgRegion = region - , cfgDebug = True - , cfgPrinterOpts = - fillMissingPrinterOpts - (printerOpts <> lspPrinterOpts) - defaultPrinterOpts - } - - liftIO (loadConfigFile fp') >>= \case - ConfigLoaded file opts -> liftIO $ do - putStrLn $ "Loaded Fourmolu config from: " <> file - format opts - ConfigNotFound searchDirs -> liftIO $ do - putStrLn - . unlines - $ ("No " ++ show configFileName ++ " found in any of:") : - map (" " ++) searchDirs - format mempty - ConfigParseError f (_, err) -> do - sendNotification SWindowShowMessage $ - ShowMessageParams - { _xtype = MtError - , _message = errorMessage - } - return . Left $ responseError errorMessage - where - errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err + do + let format printerOpts = + first (mkError . show) + <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents)) + where + config = + defaultConfig + { cfgDynOptions = map DynOption fileOpts + , cfgRegion = region + , cfgDebug = True + , cfgPrinterOpts = + fillMissingPrinterOpts + (printerOpts <> lspPrinterOpts) + defaultPrinterOpts + } + in liftIO (loadConfigFile fp') >>= \case + ConfigLoaded file opts -> liftIO $ do + putStrLn $ "Loaded Fourmolu config from: " <> file + format opts + ConfigNotFound searchDirs -> liftIO $ do + putStrLn + . unlines + $ ("No " ++ show configFileName ++ " found in any of:") : + map (" " ++) searchDirs + format mempty + ConfigParseError f (_, err) -> do + sendNotification SWindowShowMessage $ + ShowMessageParams + { _xtype = MtError + , _message = errorMessage + } + return . Left $ responseError errorMessage + where + errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err where fp' = fromNormalizedFilePath fp title = "Formatting " <> T.pack (takeFileName fp') From ace226d3e04cac427add8faa4996fd3483b42a05 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Sat, 5 Mar 2022 01:48:27 +0000 Subject: [PATCH 03/12] Add an option to run Fourmolu via the CLI interface of a separate binary, rather than the bundled library This makes it easier to set up an environment (e.g. a Nix shell) which uses the same version of Fourmolu in HLS as from the command line. It can also be useful when Fourmolu has updated and we don't want to wait a month for an HLS release, or re-compile. --- hls-plugin-api/src/Ide/Plugin/Config.hs | 3 ++ .../hls-fourmolu-plugin.cabal | 1 + .../src/Ide/Plugin/Fourmolu.hs | 33 +++++++++++++++++-- 3 files changed, 35 insertions(+), 2 deletions(-) diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 8aaafd9849..a2b3121fd5 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -50,6 +50,7 @@ data Config = { checkParents :: CheckParents , checkProject :: !Bool , formattingProvider :: !T.Text + , formattingCLI :: !Bool , maxCompletions :: !Int , plugins :: !(Map.Map T.Text PluginConfig) } deriving (Show,Eq) @@ -62,6 +63,7 @@ instance Default Config where , formattingProvider = "ormolu" -- , formattingProvider = "floskell" -- , formattingProvider = "stylish-haskell" + , formattingCLI = False , maxCompletions = 40 , plugins = Map.empty } @@ -78,6 +80,7 @@ parseConfig defValue = A.withObject "Config" $ \v -> do <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents defValue <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject defValue <*> o .:? "formattingProvider" .!= formattingProvider defValue + <*> o .:? "formattingCLI" .!= formattingCLI defValue <*> o .:? "maxCompletions" .!= maxCompletions defValue <*> o .:? "plugin" .!= plugins defValue diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal index 5b47bc7b4d..428a1bb0c3 100644 --- a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal +++ b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal @@ -30,6 +30,7 @@ library , hls-plugin-api ^>=1.3 , lens , lsp + , process , text default-language: Haskell2010 diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 43581e6f34..bbc7af4c94 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -8,22 +8,28 @@ module Ide.Plugin.Fourmolu ( provider, ) where -import Control.Exception (try) +import Control.Exception (IOException, try) import Control.Lens ((^.)) +import Control.Monad import Control.Monad.IO.Class import Data.Bifunctor (first) +import Data.Maybe import qualified Data.Text as T import Development.IDE hiding (pluginHandlers) import Development.IDE.GHC.Compat as Compat hiding (Cpp) import qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type (Extension (Cpp)) +import Ide.Plugin.Config (formattingCLI) import Ide.PluginUtils (makeDiffTextEdit) import Ide.Types import Language.LSP.Server hiding (defaultConfig) import Language.LSP.Types import Language.LSP.Types.Lens (HasTabSize (tabSize)) import Ormolu +import System.Exit import System.FilePath +import System.IO (stderr, hPutStrLn) +import System.Process -- --------------------------------------------------------------------- @@ -41,7 +47,30 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable fileOpts <- case hsc_dflags . hscEnv <$> ghc of Nothing -> return [] Just df -> liftIO $ convertDynFlags df - do + useCLI <- formattingCLI <$> getConfig + if useCLI + then liftIO + . fmap (join . first (mkError . show)) + . try @IOException + $ do + (exitCode, out, err) <- + readProcessWithExitCode + "fourmolu" + ( ["-d"] + <> catMaybes + [ ("--start-line=" <>) . show <$> regionStartLine region + , ("--end-line=" <>) . show <$> regionEndLine region + ] + <> map ("-o" <>) fileOpts + ) + (T.unpack contents) + hPutStrLn stderr err + case exitCode of + ExitSuccess -> + pure . Right $ makeDiffTextEdit contents $ T.pack out + ExitFailure n -> + pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n) + else do let format printerOpts = first (mkError . show) <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents)) From b214278554b6bd69bb598341440fa8b5008f5304 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Sat, 5 Mar 2022 11:54:20 +0000 Subject: [PATCH 04/12] Use `Text` directly for processes --- plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal | 2 +- .../hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs | 11 ++++++----- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal index 428a1bb0c3..21a05f0b50 100644 --- a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal +++ b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal @@ -30,7 +30,7 @@ library , hls-plugin-api ^>=1.3 , lens , lsp - , process + , process-extras , text default-language: Haskell2010 diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index bbc7af4c94..a63d23d07f 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -15,6 +15,7 @@ import Control.Monad.IO.Class import Data.Bifunctor (first) import Data.Maybe 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 qualified Development.IDE.GHC.Compat.Util as S @@ -28,8 +29,8 @@ import Language.LSP.Types.Lens (HasTabSize (tabSize)) import Ormolu import System.Exit import System.FilePath -import System.IO (stderr, hPutStrLn) -import System.Process +import System.IO (stderr) +import System.Process.Text (readProcessWithExitCode) -- --------------------------------------------------------------------- @@ -63,11 +64,11 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable ] <> map ("-o" <>) fileOpts ) - (T.unpack contents) - hPutStrLn stderr err + contents + T.hPutStrLn stderr err case exitCode of ExitSuccess -> - pure . Right $ makeDiffTextEdit contents $ T.pack out + pure . Right $ makeDiffTextEdit contents out ExitFailure n -> pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n) else do From 42f8df3eb3261e1c4f064c02690e31e73d2e8e58 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 8 Mar 2022 23:07:52 +0000 Subject: [PATCH 05/12] Refactor: Avoid unnecessary monad constraint in `convertDynFlags` --- .../hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index a63d23d07f..62a5f33fca 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -44,10 +44,9 @@ descriptor plId = provider :: FormattingHandler IdeState provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do - ghc <- liftIO $ runAction "Fourmolu" ideState $ use GhcSession fp - fileOpts <- case hsc_dflags . hscEnv <$> ghc of - Nothing -> return [] - Just df -> liftIO $ convertDynFlags df + fileOpts <- + maybe [] (convertDynFlags . hsc_dflags . hscEnv) + <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp) useCLI <- formattingCLI <$> getConfig if useCLI then liftIO @@ -116,7 +115,7 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable FormatRange (Range (Position sl _) (Position el _)) -> RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1) -convertDynFlags :: Monad m => DynFlags -> m [String] +convertDynFlags :: DynFlags -> [String] convertDynFlags df = let pp = ["-pgmF=" <> p | not (null p)] p = sPgm_F $ Compat.settings df @@ -125,4 +124,4 @@ convertDynFlags df = showExtension = \case Cpp -> "-XCPP" x -> "-X" ++ show x - in return $ pp <> pm <> ex + in pp <> pm <> ex From 1bd90afe123cfa2a7583ff8c6d3c15f1650ec987 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 9 Mar 2022 00:47:34 +0000 Subject: [PATCH 06/12] Make Fourmolu CLI option specific to the Fourmolu plugin --- hls-plugin-api/src/Ide/Plugin/Config.hs | 3 --- .../src/Ide/Plugin/Fourmolu.hs | 24 ++++++++++++------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index a2b3121fd5..8aaafd9849 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -50,7 +50,6 @@ data Config = { checkParents :: CheckParents , checkProject :: !Bool , formattingProvider :: !T.Text - , formattingCLI :: !Bool , maxCompletions :: !Int , plugins :: !(Map.Map T.Text PluginConfig) } deriving (Show,Eq) @@ -63,7 +62,6 @@ instance Default Config where , formattingProvider = "ormolu" -- , formattingProvider = "floskell" -- , formattingProvider = "stylish-haskell" - , formattingCLI = False , maxCompletions = 40 , plugins = Map.empty } @@ -80,7 +78,6 @@ parseConfig defValue = A.withObject "Config" $ \v -> do <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents defValue <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject defValue <*> o .:? "formattingProvider" .!= formattingProvider defValue - <*> o .:? "formattingCLI" .!= formattingCLI defValue <*> o .:? "maxCompletions" .!= maxCompletions defValue <*> o .:? "plugin" .!= plugins defValue diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 62a5f33fca..93c6c0450d 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -2,6 +2,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedLabels #-} module Ide.Plugin.Fourmolu ( descriptor, @@ -20,8 +22,8 @@ import Development.IDE hiding (pluginHandlers) import Development.IDE.GHC.Compat as Compat hiding (Cpp) import qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type (Extension (Cpp)) -import Ide.Plugin.Config (formattingCLI) -import Ide.PluginUtils (makeDiffTextEdit) +import Ide.Plugin.Properties +import Ide.PluginUtils (makeDiffTextEdit, usePropertyLsp) import Ide.Types import Language.LSP.Server hiding (defaultConfig) import Language.LSP.Types @@ -32,22 +34,26 @@ import System.FilePath import System.IO (stderr) import System.Process.Text (readProcessWithExitCode) --- --------------------------------------------------------------------- - descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkFormattingHandlers provider + { pluginHandlers = mkFormattingHandlers $ provider plId } --- --------------------------------------------------------------------- +properties :: Properties '[ 'PropertyKey "cli" 'TBoolean] +properties = + emptyProperties + & defineBooleanProperty + #cli + "Call out to \"fourmolu\" executable, rather than using the bundled library" + False -provider :: FormattingHandler IdeState -provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do +provider :: PluginId -> FormattingHandler IdeState +provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do fileOpts <- maybe [] (convertDynFlags . hsc_dflags . hscEnv) <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp) - useCLI <- formattingCLI <$> getConfig + useCLI <- usePropertyLsp #cli plId properties if useCLI then liftIO . fmap (join . first (mkError . show)) From 3d9f9641d37778e7a554cf7f477022a370690d12 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 9 Mar 2022 01:08:40 +0000 Subject: [PATCH 07/12] Set working directory for Fourmolu process Ensures expected config files are found. --- .../src/Ide/Plugin/Fourmolu.hs | 21 ++++++++++--------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 93c6c0450d..c55c4a149b 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -32,7 +32,8 @@ import Ormolu import System.Exit import System.FilePath import System.IO (stderr) -import System.Process.Text (readProcessWithExitCode) +import System.Process.Run (proc, cwd) +import System.Process.Text (readCreateProcessWithExitCode) descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = @@ -60,15 +61,15 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell . try @IOException $ do (exitCode, out, err) <- - readProcessWithExitCode - "fourmolu" - ( ["-d"] - <> catMaybes - [ ("--start-line=" <>) . show <$> regionStartLine region - , ("--end-line=" <>) . show <$> regionEndLine region - ] - <> map ("-o" <>) fileOpts - ) + readCreateProcessWithExitCode + ( proc "fourmolu" $ + ["-d"] + <> catMaybes + [ ("--start-line=" <>) . show <$> regionStartLine region + , ("--end-line=" <>) . show <$> regionEndLine region + ] + <> map ("-o" <>) fileOpts + ){cwd = Just fp'} contents T.hPutStrLn stderr err case exitCode of From 74cab28e88260840b6351a460fb30f2e092906fc Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 10 Mar 2022 00:39:05 +0000 Subject: [PATCH 08/12] Fix: Set CWD to containing directory, rather than file --- plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index c55c4a149b..2ea73e2e1d 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -69,7 +69,7 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell , ("--end-line=" <>) . show <$> regionEndLine region ] <> map ("-o" <>) fileOpts - ){cwd = Just fp'} + ){cwd = Just $ takeDirectory fp'} contents T.hPutStrLn stderr err case exitCode of From 594777a463e96214ec902889a65493353d55e795 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 10 Mar 2022 01:13:20 +0000 Subject: [PATCH 09/12] Refactor: Allow passing plugin config to `goldenWithHaskellDocFormatter` --- hls-test-utils/src/Test/Hls.hs | 17 +++++++++++------ plugins/hls-brittany-plugin/test/Main.hs | 2 +- plugins/hls-floskell-plugin/test/Main.hs | 2 +- .../hls-fourmolu-plugin.cabal | 3 +++ plugins/hls-fourmolu-plugin/test/Main.hs | 2 +- plugins/hls-ormolu-plugin/test/Main.hs | 2 +- plugins/hls-stylish-haskell-plugin/test/Main.hs | 2 +- 7 files changed, 19 insertions(+), 11 deletions(-) diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 02ece9efb4..5b0cc9073f 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -48,6 +48,7 @@ import qualified Data.Aeson as A import Data.ByteString.Lazy (ByteString) import Data.Default (def) import Data.Maybe (fromMaybe) +import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL @@ -69,7 +70,7 @@ import Development.IDE.Types.Logger (Logger (Logger), import Development.IDE.Types.Options import GHC.IO.Handle import GHC.Stack (emptyCallStack) -import Ide.Plugin.Config (Config, formattingProvider) +import Ide.Plugin.Config (Config, formattingProvider, PluginConfig, plugins) import Ide.PluginUtils (idePluginsToPluginDesc, pluginDescToIdePlugins) import Ide.Types @@ -132,6 +133,7 @@ goldenWithHaskellDoc plugin title testDataDir path desc ext act = goldenWithHaskellDocFormatter :: PluginDescriptor IdeState -> String + -> PluginConfig -> TestName -> FilePath -> FilePath @@ -139,9 +141,9 @@ goldenWithHaskellDocFormatter -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithHaskellDocFormatter plugin formatter title testDataDir path desc ext act = +goldenWithHaskellDocFormatter plugin formatter conf title testDataDir path desc ext act = goldenGitDiff title (testDataDir path <.> desc <.> ext) - $ runSessionWithServerFormatter plugin formatter testDataDir + $ runSessionWithServerFormatter plugin formatter conf testDataDir $ TL.encodeUtf8 . TL.fromStrict <$> do doc <- openDoc (path <.> ext) "haskell" @@ -152,11 +154,14 @@ goldenWithHaskellDocFormatter plugin formatter title testDataDir path desc ext a runSessionWithServer :: PluginDescriptor IdeState -> FilePath -> Session a -> IO a runSessionWithServer plugin = runSessionWithServer' [plugin] def def fullCaps -runSessionWithServerFormatter :: PluginDescriptor IdeState -> String -> FilePath -> Session a -> IO a -runSessionWithServerFormatter plugin formatter = +runSessionWithServerFormatter :: PluginDescriptor IdeState -> String -> PluginConfig -> FilePath -> Session a -> IO a +runSessionWithServerFormatter plugin formatter conf = runSessionWithServer' [plugin] - def {formattingProvider = T.pack formatter} + def + { formattingProvider = T.pack formatter + , plugins = M.singleton (T.pack formatter) conf + } def fullCaps diff --git a/plugins/hls-brittany-plugin/test/Main.hs b/plugins/hls-brittany-plugin/test/Main.hs index 2a4ef9f7d4..a7a840d7c3 100644 --- a/plugins/hls-brittany-plugin/test/Main.hs +++ b/plugins/hls-brittany-plugin/test/Main.hs @@ -31,7 +31,7 @@ tests = testGroup "brittany" ] brittanyGolden :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -brittanyGolden title path desc = goldenWithHaskellDocFormatter brittanyPlugin "brittany" title testDataDir path desc "hs" +brittanyGolden title path desc = goldenWithHaskellDocFormatter brittanyPlugin "brittany" def title testDataDir path desc "hs" testDataDir :: FilePath testDataDir = "test" "testdata" diff --git a/plugins/hls-floskell-plugin/test/Main.hs b/plugins/hls-floskell-plugin/test/Main.hs index e63aee2f2e..155291eec4 100644 --- a/plugins/hls-floskell-plugin/test/Main.hs +++ b/plugins/hls-floskell-plugin/test/Main.hs @@ -24,7 +24,7 @@ tests = testGroup "floskell" ] goldenWithFloskell :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithFloskell title path desc = goldenWithHaskellDocFormatter floskellPlugin "floskell" title testDataDir path desc "hs" +goldenWithFloskell title path desc = goldenWithHaskellDocFormatter floskellPlugin "floskell" def title testDataDir path desc "hs" testDataDir :: FilePath testDataDir = "test" "testdata" diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal index 21a05f0b50..05c0c2e6ee 100644 --- a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal +++ b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal @@ -43,7 +43,10 @@ test-suite tests ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: , base + , aeson + , containers , filepath , hls-fourmolu-plugin + , hls-plugin-api , hls-test-utils ^>=1.2 , lsp-test diff --git a/plugins/hls-fourmolu-plugin/test/Main.hs b/plugins/hls-fourmolu-plugin/test/Main.hs index a33b505790..a981c512d6 100644 --- a/plugins/hls-fourmolu-plugin/test/Main.hs +++ b/plugins/hls-fourmolu-plugin/test/Main.hs @@ -24,7 +24,7 @@ tests = testGroup "fourmolu" ] goldenWithFourmolu :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithFourmolu title path desc = goldenWithHaskellDocFormatter fourmoluPlugin "fourmolu" title testDataDir path desc "hs" +goldenWithFourmolu title path desc = goldenWithHaskellDocFormatter fourmoluPlugin "fourmolu" def title testDataDir path desc "hs" testDataDir :: FilePath testDataDir = "test" "testdata" diff --git a/plugins/hls-ormolu-plugin/test/Main.hs b/plugins/hls-ormolu-plugin/test/Main.hs index d42cc7fb91..bc637bd4dc 100644 --- a/plugins/hls-ormolu-plugin/test/Main.hs +++ b/plugins/hls-ormolu-plugin/test/Main.hs @@ -23,7 +23,7 @@ tests = testGroup "ormolu" ] goldenWithOrmolu :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithOrmolu title path desc = goldenWithHaskellDocFormatter ormoluPlugin "ormolu" title testDataDir path desc "hs" +goldenWithOrmolu title path desc = goldenWithHaskellDocFormatter ormoluPlugin "ormolu" def title testDataDir path desc "hs" testDataDir :: FilePath testDataDir = "test" "testdata" diff --git a/plugins/hls-stylish-haskell-plugin/test/Main.hs b/plugins/hls-stylish-haskell-plugin/test/Main.hs index d8cc09157f..236b705c42 100644 --- a/plugins/hls-stylish-haskell-plugin/test/Main.hs +++ b/plugins/hls-stylish-haskell-plugin/test/Main.hs @@ -22,7 +22,7 @@ tests = testGroup "stylish-haskell" ] goldenWithStylishHaskell :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithStylishHaskell title fp desc = goldenWithHaskellDocFormatter stylishHaskellPlugin "stylishHaskell" title testDataDir fp desc "hs" +goldenWithStylishHaskell title fp desc = goldenWithHaskellDocFormatter stylishHaskellPlugin "stylishHaskell" def title testDataDir fp desc "hs" testDataDir :: FilePath testDataDir = "test" "testdata" From dc64fc4497f1fc6e2d416e16500520c8268e7ac6 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 10 Mar 2022 01:21:33 +0000 Subject: [PATCH 10/12] Test Fourmolu with CLI option --- .../hls-fourmolu-plugin.cabal | 2 ++ plugins/hls-fourmolu-plugin/test/Main.hs | 25 +++++++++++++------ 2 files changed, 19 insertions(+), 8 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal index 05c0c2e6ee..df2639a8d2 100644 --- a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal +++ b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal @@ -41,6 +41,8 @@ test-suite tests hs-source-dirs: test main-is: Main.hs ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: + fourmolu:fourmolu build-depends: , base , aeson diff --git a/plugins/hls-fourmolu-plugin/test/Main.hs b/plugins/hls-fourmolu-plugin/test/Main.hs index a981c512d6..a78d5f479c 100644 --- a/plugins/hls-fourmolu-plugin/test/Main.hs +++ b/plugins/hls-fourmolu-plugin/test/Main.hs @@ -3,6 +3,9 @@ module Main ( main ) where +import Data.Aeson +import Data.Functor +import Ide.Plugin.Config import qualified Ide.Plugin.Fourmolu as Fourmolu import Language.LSP.Test import Language.LSP.Types @@ -16,15 +19,21 @@ fourmoluPlugin :: PluginDescriptor IdeState fourmoluPlugin = Fourmolu.descriptor "fourmolu" tests :: TestTree -tests = testGroup "fourmolu" - [ goldenWithFourmolu "formats correctly" "Fourmolu" "formatted" $ \doc -> do - formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) - , goldenWithFourmolu "formats imports correctly" "Fourmolu" "formatted" $ \doc -> do - formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) - ] +tests = + testGroup "fourmolu" $ + [False, True] <&> \cli -> + testGroup + (if cli then "cli" else "lib") + [ goldenWithFourmolu cli "formats correctly" "Fourmolu" "formatted" $ \doc -> do + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + , goldenWithFourmolu cli "formats imports correctly" "Fourmolu" "formatted" $ \doc -> do + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + ] -goldenWithFourmolu :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithFourmolu title path desc = goldenWithHaskellDocFormatter fourmoluPlugin "fourmolu" def title testDataDir path desc "hs" +goldenWithFourmolu :: Bool -> TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree +goldenWithFourmolu cli title path desc = goldenWithHaskellDocFormatter fourmoluPlugin "fourmolu" conf title testDataDir path desc "hs" + where + conf = def{plcConfig = (\(Object obj) -> obj) $ object ["cli" .= cli]} testDataDir :: FilePath testDataDir = "test" "testdata" From 236d244c2fef41a97f29f995b386badd1fd080b2 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 10 Mar 2022 16:40:33 +0000 Subject: [PATCH 11/12] Minor change to flag text Co-authored-by: Michael Peyton Jones --- plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 2ea73e2e1d..c3266e564f 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -46,7 +46,7 @@ properties = emptyProperties & defineBooleanProperty #cli - "Call out to \"fourmolu\" executable, rather than using the bundled library" + "Call out to a \"fourmolu\" executable, rather than using the bundled library" False provider :: PluginId -> FormattingHandler IdeState From 558a3bce20a1fe2ca44049f804cf29911925750a Mon Sep 17 00:00:00 2001 From: George Thomas Date: Fri, 11 Mar 2022 10:35:10 +0000 Subject: [PATCH 12/12] Change flag name from "cli" to "external" --- plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs | 8 ++++---- plugins/hls-fourmolu-plugin/test/Main.hs | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index c3266e564f..ea19ddf8f5 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -41,12 +41,12 @@ descriptor plId = { pluginHandlers = mkFormattingHandlers $ provider plId } -properties :: Properties '[ 'PropertyKey "cli" 'TBoolean] +properties :: Properties '[ 'PropertyKey "external" 'TBoolean] properties = emptyProperties & defineBooleanProperty - #cli - "Call out to a \"fourmolu\" executable, rather than using the bundled library" + #external + "Call out to an external \"fourmolu\" executable, rather than using the bundled library" False provider :: PluginId -> FormattingHandler IdeState @@ -54,7 +54,7 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell fileOpts <- maybe [] (convertDynFlags . hsc_dflags . hscEnv) <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp) - useCLI <- usePropertyLsp #cli plId properties + useCLI <- usePropertyLsp #external plId properties if useCLI then liftIO . fmap (join . first (mkError . show)) diff --git a/plugins/hls-fourmolu-plugin/test/Main.hs b/plugins/hls-fourmolu-plugin/test/Main.hs index a78d5f479c..f339d716bc 100644 --- a/plugins/hls-fourmolu-plugin/test/Main.hs +++ b/plugins/hls-fourmolu-plugin/test/Main.hs @@ -33,7 +33,7 @@ tests = goldenWithFourmolu :: Bool -> TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree goldenWithFourmolu cli title path desc = goldenWithHaskellDocFormatter fourmoluPlugin "fourmolu" conf title testDataDir path desc "hs" where - conf = def{plcConfig = (\(Object obj) -> obj) $ object ["cli" .= cli]} + conf = def{plcConfig = (\(Object obj) -> obj) $ object ["external" .= cli]} testDataDir :: FilePath testDataDir = "test" "testdata"