hls-ormolu-plugin 2.2.0.0 → 2.3.0.0

raw patch · 3 files changed

+168/−62 lines, 3 filesdep +aesondep +containersdep +process-extrasdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, containers, process-extras, transformers

Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils

API changes (from Hackage documentation)

Files

• hls-ormolu-plugin.cabal +11/−4
• src/Ide/Plugin/Ormolu.hs +139/−47
• test/Main.hs +18/−11

@@ -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 <https://github.com/haskell/haskell-language-server#readme>@@ -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

@@ -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"

@@ -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"