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: 2.0.0.1 +version: 2.1.0.0 synopsis: Integration with the Fourmolu code formatter description: Please see the README on GitHub at @@ -32,15 +32,17 @@ build-depends: , base >=4.12 && <5 , filepath - , fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.6 || ^>= 0.7 || ^>= 0.8 || ^>= 0.9 || ^>= 0.10 || ^>= 0.11 || ^>= 0.12 + , fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.6 || ^>= 0.7 || ^>= 0.8 || ^>= 0.9 || ^>= 0.10 || ^>= 0.11 || ^>= 0.12 || ^>= 0.13 , ghc , ghc-boot-th - , ghcide == 2.0.0.1 - , hls-plugin-api == 2.0.0.1 + , ghcide == 2.1.0.0 + , hls-plugin-api == 2.1.0.0 , lens , lsp + , mtl , process-extras >= 0.7.1 , text + , transformers -- fourmolu 0.9.0 fails to build on Windows CI for reasons unknown if impl(ghc >= 9.2) && os(windows) && impl(ghc < 9.4) @@ -63,5 +65,5 @@ , filepath , hls-fourmolu-plugin , hls-plugin-api - , hls-test-utils == 2.0.0.1 + , hls-test-utils == 2.1.0.0 , 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,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-} @@ -5,7 +6,7 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeOperators #-} module Ide.Plugin.Fourmolu ( descriptor, @@ -13,12 +14,18 @@ LogEvent, ) where -import Control.Exception (IOException, try) +import Control.Exception (IOException, handle, try) import Control.Lens ((^.)) -import Control.Monad -import Control.Monad.IO.Class -import Data.Bifunctor (bimap, first) -import Data.Maybe +import Control.Monad (guard) +import Control.Monad.Error.Class (MonadError (throwError)) +import Control.Monad.Trans.Except (ExceptT (..), mapExceptT, + runExceptT) + +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Data.Bifunctor (bimap) +import Data.List (intercalate) +import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as T import Development.IDE hiding (pluginHandlers) @@ -26,13 +33,15 @@ hang, vcat) import qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type (Extension (Cpp)) +import Ide.Plugin.Error import Ide.Plugin.Fourmolu.Shim import Ide.Plugin.Properties import Ide.PluginUtils (makeDiffTextEdit) import Ide.Types +import Language.LSP.Protocol.Lens (HasTabSize (tabSize)) +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types import Language.LSP.Server hiding (defaultConfig) -import Language.LSP.Types hiding (line) -import Language.LSP.Types.Lens (HasTabSize (tabSize)) import Ormolu import System.Exit import System.FilePath @@ -56,52 +65,20 @@ False provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState -provider recorder plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do +provider recorder plId ideState typ contents fp fo = ExceptT $ withIndefiniteProgress title Cancellable $ runExceptT $ do fileOpts <- maybe [] (convertDynFlags . hsc_dflags . hscEnv) <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp) useCLI <- liftIO $ runAction "Fourmolu" ideState $ usePropertyAction #external plId properties if useCLI - then liftIO - . fmap (join . first (mkError . show)) - . try @IOException - $ do - 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" $ - map ("-o" <>) fileOpts - <> mwhen noCabal ["--no-cabal"] - <> catMaybes - [ ("--start-line=" <>) . show <$> regionStartLine region - , ("--end-line=" <>) . show <$> regionEndLine region - ] - ){cwd = Just $ takeDirectory fp'} - contents - case exitCode of - ExitSuccess -> do - logWith recorder Debug $ StdErr err - pure . Right $ makeDiffTextEdit contents out - ExitFailure n -> do - logWith recorder Info $ StdErr err - pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n) + then mapExceptT liftIO $ ExceptT + $ handle @IOException + (pure . Left . PluginInternalError . T.pack . show) + $ runExceptT $ cliHandler fileOpts else do - let format fourmoluConfig = - bimap (mkError . show) (makeDiffTextEdit contents) + logWith recorder Debug $ LogCompiledInVersion VERSION_fourmolu + let format fourmoluConfig = ExceptT $ + bimap (PluginInternalError . T.pack . show) (InL . makeDiffTextEdit contents) #if MIN_VERSION_fourmolu(0,11,0) <$> try @OrmoluException (ormolu config fp' contents) #else @@ -121,37 +98,76 @@ defaultPrinterOpts } in liftIO (loadConfigFile fp') >>= \case - ConfigLoaded file opts -> liftIO $ do + ConfigLoaded file opts -> do logWith recorder Info $ ConfigPath file - format opts - ConfigNotFound searchDirs -> liftIO $ do + mapExceptT liftIO $ format opts + ConfigNotFound searchDirs -> do logWith recorder Info $ NoConfigPath searchDirs - format emptyConfig + mapExceptT liftIO $ format emptyConfig ConfigParseError f err -> do - sendNotification SWindowShowMessage $ + lift $ sendNotification SMethod_WindowShowMessage $ ShowMessageParams - { _xtype = MtError + { _type_ = MessageType_Error , _message = errorMessage } - return . Left $ responseError errorMessage + throwError $ PluginInternalError errorMessage where errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (showParseError err) where fp' = fromNormalizedFilePath fp title = "Formatting " <> T.pack (takeFileName fp') - mkError = responseError . ("Fourmolu: " <>) . T.pack lspPrinterOpts = mempty{poIndentation = Just $ fromIntegral $ fo ^. tabSize} region = case typ of FormatText -> RegionIndices Nothing Nothing FormatRange (Range (Position sl _) (Position el _)) -> RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1) + cliHandler :: [String] -> ExceptT PluginError IO ([TextEdit] |? Null) + cliHandler fileOpts = do + CLIVersionInfo{noCabal} <- do -- check Fourmolu version so that we know which flags to use + (exitCode, out, _err) <- liftIO $ 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 -> do + logWith recorder Debug $ LogExternalVersion v + pure CLIVersionInfo + { noCabal = v >= [0, 7] + } + Nothing -> do + logWith recorder Debug $ LogExternalVersion [] + logWith recorder Warning $ NoVersion out + pure CLIVersionInfo + { noCabal = True + } + (exitCode, out, err) <- -- run Fourmolu + liftIO $ readCreateProcessWithExitCode + ( proc "fourmolu" $ + map ("-o" <>) fileOpts + <> mwhen noCabal ["--no-cabal"] + <> catMaybes + [ ("--start-line=" <>) . show <$> regionStartLine region + , ("--end-line=" <>) . show <$> regionEndLine region + ] + ){cwd = Just $ takeDirectory fp'} + contents + case exitCode of + ExitSuccess -> do + logWith recorder Debug $ StdErr err + pure $ InL $ makeDiffTextEdit contents out + ExitFailure n -> do + logWith recorder Info $ StdErr err + throwError $ PluginInternalError $ "Fourmolu failed with exit code " <> T.pack (show n) data LogEvent = NoVersion Text | ConfigPath FilePath | NoConfigPath [FilePath] | StdErr Text + | LogCompiledInVersion String + | LogExternalVersion [Int] deriving (Show) instance Pretty LogEvent where @@ -161,6 +177,11 @@ 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) + LogCompiledInVersion v -> "Using compiled in fourmolu-" <> pretty v + LogExternalVersion v -> + "Using external fourmolu" + <> if null v then "" else "-" + <> pretty (intercalate "." $ map show v) convertDynFlags :: DynFlags -> [String] convertDynFlags df = diff --git a/src/Ide/Plugin/Fourmolu/Shim.hs b/src/Ide/Plugin/Fourmolu/Shim.hs --- a/src/Ide/Plugin/Fourmolu/Shim.hs +++ b/src/Ide/Plugin/Fourmolu/Shim.hs @@ -21,13 +21,15 @@ {-- Backport FourmoluConfig --} -#if !MIN_VERSION_fourmolu(0,7,0) +#if MIN_VERSION_fourmolu(0,7,0) +-- these functions are now defined +#else type FourmoluConfig = PrinterOptsPartial cfgFilePrinterOpts :: FourmoluConfig -> PrinterOptsPartial cfgFilePrinterOpts = id -cfgFileFixities :: FourmoluConfig -> FixityMap +cfgFileFixities :: FourmoluConfig -> FixityOverrides cfgFileFixities _ = mempty #endif @@ -45,15 +47,20 @@ emptyConfig = mempty #endif -{-- Backport FixityMap --} +{-- Backport FixityOverrides --} -#if MIN_VERSION_fourmolu(0,7,0) -addFixityOverrides :: FixityMap -> Config region -> Config region +#if MIN_VERSION_fourmolu(0,13,0) +addFixityOverrides :: FixityOverrides -> Config region -> Config region addFixityOverrides fixities cfg = cfg{cfgFixityOverrides = fixities} +#elif MIN_VERSION_fourmolu(0,7,0) +type FixityOverrides = FixityMap + +addFixityOverrides :: FixityOverrides -> Config region -> Config region +addFixityOverrides fixities cfg = cfg{cfgFixityOverrides = fixities} #else -type FixityMap = () +type FixityOverrides = () -addFixityOverrides :: FixityMap -> Config region -> Config region +addFixityOverrides :: FixityOverrides -> Config region -> Config region addFixityOverrides _ = id #endif diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -6,9 +6,9 @@ import Data.Aeson import Data.Functor import Ide.Plugin.Config -import qualified Ide.Plugin.Fourmolu as Fourmolu +import qualified Ide.Plugin.Fourmolu as Fourmolu +import Language.LSP.Protocol.Types import Language.LSP.Test -import Language.LSP.Types import System.FilePath import Test.Hls @@ -26,7 +26,7 @@ (if cli then "cli" else "lib") [ goldenWithFourmolu cli "formats correctly" "Fourmolu" "formatted" $ \doc -> do formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) - , goldenWithFourmolu cli "formats imports correctly" "Fourmolu" "formatted" $ \doc -> do + , goldenWithFourmolu cli "formats imports correctly" "Fourmolu2" "formatted" $ \doc -> do formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) ]