packages feed

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 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 =