From 66805059317bcb3712e056aac40055d12f2b88aa Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 27 Jul 2020 20:39:34 +0100 Subject: [PATCH 1/3] Fix rendering of extension flags for Ormolu --- haskell-language-server.cabal | 1 + src/Ide/Plugin/Ormolu.hs | 7 ++++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index dbbfef3129..a350c7d5f5 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -71,6 +71,7 @@ library , filepath , floskell == 0.10.* , ghc + , ghc-boot-th , ghcide >= 0.1 , gitrev , hashable diff --git a/src/Ide/Plugin/Ormolu.hs b/src/Ide/Plugin/Ormolu.hs index aa337fbc8e..188a8bf00d 100644 --- a/src/Ide/Plugin/Ormolu.hs +++ b/src/Ide/Plugin/Ormolu.hs @@ -19,6 +19,7 @@ import Development.IDE.Types.Location import qualified DynFlags as D import qualified EnumSet as S import GHC +import GHC.LanguageExtensions.Type import Ide.Types import Ide.PluginUtils import Ide.Plugin.Formatter @@ -46,7 +47,7 @@ provider _lf ideState typ contents fp _ = do let p = D.sPgm_F $ D.settings df in if null p then [] else ["-pgmF=" <> p] pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df - ex = map (("-X" <>) . show) $ S.toList $ D.extensionFlags df + ex = map showExtension $ S.toList $ D.extensionFlags df in return $ map DynOption $ pp <> pm <> ex @@ -75,3 +76,7 @@ provider _lf ideState typ contents fp _ = do ret (Left err) = Left (responseError (T.pack $ "ormoluCmd: " ++ show err) ) ret (Right new) = Right (makeDiffTextEdit contents new) + +showExtension :: Extension -> String +showExtension Cpp = "-XCPP" +showExtension other = "-X" ++ show other From 1e743a0d91228e59c07b6cdab35cacc6c7106551 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 27 Jul 2020 20:52:53 +0100 Subject: [PATCH 2/3] Ormolu already handles file pragmas ms_hspp_opts contains the LANGUAGE and OPTIONS pragmas what we want here is the cabal/stack options instead --- src/Ide/Plugin/Ormolu.hs | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/src/Ide/Plugin/Ormolu.hs b/src/Ide/Plugin/Ormolu.hs index 188a8bf00d..3421bf2f19 100644 --- a/src/Ide/Plugin/Ormolu.hs +++ b/src/Ide/Plugin/Ormolu.hs @@ -1,8 +1,7 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeApplications #-} module Ide.Plugin.Ormolu ( @@ -12,20 +11,24 @@ module Ide.Plugin.Ormolu where import Control.Exception -import qualified Data.Text as T +import qualified Data.Text as T import Development.IDE.Core.Rules +import Development.IDE.Core.RuleTypes (GhcSession (GhcSession)) +import Development.IDE.Core.Shake (use) +import Development.IDE.GHC.Util (hscEnv) import Development.IDE.Types.Diagnostics as D import Development.IDE.Types.Location -import qualified DynFlags as D -import qualified EnumSet as S +import qualified DynFlags as D +import qualified EnumSet as S import GHC import GHC.LanguageExtensions.Type -import Ide.Types -import Ide.PluginUtils +import GhcPlugins (HscEnv (hsc_dflags)) import Ide.Plugin.Formatter +import Ide.PluginUtils +import Ide.Types import Language.Haskell.LSP.Types import Ormolu -import Text.Regex.TDFA.Text() +import Text.Regex.TDFA.Text () -- --------------------------------------------------------------------- @@ -39,10 +42,9 @@ descriptor plId = (defaultPluginDescriptor plId) provider :: FormattingProvider IO provider _lf ideState typ contents fp _ = do let - fromDyn :: ParsedModule -> IO [DynOption] - fromDyn pmod = + fromDyn :: DynFlags -> IO [DynOption] + fromDyn df = let - df = ms_hspp_opts $ pm_mod_summary pmod pp = let p = D.sPgm_F $ D.settings df in if null p then [] else ["-pgmF=" <> p] @@ -51,10 +53,11 @@ provider _lf ideState typ contents fp _ = do in return $ map DynOption $ pp <> pm <> ex - m_parsed <- runAction "Ormolu" ideState $ getParsedModule fp - fileOpts <- case m_parsed of + ghc <- runAction "Ormolu" ideState $ use GhcSession fp + let df = hsc_dflags . hscEnv <$> ghc + fileOpts <- case df of Nothing -> return [] - Just pm -> fromDyn pm + Just df -> fromDyn df let fullRegion = RegionIndices Nothing Nothing @@ -78,5 +81,5 @@ provider _lf ideState typ contents fp _ = do ret (Right new) = Right (makeDiffTextEdit contents new) showExtension :: Extension -> String -showExtension Cpp = "-XCPP" +showExtension Cpp = "-XCPP" showExtension other = "-X" ++ show other From 158a279cb878cc09fd7e943474d70eeb7ad63756 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 27 Jul 2020 20:55:10 +0100 Subject: [PATCH 3/3] Progress reporting Because why not? --- src/Ide/Plugin/Ormolu.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Ide/Plugin/Ormolu.hs b/src/Ide/Plugin/Ormolu.hs index 3421bf2f19..8a88d834ff 100644 --- a/src/Ide/Plugin/Ormolu.hs +++ b/src/Ide/Plugin/Ormolu.hs @@ -26,8 +26,11 @@ import GhcPlugins (HscEnv (hsc_dflags)) import Ide.Plugin.Formatter import Ide.PluginUtils import Ide.Types +import Language.Haskell.LSP.Core (LspFuncs (withIndefiniteProgress), + ProgressCancellable (Cancellable)) import Language.Haskell.LSP.Types import Ormolu +import System.FilePath (takeFileName) import Text.Regex.TDFA.Text () -- --------------------------------------------------------------------- @@ -40,7 +43,7 @@ descriptor plId = (defaultPluginDescriptor plId) -- --------------------------------------------------------------------- provider :: FormattingProvider IO -provider _lf ideState typ contents fp _ = do +provider lf ideState typ contents fp _ = withIndefiniteProgress lf title Cancellable $ do let fromDyn :: DynFlags -> IO [DynOption] fromDyn df = @@ -75,6 +78,7 @@ provider _lf ideState typ contents fp _ = do in ret <$> fmt contents (mkConf fileOpts (rangeRegion sl el)) where + title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp) ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit) ret (Left err) = Left (responseError (T.pack $ "ormoluCmd: " ++ show err) )