From 73ba5dd99d0b9c291018eb023da9dc9ca8b14a6e Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 13 Feb 2021 14:15:02 +0000
Subject: [PATCH] Pass language extensions to Brittany

---
 plugins/default/src/Ide/Plugin/Brittany.hs | 29 ++++++++++++++++------
 1 file changed, 21 insertions(+), 8 deletions(-)

diff --git a/plugins/default/src/Ide/Plugin/Brittany.hs b/plugins/default/src/Ide/Plugin/Brittany.hs
index a12de7fe9a..37eedd18b0 100644
--- a/plugins/default/src/Ide/Plugin/Brittany.hs
+++ b/plugins/default/src/Ide/Plugin/Brittany.hs
@@ -5,18 +5,20 @@ import           Control.Lens
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
 import           Data.Coerce
-import           Data.Maybe (maybeToList)
+import           Data.Maybe (mapMaybe, maybeToList)
 import           Data.Semigroup
 import           Data.Text                             (Text)
 import qualified Data.Text                             as T
 import           Development.IDE
 import           Development.IDE.GHC.Compat (topDir, ModSummary(ms_hspp_opts))
+import qualified DynFlags                          as D
+import qualified EnumSet                           as S
+import           GHC.LanguageExtensions.Type
 import           Language.Haskell.Brittany
 import           Language.Haskell.LSP.Types            as J
 import qualified Language.Haskell.LSP.Types.Lens       as J
 import           Ide.PluginUtils
 import           Ide.Types
-
 import           System.FilePath
 import           System.Environment (setEnv, unsetEnv)
 
@@ -40,7 +42,7 @@ provider _lf ide typ contents nfp opts = do
   let dflags = ms_hspp_opts modsum
   let withRuntimeLibdir = bracket_ (setEnv key $ topDir dflags) (unsetEnv key)
         where key = "GHC_EXACTPRINT_GHC_LIBDIR"
-  res <- withRuntimeLibdir $ formatText confFile opts selectedContents
+  res <- withRuntimeLibdir $ formatText dflags confFile opts selectedContents
   case res of
     Left err -> return $ Left $ responseError (T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
     Right newText -> return $ Right $ J.List [TextEdit range newText]
@@ -50,12 +52,13 @@ provider _lf ide typ contents nfp opts = do
 -- Errors may be presented to the user.
 formatText
   :: MonadIO m
-  => Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
+  => D.DynFlags
+  -> Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
   -> FormattingOptions -- ^ Options for the formatter such as indentation.
   -> Text -- ^ Text to format
   -> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany.
-formatText confFile opts text =
-  liftIO $ runBrittany tabSize confFile text
+formatText df confFile opts text =
+  liftIO $ runBrittany tabSize df confFile text
   where tabSize = opts ^. J.tabSize
 
 -- | Recursively search in every directory of the given filepath for brittany.yaml.
@@ -71,17 +74,18 @@ getConfFile = findLocalConfigPath . takeDirectory . fromNormalizedFilePath
 -- Returns either a list of Brittany Errors or the reformatted text.
 -- May not throw an exception.
 runBrittany :: Int              -- ^ tab  size
+            -> D.DynFlags
             -> Maybe FilePath   -- ^ local config file
             -> Text             -- ^ text to format
             -> IO (Either [BrittanyError] Text)
-runBrittany tabSize confPath text = do
+runBrittany tabSize df confPath text = do
   let cfg = mempty
               { _conf_layout =
                   mempty { _lconfig_indentAmount = opt (coerce tabSize)
                          }
               , _conf_forward =
                   (mempty :: CForwardOptions Option)
-                    { _options_ghc = opt (runIdentity ( _options_ghc forwardOptionsSyntaxExtsEnabled))
+                    { _options_ghc = opt (getExtensions df)
                     }
               }
 
@@ -102,3 +106,12 @@ showErr (ErrorUnusedComment s)  = s
 showErr (LayoutWarning s)       = s
 showErr (ErrorUnknownNode s _)  = s
 showErr ErrorOutputCheck        = "Brittany error - invalid output"
+
+showExtension :: Extension -> Maybe String
+showExtension Cpp = Just "-XCPP"
+-- Brittany chokes on parsing extensions that produce warnings
+showExtension DatatypeContexts = Nothing
+showExtension other = Just $ "-X" ++ show other
+
+getExtensions :: D.DynFlags -> [String]
+getExtensions = mapMaybe showExtension . S.toList . D.extensionFlags