Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Pass language extensions to Brittany #1362

Merged
merged 2 commits into from
Feb 13, 2021
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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