diff --git a/hls-fourmolu-plugin.cabal b/hls-fourmolu-plugin.cabal --- a/hls-fourmolu-plugin.cabal +++ b/hls-fourmolu-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-fourmolu-plugin -version: 1.0.3.0 +version: 1.1.0.0 synopsis: Integration with the Fourmolu code formatter description: Please see the README on GitHub at @@ -9,6 +9,8 @@ license-file: LICENSE author: The Haskell IDE Team copyright: The Haskell IDE Team +homepage: https://github.com/haskell/haskell-language-server +bug-reports: https://github.com/haskell/haskell-language-server/issues maintainer: alan.zimm@gmail.com category: Development build-type: Simple @@ -16,26 +18,40 @@ LICENSE test/testdata/**/*.hs +source-repository head + type: git + location: git://github.com/haskell/haskell-language-server.git + library - exposed-modules: Ide.Plugin.Fourmolu + if impl(ghc >= 9.3) + buildable: False + else + buildable: True + exposed-modules: + Ide.Plugin.Fourmolu + , Ide.Plugin.Fourmolu.Shim hs-source-dirs: src ghc-options: -Wall build-depends: , base >=4.12 && <5 , filepath - , fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.5 + , fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.6 || ^>= 0.7 || ^>= 0.8 , ghc , ghc-boot-th - , ghcide ^>=1.7 - , hls-plugin-api ^>=1.4 + , ghcide ^>=1.8 + , hls-plugin-api ^>=1.5 , lens , lsp - , process-extras + , process-extras >= 0.7.1 , text default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test @@ -50,5 +66,5 @@ , filepath , hls-fourmolu-plugin , hls-plugin-api - , hls-test-utils ^>=1.3 + , hls-test-utils ^>=1.4 , lsp-test diff --git a/src/Ide/Plugin/Fourmolu.hs b/src/Ide/Plugin/Fourmolu.hs --- a/src/Ide/Plugin/Fourmolu.hs +++ b/src/Ide/Plugin/Fourmolu.hs @@ -1,9 +1,10 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedLabels #-} module Ide.Plugin.Fourmolu ( descriptor, @@ -14,31 +15,34 @@ import Control.Lens ((^.)) import Control.Monad import Control.Monad.IO.Class -import Data.Bifunctor (first) +import Data.Bifunctor (bimap, 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.Fourmolu.Shim import Ide.Plugin.Properties -import Ide.PluginUtils (makeDiffTextEdit, usePropertyLsp) +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 System.Exit import System.FilePath -import System.IO (stderr) -import System.Process.Run (proc, cwd) +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] @@ -49,8 +53,8 @@ "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) @@ -60,33 +64,51 @@ . fmap (join . first (mkError . show)) . try @IOException $ do - (exitCode, out, err) <- + CLIVersionInfo{noCabal} <- do -- check Fourmolu version so that we know which flags to use + (exitCode, out, _err) <- readCreateProcessWithExitCode ( proc "fourmolu" ["-v"] ) "" + let version = do + guard $ exitCode == ExitSuccess + "fourmolu" : v : _ <- pure $ T.words out + traverse (readMaybe @Int . T.unpack) $ T.splitOn "." v + case version of + Just v -> pure CLIVersionInfo + { noCabal = v >= [0, 7] + } + Nothing -> do + 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 printerOpts = - first (mkError . show) - <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents)) + let format fourmoluConfig = + bimap (mkError . show) (makeDiffTextEdit contents) + <$> try @OrmoluException (ormolu config fp' (T.unpack contents)) where + printerOpts = cfgFilePrinterOpts fourmoluConfig config = + addFixityOverrides (cfgFileFixities fourmoluConfig) $ defaultConfig { cfgDynOptions = map DynOption fileOpts , cfgRegion = region - , cfgDebug = True + , cfgDebug = False , cfgPrinterOpts = fillMissingPrinterOpts (printerOpts <> lspPrinterOpts) @@ -94,15 +116,12 @@ } 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 - format mempty - ConfigParseError f (_, err) -> do + logWith recorder Info $ NoConfigPath searchDirs + format emptyConfig + ConfigParseError f err -> do sendNotification SWindowShowMessage $ ShowMessageParams { _xtype = MtError @@ -110,7 +129,7 @@ } return . Left $ responseError errorMessage where - errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err + errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (showParseError err) where fp' = fromNormalizedFilePath fp title = "Formatting " <> T.pack (takeFileName fp') @@ -122,6 +141,21 @@ 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)] @@ -132,3 +166,10 @@ Cpp -> "-XCPP" x -> "-X" ++ show x in pp <> pm <> ex + +newtype CLIVersionInfo = CLIVersionInfo + { noCabal :: Bool + } + +mwhen :: Monoid a => Bool -> a -> a +mwhen b x = if b then x else mempty diff --git a/src/Ide/Plugin/Fourmolu/Shim.hs b/src/Ide/Plugin/Fourmolu/Shim.hs new file mode 100644 --- /dev/null +++ b/src/Ide/Plugin/Fourmolu/Shim.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE CPP #-} + +module Ide.Plugin.Fourmolu.Shim ( + -- * FourmoluConfig + cfgFilePrinterOpts, + cfgFileFixities, + emptyConfig, + + -- * FixityMap + addFixityOverrides, + + -- * ConfigParseError + showParseError, +) where + +import Ormolu.Config + +#if MIN_VERSION_fourmolu(0,7,0) +import Ormolu.Fixity +#endif + +{-- Backport FourmoluConfig --} + +#if !MIN_VERSION_fourmolu(0,7,0) +type FourmoluConfig = PrinterOptsPartial + +cfgFilePrinterOpts :: FourmoluConfig -> PrinterOptsPartial +cfgFilePrinterOpts = id + +cfgFileFixities :: FourmoluConfig -> FixityMap +cfgFileFixities _ = mempty +#endif + +#if MIN_VERSION_fourmolu(0,8,1) +-- emptyConfig now provided +#elif MIN_VERSION_fourmolu(0,7,0) +emptyConfig :: FourmoluConfig +emptyConfig = + FourmoluConfig + { cfgFilePrinterOpts = mempty + , cfgFileFixities = mempty + } +#else +emptyConfig :: FourmoluConfig +emptyConfig = mempty +#endif + +{-- Backport FixityMap --} + +#if MIN_VERSION_fourmolu(0,7,0) +addFixityOverrides :: FixityMap -> Config region -> Config region +addFixityOverrides fixities cfg = cfg{cfgFixityOverrides = fixities} +#else +type FixityMap = () + +addFixityOverrides :: FixityMap -> Config region -> Config region +addFixityOverrides _ = id +#endif + +{-- Backport ConfigParseError --} + +#if MIN_VERSION_fourmolu(0,7,0) +showParseError :: Show parseException => parseException -> String +showParseError = show +#else +showParseError :: (pos, String) -> String +showParseError = snd +#endif diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -16,7 +16,7 @@ main = defaultTestRunner tests fourmoluPlugin :: PluginDescriptor IdeState -fourmoluPlugin = Fourmolu.descriptor "fourmolu" +fourmoluPlugin = Fourmolu.descriptor mempty "fourmolu" tests :: TestTree tests =