@@ -5,18 +5,20 @@ import Control.Lens
55import Control.Monad.IO.Class
66import Control.Monad.Trans.Maybe (MaybeT , runMaybeT )
77import Data.Coerce
8- import Data.Maybe (maybeToList )
8+ import Data.Maybe (mapMaybe , maybeToList )
99import Data.Semigroup
1010import Data.Text (Text )
1111import qualified Data.Text as T
1212import Development.IDE
1313import Development.IDE.GHC.Compat (topDir , ModSummary (ms_hspp_opts ))
14+ import qualified DynFlags as D
15+ import qualified EnumSet as S
16+ import GHC.LanguageExtensions.Type
1417import Language.Haskell.Brittany
1518import Language.Haskell.LSP.Types as J
1619import qualified Language.Haskell.LSP.Types.Lens as J
1720import Ide.PluginUtils
1821import Ide.Types
19-
2022import System.FilePath
2123import System.Environment (setEnv , unsetEnv )
2224
@@ -40,7 +42,7 @@ provider _lf ide typ contents nfp opts = do
4042 let dflags = ms_hspp_opts modsum
4143 let withRuntimeLibdir = bracket_ (setEnv key $ topDir dflags) (unsetEnv key)
4244 where key = " GHC_EXACTPRINT_GHC_LIBDIR"
43- res <- withRuntimeLibdir $ formatText confFile opts selectedContents
45+ res <- withRuntimeLibdir $ formatText dflags confFile opts selectedContents
4446 case res of
4547 Left err -> return $ Left $ responseError (T. pack $ " brittanyCmd: " ++ unlines (map showErr err))
4648 Right newText -> return $ Right $ J. List [TextEdit range newText]
@@ -50,12 +52,13 @@ provider _lf ide typ contents nfp opts = do
5052-- Errors may be presented to the user.
5153formatText
5254 :: MonadIO m
53- => Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
55+ => D. DynFlags
56+ -> Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
5457 -> FormattingOptions -- ^ Options for the formatter such as indentation.
5558 -> Text -- ^ Text to format
5659 -> m (Either [BrittanyError ] Text ) -- ^ Either formatted Text or a error from Brittany.
57- formatText confFile opts text =
58- liftIO $ runBrittany tabSize confFile text
60+ formatText df confFile opts text =
61+ liftIO $ runBrittany tabSize df confFile text
5962 where tabSize = opts ^. J. tabSize
6063
6164-- | Recursively search in every directory of the given filepath for brittany.yaml.
@@ -71,17 +74,18 @@ getConfFile = findLocalConfigPath . takeDirectory . fromNormalizedFilePath
7174-- Returns either a list of Brittany Errors or the reformatted text.
7275-- May not throw an exception.
7376runBrittany :: Int -- ^ tab size
77+ -> D. DynFlags
7478 -> Maybe FilePath -- ^ local config file
7579 -> Text -- ^ text to format
7680 -> IO (Either [BrittanyError ] Text )
77- runBrittany tabSize confPath text = do
81+ runBrittany tabSize df confPath text = do
7882 let cfg = mempty
7983 { _conf_layout =
8084 mempty { _lconfig_indentAmount = opt (coerce tabSize)
8185 }
8286 , _conf_forward =
8387 (mempty :: CForwardOptions Option )
84- { _options_ghc = opt (runIdentity ( _options_ghc forwardOptionsSyntaxExtsEnabled) )
88+ { _options_ghc = opt (getExtensions df )
8589 }
8690 }
8791
@@ -102,3 +106,12 @@ showErr (ErrorUnusedComment s) = s
102106showErr (LayoutWarning s) = s
103107showErr (ErrorUnknownNode s _) = s
104108showErr ErrorOutputCheck = " Brittany error - invalid output"
109+
110+ showExtension :: Extension -> Maybe String
111+ showExtension Cpp = Just " -XCPP"
112+ -- Brittany chokes on parsing extensions that produce warnings
113+ showExtension DatatypeContexts = Nothing
114+ showExtension other = Just $ " -X" ++ show other
115+
116+ getExtensions :: D. DynFlags -> [String ]
117+ getExtensions = mapMaybe showExtension . S. toList . D. extensionFlags
0 commit comments