Skip to content

Commit

Permalink
Pass language extensions to Brittany (#1362)
Browse files Browse the repository at this point in the history
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
  • Loading branch information
pepeiborra and mergify[bot] committed Feb 13, 2021
1 parent e2bf01b commit f17f425
Showing 1 changed file with 21 additions and 8 deletions.
29 changes: 21 additions & 8 deletions plugins/default/src/Ide/Plugin/Brittany.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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]
Expand All @@ -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.
Expand All @@ -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)
}
}

Expand All @@ -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

0 comments on commit f17f425

Please sign in to comment.