@@ -5,18 +5,20 @@ import Control.Lens
5
5
import Control.Monad.IO.Class
6
6
import Control.Monad.Trans.Maybe (MaybeT , runMaybeT )
7
7
import Data.Coerce
8
- import Data.Maybe (maybeToList )
8
+ import Data.Maybe (mapMaybe , maybeToList )
9
9
import Data.Semigroup
10
10
import Data.Text (Text )
11
11
import qualified Data.Text as T
12
12
import Development.IDE
13
13
import 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
14
17
import Language.Haskell.Brittany
15
18
import Language.Haskell.LSP.Types as J
16
19
import qualified Language.Haskell.LSP.Types.Lens as J
17
20
import Ide.PluginUtils
18
21
import Ide.Types
19
-
20
22
import System.FilePath
21
23
import System.Environment (setEnv , unsetEnv )
22
24
@@ -40,7 +42,7 @@ provider _lf ide typ contents nfp opts = do
40
42
let dflags = ms_hspp_opts modsum
41
43
let withRuntimeLibdir = bracket_ (setEnv key $ topDir dflags) (unsetEnv key)
42
44
where key = " GHC_EXACTPRINT_GHC_LIBDIR"
43
- res <- withRuntimeLibdir $ formatText confFile opts selectedContents
45
+ res <- withRuntimeLibdir $ formatText dflags confFile opts selectedContents
44
46
case res of
45
47
Left err -> return $ Left $ responseError (T. pack $ " brittanyCmd: " ++ unlines (map showErr err))
46
48
Right newText -> return $ Right $ J. List [TextEdit range newText]
@@ -50,12 +52,13 @@ provider _lf ide typ contents nfp opts = do
50
52
-- Errors may be presented to the user.
51
53
formatText
52
54
:: 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.
54
57
-> FormattingOptions -- ^ Options for the formatter such as indentation.
55
58
-> Text -- ^ Text to format
56
59
-> 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
59
62
where tabSize = opts ^. J. tabSize
60
63
61
64
-- | Recursively search in every directory of the given filepath for brittany.yaml.
@@ -71,17 +74,18 @@ getConfFile = findLocalConfigPath . takeDirectory . fromNormalizedFilePath
71
74
-- Returns either a list of Brittany Errors or the reformatted text.
72
75
-- May not throw an exception.
73
76
runBrittany :: Int -- ^ tab size
77
+ -> D. DynFlags
74
78
-> Maybe FilePath -- ^ local config file
75
79
-> Text -- ^ text to format
76
80
-> IO (Either [BrittanyError ] Text )
77
- runBrittany tabSize confPath text = do
81
+ runBrittany tabSize df confPath text = do
78
82
let cfg = mempty
79
83
{ _conf_layout =
80
84
mempty { _lconfig_indentAmount = opt (coerce tabSize)
81
85
}
82
86
, _conf_forward =
83
87
(mempty :: CForwardOptions Option )
84
- { _options_ghc = opt (runIdentity ( _options_ghc forwardOptionsSyntaxExtsEnabled) )
88
+ { _options_ghc = opt (getExtensions df )
85
89
}
86
90
}
87
91
@@ -102,3 +106,12 @@ showErr (ErrorUnusedComment s) = s
102
106
showErr (LayoutWarning s) = s
103
107
showErr (ErrorUnknownNode s _) = s
104
108
showErr 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