diff --git a/hls-ormolu-plugin.cabal b/hls-ormolu-plugin.cabal --- a/hls-ormolu-plugin.cabal +++ b/hls-ormolu-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-ormolu-plugin -version: 2.2.0.0 +version: 2.3.0.0 synopsis: Integration with the Ormolu code formatter description: Please see the README on GitHub at @@ -33,13 +33,15 @@ , filepath , ghc , ghc-boot-th - , ghcide == 2.2.0.0 - , hls-plugin-api == 2.2.0.0 + , ghcide == 2.3.0.0 + , hls-plugin-api == 2.3.0.0 , lens , lsp , mtl + , process-extras >= 0.7.1 , ormolu ^>=0.1.2 || ^>= 0.2 || ^>= 0.3 || ^>= 0.5 || ^>= 0.6 || ^>= 0.7 , text + , transformers default-language: Haskell2010 @@ -51,11 +53,16 @@ hs-source-dirs: test main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: + ormolu:ormolu build-depends: , base + , aeson + , containers , filepath , hls-ormolu-plugin - , hls-test-utils == 2.2.0.0 + , hls-plugin-api + , hls-test-utils == 2.3.0.0 , lsp-types , text , ormolu diff --git a/src/Ide/Plugin/Ormolu.hs b/src/Ide/Plugin/Ormolu.hs --- a/src/Ide/Plugin/Ormolu.hs +++ b/src/Ide/Plugin/Ormolu.hs @@ -1,22 +1,32 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} module Ide.Plugin.Ormolu ( descriptor , provider + , LogEvent ) where import Control.Exception (Handler (..), IOException, - SomeException (..), catches) + SomeException (..), catches, + handle) import Control.Monad.Except (ExceptT (ExceptT), runExceptT, throwError) import Control.Monad.Extra import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans +import Control.Monad.Trans.Except (ExceptT (..), mapExceptT, + runExceptT) import Data.Functor ((<&>)) +import Data.List (intercalate) +import Data.Maybe (catMaybes) +import Data.Text (Text) import qualified Data.Text as T import Development.IDE hiding (pluginHandlers) import Development.IDE.GHC.Compat (hsc_dflags, moduleNameString) @@ -24,6 +34,7 @@ import qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type import Ide.Plugin.Error (PluginError (PluginInternalError)) +import Ide.Plugin.Properties import Ide.PluginUtils import Ide.Types hiding (Config) import qualified Ide.Types as Types @@ -31,72 +42,91 @@ import Language.LSP.Protocol.Types import Language.LSP.Server hiding (defaultConfig) import Ormolu -import System.FilePath (takeFileName) +import System.Exit +import System.FilePath +import System.Process.Run (cwd, proc) +import System.Process.Text (readCreateProcessWithExitCode) +import Text.Read (readMaybe) -- --------------------------------------------------------------------- -descriptor :: Recorder (WithPriority T.Text) -> PluginId -> PluginDescriptor IdeState -descriptor recorder plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkFormattingHandlers $ provider recorder - } +descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState +descriptor recorder plId = + (defaultPluginDescriptor plId) + { pluginHandlers = mkFormattingHandlers $ provider recorder plId, + pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties} + } +properties :: Properties '[ 'PropertyKey "external" 'TBoolean] +properties = + emptyProperties + & defineBooleanProperty + #external + "Call out to an external \"ormolu\" executable, rather than using the bundled library" + False + -- --------------------------------------------------------------------- -provider :: Recorder (WithPriority T.Text) -> FormattingHandler IdeState -provider recorder ideState typ contents fp _ = ExceptT $ withIndefiniteProgress title Cancellable $ runExceptT $ do - ghc <- liftIO $ runAction "Ormolu" ideState $ use GhcSession fp - let df = hsc_dflags . hscEnv <$> ghc - fileOpts <- case df of - Nothing -> pure [] - Just df -> pure $ fromDyn df +provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState +provider recorder plId ideState typ contents fp _ = ExceptT $ withIndefiniteProgress title Cancellable $ runExceptT $ do + fileOpts <- + maybe [] (fromDyn . hsc_dflags . hscEnv) + <$> liftIO (runAction "Ormolu" ideState $ use GhcSession fp) + useCLI <- liftIO $ runAction "Ormolu" ideState $ usePropertyAction #external plId properties - logWith recorder Debug $ "Using ormolu-" <> VERSION_ormolu + if useCLI + then mapExceptT liftIO $ ExceptT + $ handle @IOException + (pure . Left . PluginInternalError . T.pack . show) + $ runExceptT $ cliHandler fileOpts + else do + logWith recorder Debug $ LogCompiledInVersion VERSION_ormolu - let - fullRegion = RegionIndices Nothing Nothing - rangeRegion s e = RegionIndices (Just $ s + 1) (Just $ e + 1) - mkConf o region = defaultConfig { cfgDynOptions = o, cfgRegion = region } - fmt :: T.Text -> Config RegionIndices -> IO (Either SomeException T.Text) - fmt cont conf = flip catches handlers $ do - let fp' = fromNormalizedFilePath fp + let + fmt :: T.Text -> Config RegionIndices -> IO (Either SomeException T.Text) + fmt cont conf = flip catches handlers $ do #if MIN_VERSION_ormolu(0,5,3) - cabalInfo <- getCabalInfoForSourceFile fp' <&> \case - CabalNotFound -> Nothing - CabalDidNotMention cabalInfo -> Just cabalInfo - CabalFound cabalInfo -> Just cabalInfo + cabalInfo <- getCabalInfoForSourceFile fp' <&> \case + CabalNotFound -> Nothing + CabalDidNotMention cabalInfo -> Just cabalInfo + CabalFound cabalInfo -> Just cabalInfo #if MIN_VERSION_ormolu(0,7,0) - (fixityOverrides, moduleReexports) <- getDotOrmoluForSourceFile fp' - let conf' = refineConfig ModuleSource cabalInfo (Just fixityOverrides) (Just moduleReexports) conf + (fixityOverrides, moduleReexports) <- getDotOrmoluForSourceFile fp' + let conf' = refineConfig ModuleSource cabalInfo (Just fixityOverrides) (Just moduleReexports) conf #else - fixityOverrides <- traverse getFixityOverridesForSourceFile cabalInfo - let conf' = refineConfig ModuleSource cabalInfo fixityOverrides conf + fixityOverrides <- traverse getFixityOverridesForSourceFile cabalInfo + let conf' = refineConfig ModuleSource cabalInfo fixityOverrides conf #endif - let cont' = cont + let cont' = cont #else - let conf' = conf - cont' = T.unpack cont + let conf' = conf + cont' = T.unpack cont #endif - Right <$> ormolu conf' fp' cont' - handlers = - [ Handler $ pure . Left . SomeException @OrmoluException - , Handler $ pure . Left . SomeException @IOException - ] + Right <$> ormolu conf' fp' cont' + handlers = + [ Handler $ pure . Left . SomeException @OrmoluException + , Handler $ pure . Left . SomeException @IOException + ] - case typ of - FormatText -> do - res <- liftIO $ fmt contents (mkConf fileOpts fullRegion) - ret res - FormatRange (Range (Position sl _) (Position el _)) -> do - res <- liftIO $ fmt contents (mkConf fileOpts (rangeRegion (fromIntegral sl) (fromIntegral el))) - ret res + res <- liftIO $ fmt contents defaultConfig { cfgDynOptions = map DynOption fileOpts, cfgRegion = region } + ret res where + fp' = fromNormalizedFilePath fp + + region :: RegionIndices + region = case typ of + FormatText -> + RegionIndices Nothing Nothing + FormatRange (Range (Position sl _) (Position el _)) -> + RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1) + title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp) ret :: Either SomeException T.Text -> ExceptT PluginError (LspM Types.Config) ([TextEdit] |? Null) ret (Left err) = throwError $ PluginInternalError . T.pack $ "ormoluCmd: " ++ show err ret (Right new) = pure $ InL $ makeDiffTextEdit contents new - fromDyn :: D.DynFlags -> [DynOption] + fromDyn :: D.DynFlags -> [String] fromDyn df = let pp = @@ -104,8 +134,70 @@ in ["-pgmF=" <> p | not (null p)] pm = ("-fplugin=" <>) . moduleNameString <$> D.pluginModNames df ex = showExtension <$> S.toList (D.extensionFlags df) - in - DynOption <$> pp <> pm <> ex + in pp <> pm <> ex + + cliHandler :: [String] -> ExceptT PluginError IO ([TextEdit] |? Null) + cliHandler fileOpts = do + CLIVersionInfo{noCabal} <- do -- check Ormolu version so that we know which flags to use + (exitCode, out, _err) <- liftIO $ readCreateProcessWithExitCode ( proc "ormolu" ["--version"] ) "" + let version = do + guard $ exitCode == ExitSuccess + "ormolu" : 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) <- do -- run Ormolu + let commandArgs = map ("-o" <>) fileOpts + -- "The --stdin-input-file option is necessary when using input from + -- stdin and accounting for .cabal files" as per Ormolu documentation + <> (if noCabal then ["--no-cabal"] else ["--stdin-input-file", fp']) + <> catMaybes + [ ("--start-line=" <>) . show <$> regionStartLine region + , ("--end-line=" <>) . show <$> regionEndLine region + ] + cwd = takeDirectory fp' + logWith recorder Debug $ LogOrmoluCommand commandArgs cwd + liftIO $ readCreateProcessWithExitCode (proc "ormolu" commandArgs) {cwd = Just cwd} contents + case exitCode of + ExitSuccess -> do + when (not $ T.null err) $ logWith recorder Debug $ StdErr err + pure $ InL $ makeDiffTextEdit contents out + ExitFailure n -> do + logWith recorder Info $ StdErr err + throwError $ PluginInternalError $ "Ormolu failed with exit code " <> T.pack (show n) + +newtype CLIVersionInfo = CLIVersionInfo + { noCabal :: Bool + } + +data LogEvent + = NoVersion Text + | StdErr Text + | LogCompiledInVersion String + | LogExternalVersion [Int] + | LogOrmoluCommand [String] FilePath + deriving (Show) + +instance Pretty LogEvent where + pretty = \case + NoVersion t -> "Couldn't get Ormolu version:" <> line <> indent 2 (pretty t) + StdErr t -> "Ormolu stderr:" <> line <> indent 2 (pretty t) + LogCompiledInVersion v -> "Using compiled in ormolu-" <> pretty v + LogExternalVersion v -> + "Using external ormolu" + <> if null v then "" else "-" + <> pretty (intercalate "." $ map show v) + LogOrmoluCommand commandArgs cwd -> "Running: `ormolu " <> pretty (unwords commandArgs) <> "` in directory " <> pretty cwd showExtension :: Extension -> String showExtension Cpp = "-XCPP" diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -4,7 +4,10 @@ ( main ) where +import Data.Aeson +import Data.Functor import qualified Data.Text as T +import Ide.Plugin.Config import qualified Ide.Plugin.Ormolu as Ormolu import Language.LSP.Protocol.Types import System.FilePath @@ -13,23 +16,27 @@ main :: IO () main = defaultTestRunner tests -ormoluPlugin :: PluginTestDescriptor T.Text +ormoluPlugin :: PluginTestDescriptor Ormolu.LogEvent ormoluPlugin = mkPluginTestDescriptor Ormolu.descriptor "ormolu" tests :: TestTree -tests = testGroup "ormolu" - [ goldenWithOrmolu "formats correctly" "Ormolu" "formatted" $ \doc -> do - formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) - , goldenWithOrmolu "formats imports correctly" "Ormolu2" "formatted" $ \doc -> do - formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) +tests = testGroup "ormolu" $ + [False, True] <&> \cli -> + testGroup (if cli then "cli" else "lib") + [ goldenWithOrmolu cli "formats correctly" "Ormolu" "formatted" $ \doc -> do + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + , goldenWithOrmolu cli "formats imports correctly" "Ormolu2" "formatted" $ \doc -> do + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) #if MIN_VERSION_ormolu(0,5,3) - , goldenWithOrmolu "formats operators correctly" "Ormolu3" "formatted" $ \doc -> do - formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + , goldenWithOrmolu cli "formats operators correctly" "Ormolu3" "formatted" $ \doc -> do + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) #endif - ] + ] -goldenWithOrmolu :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithOrmolu title path desc = goldenWithHaskellDocFormatter def ormoluPlugin "ormolu" def title testDataDir path desc "hs" +goldenWithOrmolu :: Bool -> TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree +goldenWithOrmolu cli title path desc = goldenWithHaskellDocFormatter def ormoluPlugin "ormolu" def title testDataDir path desc "hs" + where + conf = def{plcConfig = (\(Object obj) -> obj) $ object ["external" .= cli]} testDataDir :: FilePath testDataDir = "test" "testdata"