Skip to content

More Fourmolu improvements #2959

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.

Sign up for GitHub

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

Merged
merged 4 commits into from
Jun 17, 2022
Merged

More Fourmolu improvements #2959

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
b1e23e7
Use proper structured logging for Fourmolu
georgefst Jun 15, 2022
54bd3b4
Don't run Fourmolu in debug mode
georgefst Jun 15, 2022
eaa2791
Fourmolu: parse strings to integers before comparing versions
georgefst Jun 15, 2022
89182b5
Merge branch 'master' into fourmolu-logging
michaelpj Jun 17, 2022
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
2 changes: 1 addition & 1 deletion exe/Plugins.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -136,7 +136,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
Floskell.descriptor "floskell" :
#endif
#if fourmolu
Fourmolu.descriptor "fourmolu" :
Fourmolu.descriptor pluginRecorder "fourmolu" :
#endif
#if tactic
Tactic.descriptor pluginRecorder "tactics" :
Expand Down
59 changes: 36 additions & 23 deletions plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,31 +18,32 @@ import Control.Monad
import Control.Monad.IO.Class
import Data.Bifunctor (first)
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.GHC.Compat as Compat hiding (Cpp)
import Development.IDE.GHC.Compat as Compat hiding (Cpp, Warning,
hang, vcat)
import qualified Development.IDE.GHC.Compat.Util as S
import GHC.LanguageExtensions.Type (Extension (Cpp))
import Ide.Plugin.Properties
import Ide.PluginUtils (makeDiffTextEdit,
usePropertyLsp)
import Ide.Types
import Language.LSP.Server hiding (defaultConfig)
import Language.LSP.Types
import Language.LSP.Types hiding (line)
import Language.LSP.Types.Lens (HasTabSize (tabSize))
import Ormolu
import Ormolu.Config
import System.Exit
import System.FilePath
import System.IO (stderr)
import System.Process.Run (cwd, proc)
import System.Process.Text (readCreateProcessWithExitCode)
import Text.Read (readMaybe)

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId =
descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId =
(defaultPluginDescriptor plId)
{ pluginHandlers = mkFormattingHandlers $ provider plId
{ pluginHandlers = mkFormattingHandlers $ provider recorder plId
}

properties :: Properties '[ 'PropertyKey "external" 'TBoolean]
Expand All @@ -53,8 +54,8 @@ properties =
"Call out to an external \"fourmolu\" executable, rather than using the bundled library"
False

provider :: PluginId -> FormattingHandler IdeState
provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do
provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState
provider recorder plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do
fileOpts <-
maybe [] (convertDynFlags . hsc_dflags . hscEnv)
<$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp)
Expand All @@ -69,33 +70,33 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
let version = do
guard $ exitCode == ExitSuccess
"fourmolu" : v : _ <- pure $ T.words out
pure $ T.splitOn "." v
traverse (readMaybe @Int . T.unpack) $ T.splitOn "." v
case version of
Just v -> pure CLIVersionInfo
{ noCabal = v >= ["0", "7"]
{ noCabal = v >= [0, 7]
}
Nothing -> do
T.hPutStrLn stderr "couldn't get Fourmolu version"
logWith recorder Warning $ NoVersion out
pure CLIVersionInfo
{ noCabal = True
}
(exitCode, out, err) <- -- run Fourmolu
readCreateProcessWithExitCode
( proc "fourmolu" $
["-d"]
map ("-o" <>) fileOpts
<> mwhen noCabal ["--no-cabal"]
<> catMaybes
[ ("--start-line=" <>) . show <$> regionStartLine region
, ("--end-line=" <>) . show <$> regionEndLine region
]
<> map ("-o" <>) fileOpts
){cwd = Just $ takeDirectory fp'}
contents
T.hPutStrLn stderr err
case exitCode of
ExitSuccess ->
ExitSuccess -> do
logWith recorder Debug $ StdErr err
pure . Right $ makeDiffTextEdit contents out
ExitFailure n ->
ExitFailure n -> do
logWith recorder Info $ StdErr err
pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n)
else do
let format fourmoluConfig =
Expand All @@ -113,7 +114,7 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
defaultConfig
{ cfgDynOptions = map DynOption fileOpts
, cfgRegion = region
, cfgDebug = True
, cfgDebug = False
, cfgPrinterOpts =
fillMissingPrinterOpts
(printerOpts <> lspPrinterOpts)
Expand All @@ -125,13 +126,10 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
}
in liftIO (loadConfigFile fp') >>= \case
ConfigLoaded file opts -> liftIO $ do
putStrLn $ "Loaded Fourmolu config from: " <> file
logWith recorder Info $ ConfigPath file
format opts
ConfigNotFound searchDirs -> liftIO $ do
putStrLn
. unlines
$ ("No " ++ show configFileName ++ " found in any of:") :
map (" " ++) searchDirs
logWith recorder Info $ NoConfigPath searchDirs
format emptyOptions
where
emptyOptions =
Expand Down Expand Up @@ -170,6 +168,21 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
FormatRange (Range (Position sl _) (Position el _)) ->
RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1)

data LogEvent
= NoVersion Text
| ConfigPath FilePath
| NoConfigPath [FilePath]
| StdErr Text
deriving (Show)

instance Pretty LogEvent where
pretty = \case
NoVersion t -> "Couldn't get Fourmolu version:" <> line <> indent 2 (pretty t)
ConfigPath p -> "Loaded Fourmolu config from: " <> pretty (show p)
NoConfigPath ps -> "No " <> pretty configFileName <> " found in any of:"
<> line <> indent 2 (vsep (map (pretty . show) ps))
StdErr t -> "Fourmolu stderr:" <> line <> indent 2 (pretty t)

convertDynFlags :: DynFlags -> [String]
convertDynFlags df =
let pp = ["-pgmF=" <> p | not (null p)]
Expand Down
2 changes: 1 addition & 1 deletion plugins/hls-fourmolu-plugin/test/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ main :: IO ()
main = defaultTestRunner tests

fourmoluPlugin :: PluginDescriptor IdeState
fourmoluPlugin = Fourmolu.descriptor "fourmolu"
fourmoluPlugin = Fourmolu.descriptor mempty "fourmolu"

tests :: TestTree
tests =
Expand Down