haskell/haskell-language-server
1
1
Fork 0
mirror of https://github.com/haskell/haskell-language-server.git synced 2024-10-26 17:32:57 +03:00
Code Issues Projects Releases Wiki Activity

Support fourmolu ^>= 0.7 (#2944)

Browse Source
This commit is contained in:
Matt Parsons 2022-06-10 22:45:21 -06:00 committed by GitHub
parent 140f9040ae
commit bb6b4e167a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 46 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal
View File

@ -9,6 +9,8 @@ license: Apache-2.0
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,6 +18,10 @@ extra-source-files:
LICENSE
test/testdata/**/*.hs
source-repository head
type: git
location: git://github.com/haskell/haskell-language-server.git
library
exposed-modules: Ide.Plugin.Fourmolu
hs-source-dirs: src
@ -23,7 +29,7 @@ library
build-depends:
, base >=4.12 && <5
, filepath
, fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.6
, fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.6 || ^>= 0.7
, ghc
, ghc-boot-th
, ghcide ^>=1.7

47
plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs
View File

@ -1,9 +1,10 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
module Ide.Plugin.Fourmolu (
descriptor,
@ -23,16 +24,18 @@ 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.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.Lens (HasTabSize (tabSize))
import Ormolu
import Ormolu.Config
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)
descriptor :: PluginId -> PluginDescriptor IdeState
@ -78,10 +81,17 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
ExitFailure n ->
pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n)
else do
let format printerOpts =
let format fourmoluConfig =
first (mkError . show)
<$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents))
where
printerOpts =
#if MIN_VERSION_fourmolu(0,7,0)
cfgFilePrinterOpts fourmoluConfig
#else
fourmoluConfig
#endif
config =
defaultConfig
{ cfgDynOptions = map DynOption fileOpts
@ -91,6 +101,10 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
fillMissingPrinterOpts
(printerOpts <> lspPrinterOpts)
defaultPrinterOpts
#if MIN_VERSION_fourmolu(0,7,0)
, cfgFixityOverrides =
cfgFileFixities fourmoluConfig
#endif
}
in liftIO (loadConfigFile fp') >>= \case
ConfigLoaded file opts -> liftIO $ do
@ -101,8 +115,19 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
. unlines
$ ("No " ++ show configFileName ++ " found in any of:") :
map (" " ++) searchDirs
format mempty
ConfigParseError f (_, err) -> do
format emptyOptions
where
emptyOptions =
#if MIN_VERSION_fourmolu(0,7,0)
FourmoluConfig
{ cfgFilePrinterOpts = mempty
, cfgFileFixities = mempty
}
#else
mempty
#endif
ConfigParseError f err -> do
sendNotification SWindowShowMessage $
ShowMessageParams
{ _xtype = MtError
@ -110,7 +135,13 @@ provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancell
}
return . Left $ responseError errorMessage
where
errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err
errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (convertErr err)
convertErr =
#if MIN_VERSION_fourmolu(0,7,0)
show
#else
snd
#endif
where
fp' = fromNormalizedFilePath fp
title = "Formatting " <> T.pack (takeFileName fp')