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..8a88d834ff 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,19 +11,27 @@ 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 Ide.Types -import Ide.PluginUtils +import GHC.LanguageExtensions.Type +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 Text.Regex.TDFA.Text() +import System.FilePath (takeFileName) +import Text.Regex.TDFA.Text () -- --------------------------------------------------------------------- @@ -36,24 +43,24 @@ 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 :: 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] 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 - 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 @@ -71,7 +78,12 @@ 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) ) ret (Right new) = Right (makeDiffTextEdit contents new) + +showExtension :: Extension -> String +showExtension Cpp = "-XCPP" +showExtension other = "-X" ++ show other