hls-fourmolu-plugin 1.0.3.0 → 1.1.0.0
raw patch · 4 files changed
+165/−40 lines, 4 filesdep ~fourmoludep ~ghcidedep ~hls-plugin-apiPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: fourmolu, ghcide, hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
+ Ide.Plugin.Fourmolu: instance GHC.Show.Show Ide.Plugin.Fourmolu.LogEvent
+ Ide.Plugin.Fourmolu: instance Prettyprinter.Internal.Pretty Ide.Plugin.Fourmolu.LogEvent
+ Ide.Plugin.Fourmolu.Shim: addFixityOverrides :: FixityMap -> Config region -> Config region
+ Ide.Plugin.Fourmolu.Shim: cfgFileFixities :: FourmoluConfig -> FixityMap
+ Ide.Plugin.Fourmolu.Shim: cfgFilePrinterOpts :: FourmoluConfig -> PrinterOptsPartial
+ Ide.Plugin.Fourmolu.Shim: emptyConfig :: FourmoluConfig
+ Ide.Plugin.Fourmolu.Shim: showParseError :: Show parseException => parseException -> String
- Ide.Plugin.Fourmolu: descriptor :: PluginId -> PluginDescriptor IdeState
+ Ide.Plugin.Fourmolu: descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState
- Ide.Plugin.Fourmolu: provider :: PluginId -> FormattingHandler IdeState
+ Ide.Plugin.Fourmolu: provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState
Files
- hls-fourmolu-plugin.cabal +23/−7
- src/Ide/Plugin/Fourmolu.hs +73/−32
- src/Ide/Plugin/Fourmolu/Shim.hs +68/−0
- test/Main.hs +1/−1
hls-fourmolu-plugin.cabal view
@@ -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 <https://github.com/haskell/haskell-language-server#readme>@@ -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
src/Ide/Plugin/Fourmolu.hs view
@@ -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
+ src/Ide/Plugin/Fourmolu/Shim.hs view
@@ -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
test/Main.hs view
@@ -16,7 +16,7 @@ main = defaultTestRunner tests fourmoluPlugin :: PluginDescriptor IdeState-fourmoluPlugin = Fourmolu.descriptor "fourmolu"+fourmoluPlugin = Fourmolu.descriptor mempty "fourmolu" tests :: TestTree tests =