hls-fourmolu-plugin 1.0.2.0 → 1.0.3.0
raw patch · 3 files changed
+112/−61 lines, 3 filesdep +aesondep +containersdep +process-extrasdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsnew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: aeson, containers, process-extras
Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
- Ide.Plugin.Fourmolu: provider :: FormattingHandler IdeState
+ Ide.Plugin.Fourmolu: provider :: PluginId -> FormattingHandler IdeState
Files
- hls-fourmolu-plugin.cabal +10/−4
- src/Ide/Plugin/Fourmolu.hs +85/−49
- test/Main.hs +17/−8
hls-fourmolu-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-fourmolu-plugin-version: 1.0.2.0+version: 1.0.3.0 synopsis: Integration with the Fourmolu code formatter description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -26,10 +26,11 @@ , fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.5 , ghc , ghc-boot-th- , ghcide ^>=1.6- , hls-plugin-api ^>=1.3+ , ghcide ^>=1.7+ , hls-plugin-api ^>=1.4 , lens , lsp+ , process-extras , text default-language: Haskell2010@@ -40,9 +41,14 @@ hs-source-dirs: test main-is: Main.hs ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ fourmolu:fourmolu build-depends: , base+ , aeson+ , containers , filepath , hls-fourmolu-plugin- , hls-test-utils ^>=1.2+ , hls-plugin-api+ , hls-test-utils ^>=1.3 , lsp-test
src/Ide/Plugin/Fourmolu.hs view
@@ -2,83 +2,119 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedLabels #-} module Ide.Plugin.Fourmolu ( descriptor, provider, ) where -import Control.Exception (try)+import Control.Exception (IOException, try) import Control.Lens ((^.))+import Control.Monad import Control.Monad.IO.Class import Data.Bifunctor (first)+import Data.Maybe 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 qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type (Extension (Cpp))-import Ide.PluginUtils (makeDiffTextEdit)+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.Lens (HasTabSize (tabSize)) import Ormolu+import System.Exit import System.FilePath---- ---------------------------------------------------------------------+import System.IO (stderr)+import System.Process.Run (proc, cwd)+import System.Process.Text (readCreateProcessWithExitCode) descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId)- { pluginHandlers = mkFormattingHandlers provider+ { pluginHandlers = mkFormattingHandlers $ provider plId } --- -----------------------------------------------------------------------provider :: FormattingHandler IdeState-provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do- ghc <- liftIO $ runAction "Fourmolu" ideState $ use GhcSession fp- fileOpts <- case hsc_dflags . hscEnv <$> ghc of- Nothing -> return []- Just df -> liftIO $ convertDynFlags df-- let format printerOpts =- first (responseError . ("Fourmolu: " <>) . T.pack . show)- <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents))- where- config =- defaultConfig- { cfgDynOptions = fileOpts- , cfgRegion = region- , cfgDebug = True- , cfgPrinterOpts =- fillMissingPrinterOpts- (printerOpts <> lspPrinterOpts)- defaultPrinterOpts- }+properties :: Properties '[ 'PropertyKey "external" 'TBoolean]+properties =+ emptyProperties+ & defineBooleanProperty+ #external+ "Call out to an external \"fourmolu\" executable, rather than using the bundled library"+ False - liftIO (loadConfigFile fp') >>= \case- ConfigLoaded file opts -> liftIO $ do- putStrLn $ "Loaded Fourmolu config from: " <> file- format opts- ConfigNotFound searchDirs -> liftIO $ do- putStrLn- . unlines- $ ("No " ++ show configFileName ++ " found in any of:") :- map (" " ++) searchDirs- format mempty- ConfigParseError f (_, err) -> do- sendNotification SWindowShowMessage $- ShowMessageParams- { _xtype = MtError- , _message = errorMessage- }- return . Left $ responseError errorMessage- where- errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err+provider :: PluginId -> FormattingHandler IdeState+provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do+ fileOpts <-+ maybe [] (convertDynFlags . hsc_dflags . hscEnv)+ <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp)+ useCLI <- usePropertyLsp #external plId properties+ if useCLI+ then liftIO+ . fmap (join . first (mkError . show))+ . try @IOException+ $ do+ (exitCode, out, err) <-+ readCreateProcessWithExitCode+ ( proc "fourmolu" $+ ["-d"]+ <> 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 ->+ pure . Right $ makeDiffTextEdit contents out+ ExitFailure n ->+ 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))+ where+ config =+ defaultConfig+ { cfgDynOptions = map DynOption fileOpts+ , cfgRegion = region+ , cfgDebug = True+ , cfgPrinterOpts =+ fillMissingPrinterOpts+ (printerOpts <> lspPrinterOpts)+ defaultPrinterOpts+ }+ in liftIO (loadConfigFile fp') >>= \case+ ConfigLoaded file opts -> liftIO $ do+ putStrLn $ "Loaded Fourmolu config from: " <> file+ format opts+ ConfigNotFound searchDirs -> liftIO $ do+ putStrLn+ . unlines+ $ ("No " ++ show configFileName ++ " found in any of:") :+ map (" " ++) searchDirs+ format mempty+ ConfigParseError f (_, err) -> do+ sendNotification SWindowShowMessage $+ ShowMessageParams+ { _xtype = MtError+ , _message = errorMessage+ }+ return . Left $ responseError errorMessage+ where+ errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack 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 ->@@ -86,7 +122,7 @@ FormatRange (Range (Position sl _) (Position el _)) -> RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1) -convertDynFlags :: DynFlags -> IO [DynOption]+convertDynFlags :: DynFlags -> [String] convertDynFlags df = let pp = ["-pgmF=" <> p | not (null p)] p = sPgm_F $ Compat.settings df@@ -95,4 +131,4 @@ showExtension = \case Cpp -> "-XCPP" x -> "-X" ++ show x- in return $ map DynOption $ pp <> pm <> ex+ in pp <> pm <> ex
test/Main.hs view
@@ -3,6 +3,9 @@ ( main ) where +import Data.Aeson+import Data.Functor+import Ide.Plugin.Config import qualified Ide.Plugin.Fourmolu as Fourmolu import Language.LSP.Test import Language.LSP.Types@@ -16,15 +19,21 @@ fourmoluPlugin = Fourmolu.descriptor "fourmolu" tests :: TestTree-tests = testGroup "fourmolu"- [ goldenWithFourmolu "formats correctly" "Fourmolu" "formatted" $ \doc -> do- formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)- , goldenWithFourmolu "formats imports correctly" "Fourmolu" "formatted" $ \doc -> do- formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)- ]+tests =+ testGroup "fourmolu" $+ [False, True] <&> \cli ->+ testGroup+ (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+ formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)+ ] -goldenWithFourmolu :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree-goldenWithFourmolu title path desc = goldenWithHaskellDocFormatter fourmoluPlugin "fourmolu" title testDataDir path desc "hs"+goldenWithFourmolu :: Bool -> TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree+goldenWithFourmolu cli title path desc = goldenWithHaskellDocFormatter fourmoluPlugin "fourmolu" conf title testDataDir path desc "hs"+ where+ conf = def{plcConfig = (\(Object obj) -> obj) $ object ["external" .= cli]} testDataDir :: FilePath testDataDir = "test" </> "testdata"