Formatting with Brittany Fails When Warnings are Emitted #2005
Labels
component: formatters
status: blocked
Not actionable, because blocked by upstream/GHC etc.
type: bug
Something isn't right: doesn't work as intended, documentation is missing/outdated, etc..
Milestone
Comments
|
Doing some digging into brittany's CLI tool, it seems to be using Which is not a simple drop-in replacement. I hacked/copy-and-pasted together a very ugly port of Shit-tier patch:diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
index 51d278c2..6b59d837 100644
--- a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
+++ b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal
@@ -21,13 +21,16 @@ library
hs-source-dirs: src
build-depends:
, base >=4.12 && <5
, brittany >=0.13.1.0
, filepath
, ghc
, ghc-boot-th
, ghcide >=1.2 && <1.5
, hls-plugin-api ^>=1.1
+ , extra
+ , ghc-exactprint
, lens
+ , czipwith
, lsp-types
, text
, transformers
diff --git a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs
index 8f6e4e19..2bc7ddaa 100644
--- a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs
+++ b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs
@@ -1,12 +1,16 @@
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE LambdaCase #-}
module Ide.Plugin.Brittany where
import Control.Exception (bracket_)
import Control.Lens
+import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
-import Data.Maybe (mapMaybe, maybeToList)
+import Control.Monad.Trans.Class (lift)
+import Data.Maybe (mapMaybe, maybeToList, fromMaybe)
import Data.Semigroup
import Data.Text (Text)
import qualified Data.Text as T
@@ -18,11 +22,36 @@ import GHC.LanguageExtensions.Type
import Ide.PluginUtils
import Ide.Types
import Language.Haskell.Brittany
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal
+import Language.Haskell.Brittany.Internal.Config
+import Language.Haskell.Brittany.Internal.Utils
+import Language.Haskell.Brittany.Internal.Obfuscation
import Language.LSP.Types as J
import qualified Language.LSP.Types.Lens as J
import System.Environment (setEnv, unsetEnv)
import System.FilePath
+import Data.CZipWith
+import qualified Data.Text.Lazy as TextL
+import qualified Data.Text.Lazy.Encoding as TextL.Encoding
+import qualified Data.Text.Lazy.IO as TextL.IO
+import qualified GHC.OldList as List
+import qualified Control.Monad.Trans.Except as ExceptT
+import qualified Data.List.Extra
+import qualified Data.Text as Text
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
+import qualified GHC as GHC
+import GHC ( Located
+ , runGhc
+ , GenLocated(L)
+ , moduleNameString
+ )
+import qualified DynFlags as GHC
+import qualified GHC.LanguageExtensions.Type as GHC
+
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId = (defaultPluginDescriptor plId)
{ pluginHandlers = mkFormattingHandlers provider
@@ -89,7 +118,176 @@ runBrittany tabSize df confPath text = do
}
config <- fromMaybeT (pure staticDefaultConfig) (readConfigsWithUserConfig cfg (maybeToList confPath))
- parsePrintModule config text
+ _myPPrintModule config $ Text.unpack text
+
+_myPPrintModule config text =
+ ExceptT.runExceptT $ do
+ let putErrorLn = const $ return ()
+ let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
+ -- there is a good of code duplication between the following code and the
+ -- `pureModuleTransform` function. Unfortunately, there are also a good
+ -- amount of slight differences: This module is a bit more verbose, and
+ -- it tries to use the full-blown `parseModule` function which supports
+ -- CPP (but requires the input to be a file..).
+ let cppMode = config & _conf_preprocessor & _ppconf_CPPMode & confUnpack
+ -- the flag will do the following: insert a marker string
+ -- ("-- BRITANY_INCLUDE_HACK ") right before any lines starting with
+ -- "#include" before processing (parsing) input; and remove that marker
+ -- string from the transformation output.
+ -- The flag is intentionally misspelled to prevent clashing with
+ -- inline-config stuff.
+ let hackAroundIncludes =
+ config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack
+ let exactprintOnly = viaGlobal || viaDebug
+ where
+ viaGlobal = config & _conf_roundtrip_exactprint_only & confUnpack
+ viaDebug =
+ config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack
+
+ let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
+ then case cppMode of
+ CPPModeAbort -> do
+ return $ Left "Encountered -XCPP. Aborting."
+ CPPModeWarn -> do
+ return $ Right True
+ CPPModeNowarn -> return $ Right True
+ else return $ Right False
+ (parseResult, originalContents) <- do
+ -- TODO: refactor this hack to not be mixed into parsing logic
+ let hackF s = if "#include" `Data.List.Extra.isPrefixOf` s
+ then "-- BRITANY_INCLUDE_HACK " ++ s
+ else s
+ let hackTransform = if hackAroundIncludes && not exactprintOnly
+ then List.intercalate "\n" . fmap hackF . lines'
+ else id
+ let inputString = text
+ parseRes <- liftIO $ parseModuleFromString ghcOptions
+ "stdin"
+ cppCheckFunc
+ (hackTransform inputString)
+ return (parseRes, Text.pack inputString)
+ case parseResult of
+ Left left -> do
+ putErrorLn "parse error:"
+ putErrorLn left
+ ExceptT.throwE [ ErrorInput left ]
+ Right (anns, parsedSource, hasCPP) -> do
+ (inlineConf, perItemConf) <-
+ case
+ extractCommentConfigs anns (getTopLevelDeclNameMap parsedSource)
+ of
+ Left (err, input) ->
+ ExceptT.throwE
+ [ ErrorInput $ concat
+ ["Error: parse error in inline configuration:"
+ , err
+ , " in the string \"" ++ input ++ "\"."
+ ]
+ ]
+ Right c ->
+ pure c
+ let moduleConf = cZipWith fromOptionIdentity config inlineConf
+ let disableFormatting =
+ moduleConf & _conf_disable_formatting & confUnpack
+ (errsWarns, outSText, hasChanges) <- do
+ if
+ | disableFormatting -> do
+ pure ([], originalContents, False)
+ | exactprintOnly -> do
+ let r = Text.pack $ ExactPrint.exactPrint parsedSource anns
+ pure ([], r, r /= originalContents)
+ | otherwise -> do
+ (ews, outRaw) <- if hasCPP
+ then return
+ $ pPrintModule moduleConf perItemConf anns parsedSource
+ else liftIO $ pPrintModuleAndCheck moduleConf
+ perItemConf
+ anns
+ parsedSource
+ let hackF s = fromMaybe s $ TextL.stripPrefix
+ (TextL.pack "-- BRITANY_INCLUDE_HACK ")
+ s
+ let out = TextL.toStrict $ if hackAroundIncludes
+ then
+ TextL.intercalate (TextL.pack "\n")
+ $ fmap hackF
+ $ TextL.splitOn (TextL.pack "\n") outRaw
+ else outRaw
+ out' <- if moduleConf & _conf_obfuscate & confUnpack
+ then lift $ obfuscate out
+ else pure out
+ pure $ (ews, out', out' /= originalContents)
+ let customErrOrder ErrorInput{} = 4
+ customErrOrder LayoutWarning{} = -1 :: Int
+ customErrOrder ErrorOutputCheck{} = 1
+ customErrOrder ErrorUnusedComment{} = 2
+ customErrOrder ErrorUnknownNode{} = -2 :: Int
+ customErrOrder ErrorMacroConfig{} = 5
+ when (not $ null errsWarns) $ do
+ let groupedErrsWarns =
+ Data.List.Extra.groupOn customErrOrder
+ $ List.sortOn customErrOrder
+ $ errsWarns
+ groupedErrsWarns `forM_` \case
+ (ErrorOutputCheck{} : _) -> do
+ putErrorLn
+ $ "ERROR: brittany pretty printer"
+ ++ " returned syntactically invalid result."
+ (ErrorInput str : _) -> do
+ putErrorLn $ "ERROR: parse error: " ++ str
+ uns@(ErrorUnknownNode{} : _) -> do
+ putErrorLn
+ $ "WARNING: encountered unknown syntactical constructs:"
+ uns `forM_` \case
+ ErrorUnknownNode str ast@(L loc _) -> do
+ when
+ ( config
+ & _conf_debug
+ & _dconf_dump_ast_unknown
+ & confUnpack
+ )
+ $ do
+ putErrorLn $ " " ++ show (astToDoc ast)
+ _ -> error "cannot happen (TM)"
+ putErrorLn
+ " -> falling back on exactprint for this element of the module"
+ warns@(LayoutWarning{} : _) -> do
+ putErrorLn $ "WARNINGS:"
+ warns `forM_` \case
+ LayoutWarning str -> putErrorLn str
+ _ -> error "cannot happen (TM)"
+ unused@(ErrorUnusedComment{} : _) -> do
+ putErrorLn
+ $ "Error: detected unprocessed comments."
+ ++ " The transformation output will most likely"
+ ++ " not contain some of the comments"
+ ++ " present in the input haskell source file."
+ putErrorLn $ "Affected are the following comments:"
+ unused `forM_` \case
+ ErrorUnusedComment str -> putErrorLn str
+ _ -> error "cannot happen (TM)"
+ (ErrorMacroConfig err input : _) -> do
+ putErrorLn $ "Error: parse error in inline configuration:"
+ putErrorLn err
+ putErrorLn $ " in the string \"" ++ input ++ "\"."
+ [] -> error "cannot happen"
+ -- TODO: don't output anything when there are errors unless user
+ -- adds some override?
+ let
+ hasErrors =
+ case config & _conf_errorHandling & _econf_Werror & confUnpack of
+ False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
+ True -> not $ null errsWarns
+ outputOnErrs =
+ config
+ & _conf_errorHandling
+ & _econf_produceOutputOnErrors
+ & confUnpack
+ shouldOutput =
+ (not hasErrors || outputOnErrs)
+
+ when hasErrors $ ExceptT.throwE errsWarns
+ return outSText
fromMaybeT :: Monad m => m a -> MaybeT m a -> m a
fromMaybeT def act = runMaybeT act >>= maybe def return |
jneira
added
component: formatters
pr welcome
type: bug
|
Thanks for the report and the patch. Do you think it could be tidied and converted in a pr? |
|
Yeah, I'll try & find some time in the next few days to submit a PR. Is that sort of code out-of-scope for an HLS plugin? I could see if brittany would accept a PR instead. Then the "fix" would be to just swap out the |
Yeah, that sounds sensible and it will be good for brittany itself |
prikhi
added a commit
to prikhi/haskell-language-server
that referenced
this issue
Jul 23, 2021
Add a temporary fix for issue haskell#2005 while we wait for upstream brittany to incorporate similar changes.
prikhi
added a commit
to prikhi/haskell-language-server
that referenced
this issue
Jul 23, 2021
Add a temporary fix for issue haskell#2005 while we wait for upstream brittany to incorporate similar changes.
prikhi
added a commit
to prikhi/haskell-language-server
that referenced
this issue
Jul 31, 2021
Add a temporary fix for issue haskell#2005 while we wait for upstream brittany to incorporate similar changes.
prikhi
added a commit
to prikhi/haskell-language-server
that referenced
this issue
Aug 5, 2021
Add a temporary fix for issue haskell#2005 while we wait for upstream brittany to incorporate similar changes.
|
This has been included in the last release, but i would keep open until the fix is upstreamed and removed here |
jneira
added
status: blocked
|
The brittany plugin is gone |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Your environment
Output of
haskell-language-server --probe-toolsorhaskell-language-server-wrapper --probe-tools:haskell-language-server version: 1.2.0.0 (GHC: 8.8.4) (PATH: /home/prikhi/.local/bin/haskell-language-server-wrapper) (GIT hash: b8bb06eb1b117943f4436a6fdafe5c09e76cac1c) Tool versions found on the $PATH cabal: 3.2.0.0 stack: 2.7.1 ghc: 8.10.5Which OS do you use:
ArchLinux
Which lsp-client do you use:
Neovim + coc.nvim
Steps to reproduce
Chang formatter to
brittany& attempt to format a file that contains type operators in a multi-line expression:{-# LANGUAGE TypeOperators #-} module HsOpTy where -- brittany *should* remove the extra spaces between import & module name import GHC.TypeLits type Foo = Int : '[]See lspitzner/brittany#271 for more repros.
As noted in that issue, if you remove the newlines, formatting proceeds correctly
Expected behaviour
HLS ignores the warnings & uses the formatted text.
This is the behavior brittany's CLI tool exhibits:
Actual behaviour
Nothing happens, following output appears in coc's HLS workspace output:
Include debug information
Execute in the root of your project the command
haskell-language-server --debug .and paste the logs here:Debug output:
Paste the logs from the lsp-client, e.g. for VS Code
LSP logs:
The text was updated successfully, but these errors were encountered: