Skip to content

Commit b829959

Browse files
authored
Merge branch 'master' into bench-lsp-typed
2 parents a96b9ba + 9c76ac9 commit b829959

File tree

3 files changed

+78
-37
lines changed

3 files changed

+78
-37
lines changed

plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,13 +23,15 @@ source-repository head
2323
location: git://github.com/haskell/haskell-language-server.git
2424

2525
library
26-
exposed-modules: Ide.Plugin.Fourmolu
26+
exposed-modules:
27+
Ide.Plugin.Fourmolu
28+
, Ide.Plugin.Fourmolu.Shim
2729
hs-source-dirs: src
2830
ghc-options: -Wall
2931
build-depends:
3032
, base >=4.12 && <5
3133
, filepath
32-
, fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.6 || ^>= 0.7
34+
, fourmolu ^>=0.3 || ^>=0.4 || ^>= 0.6 || ^>= 0.7 || ^>= 0.8
3335
, ghc
3436
, ghc-boot-th
3537
, ghcide ^>=1.7

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

Lines changed: 8 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE DataKinds #-}
32
{-# LANGUAGE DisambiguateRecordFields #-}
43
{-# LANGUAGE LambdaCase #-}
@@ -16,7 +15,7 @@ import Control.Exception (IOException, try)
1615
import Control.Lens ((^.))
1716
import Control.Monad
1817
import Control.Monad.IO.Class
19-
import Data.Bifunctor (first)
18+
import Data.Bifunctor (bimap, first)
2019
import Data.Maybe
2120
import Data.Text (Text)
2221
import qualified Data.Text as T
@@ -25,6 +24,7 @@ import Development.IDE.GHC.Compat as Compat hiding (Cpp, Warning,
2524
hang, vcat)
2625
import qualified Development.IDE.GHC.Compat.Util as S
2726
import GHC.LanguageExtensions.Type (Extension (Cpp))
27+
import Ide.Plugin.Fourmolu.Shim
2828
import Ide.Plugin.Properties
2929
import Ide.PluginUtils (makeDiffTextEdit,
3030
usePropertyLsp)
@@ -33,7 +33,6 @@ import Language.LSP.Server hiding (defaultConfig)
3333
import Language.LSP.Types hiding (line)
3434
import Language.LSP.Types.Lens (HasTabSize (tabSize))
3535
import Ormolu
36-
import Ormolu.Config
3736
import System.Exit
3837
import System.FilePath
3938
import System.Process.Run (cwd, proc)
@@ -100,17 +99,12 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl
10099
pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n)
101100
else do
102101
let format fourmoluConfig =
103-
first (mkError . show)
104-
<$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents))
102+
bimap (mkError . show) (makeDiffTextEdit contents)
103+
<$> try @OrmoluException (ormolu config fp' (T.unpack contents))
105104
where
106-
printerOpts =
107-
#if MIN_VERSION_fourmolu(0,7,0)
108-
cfgFilePrinterOpts fourmoluConfig
109-
#else
110-
fourmoluConfig
111-
112-
#endif
105+
printerOpts = cfgFilePrinterOpts fourmoluConfig
113106
config =
107+
addFixityOverrides (cfgFileFixities fourmoluConfig) $
114108
defaultConfig
115109
{ cfgDynOptions = map DynOption fileOpts
116110
, cfgRegion = region
@@ -119,29 +113,14 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl
119113
fillMissingPrinterOpts
120114
(printerOpts <> lspPrinterOpts)
121115
defaultPrinterOpts
122-
#if MIN_VERSION_fourmolu(0,7,0)
123-
, cfgFixityOverrides =
124-
cfgFileFixities fourmoluConfig
125-
#endif
126116
}
127117
in liftIO (loadConfigFile fp') >>= \case
128118
ConfigLoaded file opts -> liftIO $ do
129119
logWith recorder Info $ ConfigPath file
130120
format opts
131121
ConfigNotFound searchDirs -> liftIO $ do
132122
logWith recorder Info $ NoConfigPath searchDirs
133-
format emptyOptions
134-
where
135-
emptyOptions =
136-
#if MIN_VERSION_fourmolu(0,7,0)
137-
FourmoluConfig
138-
{ cfgFilePrinterOpts = mempty
139-
, cfgFileFixities = mempty
140-
}
141-
#else
142-
mempty
143-
#endif
144-
123+
format emptyConfig
145124
ConfigParseError f err -> do
146125
sendNotification SWindowShowMessage $
147126
ShowMessageParams
@@ -150,13 +129,7 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl
150129
}
151130
return . Left $ responseError errorMessage
152131
where
153-
errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (convertErr err)
154-
convertErr =
155-
#if MIN_VERSION_fourmolu(0,7,0)
156-
show
157-
#else
158-
snd
159-
#endif
132+
errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (showParseError err)
160133
where
161134
fp' = fromNormalizedFilePath fp
162135
title = "Formatting " <> T.pack (takeFileName fp')
Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
{-# LANGUAGE CPP #-}
2+
3+
module Ide.Plugin.Fourmolu.Shim (
4+
-- * FourmoluConfig
5+
cfgFilePrinterOpts,
6+
cfgFileFixities,
7+
emptyConfig,
8+
9+
-- * FixityMap
10+
addFixityOverrides,
11+
12+
-- * ConfigParseError
13+
showParseError,
14+
) where
15+
16+
import Ormolu.Config
17+
18+
#if MIN_VERSION_fourmolu(0,7,0)
19+
import Ormolu.Fixity
20+
#endif
21+
22+
{-- Backport FourmoluConfig --}
23+
24+
#if !MIN_VERSION_fourmolu(0,7,0)
25+
type FourmoluConfig = PrinterOptsPartial
26+
27+
cfgFilePrinterOpts :: FourmoluConfig -> PrinterOptsPartial
28+
cfgFilePrinterOpts = id
29+
30+
cfgFileFixities :: FourmoluConfig -> FixityMap
31+
cfgFileFixities _ = mempty
32+
#endif
33+
34+
#if MIN_VERSION_fourmolu(0,7,0)
35+
emptyConfig :: FourmoluConfig
36+
emptyConfig =
37+
FourmoluConfig
38+
{ cfgFilePrinterOpts = mempty
39+
, cfgFileFixities = mempty
40+
}
41+
#else
42+
emptyConfig :: FourmoluConfig
43+
emptyConfig = mempty
44+
#endif
45+
46+
{-- Backport FixityMap --}
47+
48+
#if MIN_VERSION_fourmolu(0,7,0)
49+
addFixityOverrides :: FixityMap -> Config region -> Config region
50+
addFixityOverrides fixities cfg = cfg{cfgFixityOverrides = fixities}
51+
#else
52+
type FixityMap = ()
53+
54+
addFixityOverrides :: FixityMap -> Config region -> Config region
55+
addFixityOverrides _ = id
56+
#endif
57+
58+
{-- Backport ConfigParseError --}
59+
60+
#if MIN_VERSION_fourmolu(0,7,0)
61+
showParseError :: Show parseException => parseException -> String
62+
showParseError = show
63+
#else
64+
showParseError :: (pos, String) -> String
65+
showParseError = snd
66+
#endif

0 commit comments

Comments
 (0)