diff --git a/cabal.project b/cabal.project index a7b601076d..74e553f3f8 100644 --- a/cabal.project +++ b/cabal.project @@ -20,6 +20,6 @@ package ghcide write-ghc-environment-files: never -index-state: 2020-09-30T21:52:43Z +index-state: 2020-10-02T22:25:53Z allow-newer: data-tree-print:base diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index e49e1a5451..80db306c81 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -124,7 +124,7 @@ executable haskell-language-server , containers , deepseq , floskell ^>=0.10 - , fourmolu ^>=0.1 + , fourmolu ^>=0.2 , ghc , ghc-boot-th , ghcide >=0.1 @@ -155,7 +155,7 @@ executable haskell-language-server , transformers , unordered-containers , ghc-source-gen - , refinery >=0.2.0.0 + , refinery ^>=0.2 , ghc-exactprint , fingertree diff --git a/plugins/default/src/Ide/Plugin/Fourmolu.hs b/plugins/default/src/Ide/Plugin/Fourmolu.hs index 7f621d0153..3db9c48259 100644 --- a/plugins/default/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/default/src/Ide/Plugin/Fourmolu.hs @@ -1,90 +1,111 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} -module Ide.Plugin.Fourmolu - ( - descriptor - , provider - ) -where +module Ide.Plugin.Fourmolu ( + descriptor, + provider, +) where -import Control.Exception -import qualified Data.Text as T -import Development.IDE as D -import qualified DynFlags as D -import qualified EnumSet as S -import GHC -import GHC.LanguageExtensions.Type -import GhcPlugins (HscEnv (hsc_dflags)) -import Ide.Plugin.Formatter -import Ide.PluginUtils -import Ide.Types -import Language.Haskell.LSP.Core (LspFuncs (withIndefiniteProgress), - ProgressCancellable (Cancellable)) -import Language.Haskell.LSP.Types +import Control.Exception +import Data.Either.Extra +import System.FilePath + +import Control.Lens ((^.)) +import qualified Data.Text as T +import Development.IDE as D +import qualified DynFlags as D +import qualified EnumSet as S +import GHC (DynFlags, moduleNameString) +import GHC.LanguageExtensions.Type (Extension (Cpp)) +import GhcPlugins (HscEnv (hsc_dflags)) +import Ide.Plugin.Formatter (responseError) +import Ide.PluginUtils (makeDiffTextEdit) +import Language.Haskell.LSP.Messages (FromServerMessage (ReqShowMessage)) + +import Ide.Types +import Language.Haskell.LSP.Core +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Lens import "fourmolu" Ormolu -import System.FilePath (takeFileName) -import Text.Regex.TDFA.Text () -- --------------------------------------------------------------------- descriptor :: PluginId -> PluginDescriptor -descriptor plId = (defaultPluginDescriptor plId) - { pluginFormattingProvider = Just provider - } +descriptor plId = + (defaultPluginDescriptor plId) + { pluginFormattingProvider = Just provider + } -- --------------------------------------------------------------------- provider :: FormattingProvider IO -provider lf ideState typ contents fp _ = withIndefiniteProgress lf title Cancellable $ do - let - fromDyn :: DynFlags -> IO [DynOption] - fromDyn df = - let - pp = - let p = D.sPgm_F $ D.settings df - in if null p then [] else ["-pgmF=" <> p] - pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df - ex = map showExtension $ S.toList $ D.extensionFlags df - in - return $ map DynOption $ pp <> pm <> ex +provider lf ideState typ contents fp fo = withIndefiniteProgress lf title Cancellable $ do + ghc <- runAction "Fourmolu" ideState $ use GhcSession fp + fileOpts <- case hsc_dflags . hscEnv <$> ghc of + Nothing -> return [] + Just df -> convertDynFlags df - ghc <- runAction "Fourmolu" ideState $ use GhcSession fp - let df = hsc_dflags . hscEnv <$> ghc - fileOpts <- case df of - Nothing -> return [] - Just df -> fromDyn df + let format printerOpts = + mapLeft (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 + (lspPrinterOpts <> printerOpts) + defaultPrinterOpts + } - let - fullRegion = RegionIndices Nothing Nothing - rangeRegion s e = RegionIndices (Just $ s + 1) (Just $ e + 1) - mkConf o region = do - printerOpts <- loadConfigFile True (Just fp') defaultPrinterOpts - return $ defaultConfig - { cfgDynOptions = o - , cfgRegion = region - , cfgDebug = True - , cfgPrinterOpts = printerOpts - } - fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text) - fmt cont conf = - try @OrmoluException (ormolu conf fp' $ T.unpack cont) + loadConfigFile fp' >>= \case + ConfigLoaded file opts -> do + putStrLn $ "Loaded Fourmolu config from: " <> file + format opts + ConfigNotFound searchDirs -> do + putStrLn + . unlines + $ ("No " ++ show configFileName ++ " found in any of:") : + map (" " ++) searchDirs + format mempty + ConfigParseError f (_, err) -> do + sendFunc lf . ReqShowMessage $ + RequestMessage + { _jsonrpc = "" + , _id = IdString "fourmolu" + , _method = WindowShowMessageRequest + , _params = + ShowMessageRequestParams + { _xtype = MtError + , _message = errorMessage + , _actions = Nothing + } + } + 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') + lspPrinterOpts = mempty{poIndentation = Just $ fo ^. tabSize} + region = case typ of + FormatText -> + RegionIndices Nothing Nothing + FormatRange (Range (Position sl _) (Position el _)) -> + RegionIndices (Just $ sl + 1) (Just $ el + 1) - case typ of - FormatText -> ret <$> (fmt contents =<< mkConf fileOpts fullRegion) - FormatRange (Range (Position sl _) (Position el _)) -> - ret <$> (fmt contents =<< mkConf fileOpts (rangeRegion sl el)) - where - title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp) - ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit) - ret (Left err) = Left - (responseError (T.pack $ "fourmoluCmd: " ++ show err) ) - ret (Right new) = Right (makeDiffTextEdit contents new) - -showExtension :: Extension -> String -showExtension Cpp = "-XCPP" -showExtension other = "-X" ++ show other +convertDynFlags :: DynFlags -> IO [DynOption] +convertDynFlags df = + let pp = if null p then [] else ["-pgmF=" <> p] + p = D.sPgm_F $ D.settings df + pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df + ex = map showExtension $ S.toList $ D.extensionFlags df + showExtension = \case + Cpp -> "-XCPP" + x -> "-X" ++ show x + in return $ map DynOption $ pp <> pm <> ex diff --git a/stack-8.10.1.yaml b/stack-8.10.1.yaml index d198452493..3c36a35aa8 100644 --- a/stack-8.10.1.yaml +++ b/stack-8.10.1.yaml @@ -16,7 +16,7 @@ extra-deps: - clock-0.7.2 - data-tree-print-0.1.0.2 - floskell-0.10.4 -- fourmolu-0.1.0.0@rev:1 +- fourmolu-0.2.0.0 - HsYAML-aeson-0.2.0.0@rev:2 - monad-dijkstra-0.1.1.2 - opentelemetry-0.4.2 diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index a917a40fe9..3d2e073eee 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -17,7 +17,7 @@ extra-deps: - clock-0.7.2 - data-tree-print-0.1.0.2 - floskell-0.10.4 -- fourmolu-0.1.0.0@rev:1 +- fourmolu-0.2.0.0 - HsYAML-aeson-0.2.0.0@rev:2 - monad-dijkstra-0.1.1.2 - opentelemetry-0.4.2 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 116d7619c0..5aa9ac4601 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -21,7 +21,7 @@ extra-deps: - clock-0.7.2 - extra-1.7.3 - floskell-0.10.4 -- fourmolu-0.1.0.0@rev:1 +- fourmolu-0.2.0.0 - fuzzy-0.1.0.0 # - ghcide-0.1.0 - ghc-check-0.5.0.1 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 65e1e14ee4..eb945bec67 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -20,7 +20,7 @@ extra-deps: - clock-0.7.2 - extra-1.7.3 - floskell-0.10.4 -- fourmolu-0.1.0.0@rev:1 +- fourmolu-0.2.0.0 - fuzzy-0.1.0.0 # - ghcide-0.1.0 - ghc-check-0.5.0.1 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index 2b2308268d..ee418079d6 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -19,7 +19,7 @@ extra-deps: - constrained-dynamic-0.1.0.0 - extra-1.7.3 - floskell-0.10.4 -- fourmolu-0.1.0.0@rev:1 +- fourmolu-0.2.0.0 # - ghcide-0.1.0 - ghc-check-0.5.0.1 - ghc-lib-parser-8.10.1.20200523 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 30a7c72bb3..54ef372619 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -19,7 +19,7 @@ extra-deps: - constrained-dynamic-0.1.0.0 - extra-1.7.3 - floskell-0.10.4 -- fourmolu-0.1.0.0@rev:1 +- fourmolu-0.2.0.0 # - ghcide-0.1.0 - haskell-src-exts-1.21.1 - hlint-2.2.8 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 10bc12c58d..9719e58bbc 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -21,7 +21,7 @@ extra-deps: - constrained-dynamic-0.1.0.0 - extra-1.7.3 - floskell-0.10.4 -- fourmolu-0.1.0.0@rev:1 +- fourmolu-0.2.0.0 # - ghcide-0.1.0 - haskell-src-exts-1.21.1 - hie-bios-0.7.1 diff --git a/stack.yaml b/stack.yaml index 65e1e14ee4..eb945bec67 100644 --- a/stack.yaml +++ b/stack.yaml @@ -20,7 +20,7 @@ extra-deps: - clock-0.7.2 - extra-1.7.3 - floskell-0.10.4 -- fourmolu-0.1.0.0@rev:1 +- fourmolu-0.2.0.0 - fuzzy-0.1.0.0 # - ghcide-0.1.0 - ghc-check-0.5.0.1 diff --git a/test/testdata/Format.fourmolu.formatted.hs b/test/testdata/Format.fourmolu.formatted.hs index 41dba5b34d..5342473189 100644 --- a/test/testdata/Format.fourmolu.formatted.hs +++ b/test/testdata/Format.fourmolu.formatted.hs @@ -1,13 +1,13 @@ module Format where -import Data.Int import Data.List + +import Data.Int import Prelude foo :: Int -> Int foo 3 = 2 foo x = x - bar :: String -> IO String bar s = do x <- return "hello"