Skip to content

Commit 2625689

Browse files
jneiraAnton-Latukhamichaelpjmergify[bot]
authored
Add support for brittany (needs aeson-2) and floskell with ghc-9.0.1 (#2551)
* Enable tests for brittany and 9.0.2 * Enable tests for floskell plugin * cabal-ghc901.project: naively enable brittany * haskell-language-server.cabal: bump brittany flag <(9.0.1->9.2.1) * Trying to add support for brittany * Use last hackage floskell version * Activate floskell in func-test suite * Restrict brittany in hackage for ghc<9.0.1 * Adapt to Aeson.Key * Update lsp source repo package * Refer pr for butcher * Add missing prefix * Adapt to aeson-2 (incomplete) * Use compat module * Support for aeson-2 and extra-1.7.10 * Remove lsp * Allow newer aeson for stylish-haskell * Add needed import for non windows * Remove insertJson and toJsonKey * Update cabal-ghc901.project * Missing import * Avoid CPP by using lens-aeson * Update hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs * Use ghcide compat module * Use type alias in cpp * Fix stack build for ghc-8.6.5 * Use lens-aeson key * Use lens-aeson in func-test * Fixup shake-bench * Update docs * Switch to lens ix * Try this Co-authored-by: Anton-Latukha <[email protected]> Co-authored-by: Michael Peyton Jones <[email protected]> Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent f7b4b55 commit 2625689

File tree

21 files changed

+134
-106
lines changed

21 files changed

+134
-106
lines changed

‎.github/workflows/test.yml

+1-1
Original file line numberDiff line numberDiff line change
@@ -144,7 +144,7 @@ jobs:
144144

145145
run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper"
146146

147-
- if: matrix.test && matrix.ghc != '9.0.1'
147+
- if: matrix.test
148148
name: Test hls-brittany-plugin
149149
run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS"
150150

‎cabal-ghc901.project

+9-6
Original file line numberDiff line numberDiff line change
@@ -41,22 +41,25 @@ index-state: 2021-12-29T12:30:08Z
4141

4242
constraints:
4343
-- These plugins don't work on GHC9 yet
44-
haskell-language-server +ignore-plugins-ghc-bounds -brittany -stylishhaskell -tactic,
44+
-- Add a plugin needs remove the -flag but also update ghc bounds in hls.cabal
45+
haskell-language-server +ignore-plugins-ghc-bounds -stylishhaskell -tactic,
4546
ghc-lib-parser ^>= 9.0
4647

4748
-- although we are not building all plugins cabal solver phase is run for all packages
4849
-- this way we track explicitly all transitive dependencies which need support for ghc-9
4950
allow-newer:
50-
brittany:base,
51-
brittany:ghc,
52-
brittany:ghc-boot-th,
53-
-- for brittany
54-
butcher:base,
51+
52+
-- brittany: update ghc bounds in hls.cabal when those are removed
53+
-- https://github.com/lspitzner/multistate/pull/8
5554
multistate:base,
55+
-- https://github.com/lspitzner/data-tree-print/pull/3
5656
data-tree-print:base,
57+
-- https://github.com/lspitzner/butcher/pull/8
58+
butcher:base,
5759

5860
stylish-haskell:Cabal,
5961
stylish-haskell:ghc-lib-parser,
62+
stylish-haskell:aeson,
6063

6164
floskell:base,
6265
floskell:ghc-prim,

‎ghcide/ghcide.cabal

+1-2
Original file line numberDiff line numberDiff line change
@@ -49,8 +49,7 @@ library
4949
dependent-sum,
5050
dlist,
5151
exceptions,
52-
-- we can't use >= 1.7.10 while we have to use hlint == 3.2.*
53-
extra >= 1.7.4 && < 1.7.10,
52+
extra >= 1.7.4,
5453
fuzzy,
5554
filepath,
5655
fingertree,

‎ghcide/src/Control/Concurrent/Strict.hs

+6-5
Original file line numberDiff line numberDiff line change
@@ -4,31 +4,32 @@ module Control.Concurrent.Strict
44
,module Control.Concurrent.Extra
55
) where
66

7-
import Control.Concurrent.Extra hiding (modifyVar, modifyVar_)
7+
import Control.Concurrent.Extra hiding (modifyVar, modifyVar',
8+
modifyVar_)
89
import qualified Control.Concurrent.Extra as Extra
910
import Control.Exception (evaluate)
1011
import Control.Monad (void)
1112
import Data.Tuple.Extra (dupe)
1213

1314
-- | Strict modification that returns the new value
14-
modifyVar' :: Var a -> (a -> a) -> IO a
15+
modifyVar' :: Extra.Var a -> (a -> a) -> IO a
1516
modifyVar' var upd = modifyVarIO' var (pure . upd)
1617

1718
-- | Strict modification that returns the new value
18-
modifyVarIO' :: Var a -> (a -> IO a) -> IO a
19+
modifyVarIO' :: Extra.Var a -> (a -> IO a) -> IO a
1920
modifyVarIO' var upd = do
2021
res <- Extra.modifyVar var $ \v -> do
2122
v' <- upd v
2223
pure $ dupe v'
2324
evaluate res
2425

25-
modifyVar :: Var a -> (a -> IO (a, b)) -> IO b
26+
modifyVar :: Extra.Var a -> (a -> IO (a, b)) -> IO b
2627
modifyVar var upd = do
2728
(new, res) <- Extra.modifyVar var $ \old -> do
2829
(new,res) <- upd old
2930
return (new, (new, res))
3031
void $ evaluate new
3132
return res
3233

33-
modifyVar_ :: Var a -> (a -> IO a) -> IO ()
34+
modifyVar_ :: Extra.Var a -> (a -> IO a) -> IO ()
3435
modifyVar_ var upd = void $ modifyVarIO' var upd

‎ghcide/src/Development/IDE/GHC/Orphans.hs

+11-12
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,6 @@ import Control.DeepSeq
3636
import Data.Aeson
3737
import Data.Hashable
3838
import Data.String (IsString (fromString))
39-
import Data.Text (Text)
4039

4140
-- Orphan instances for types from the GHC API.
4241
instance Show CoreModule where show = prettyPrint
@@ -122,7 +121,7 @@ instance NFData RealSrcSpan where
122121
rnf = rwhnf
123122

124123
srcSpanFileTag, srcSpanStartLineTag, srcSpanStartColTag,
125-
srcSpanEndLineTag, srcSpanEndColTag :: Text
124+
srcSpanEndLineTag, srcSpanEndColTag :: String
126125
srcSpanFileTag = "srcSpanFile"
127126
srcSpanStartLineTag = "srcSpanStartLine"
128127
srcSpanStartColTag = "srcSpanStartCol"
@@ -132,24 +131,24 @@ srcSpanEndColTag = "srcSpanEndCol"
132131
instance ToJSON RealSrcSpan where
133132
toJSON spn =
134133
object
135-
[ srcSpanFileTag .= unpackFS (srcSpanFile spn)
136-
, srcSpanStartLineTag .= srcSpanStartLine spn
137-
, srcSpanStartColTag .= srcSpanStartCol spn
138-
, srcSpanEndLineTag .= srcSpanEndLine spn
139-
, srcSpanEndColTag .= srcSpanEndCol spn
134+
[ fromString srcSpanFileTag .= unpackFS (srcSpanFile spn)
135+
, fromString srcSpanStartLineTag .= srcSpanStartLine spn
136+
, fromString srcSpanStartColTag .= srcSpanStartCol spn
137+
, fromString srcSpanEndLineTag .= srcSpanEndLine spn
138+
, fromString srcSpanEndColTag .= srcSpanEndCol spn
140139
]
141140

142141
instance FromJSON RealSrcSpan where
143142
parseJSON = withObject "object" $ \obj -> do
144-
file <- fromString <$> (obj .: srcSpanFileTag)
143+
file <- fromString <$> (obj .: fromString srcSpanFileTag)
145144
mkRealSrcSpan
146145
<$> (mkRealSrcLoc file
147-
<$> obj .: srcSpanStartLineTag
148-
<*> obj .: srcSpanStartColTag
146+
<$> obj .: fromString srcSpanStartLineTag
147+
<*> obj .: fromString srcSpanStartColTag
149148
)
150149
<*> (mkRealSrcLoc file
151-
<$> obj .: srcSpanEndLineTag
152-
<*> obj .: srcSpanEndColTag
150+
<$> obj .: fromString srcSpanEndLineTag
151+
<*> obj .: fromString srcSpanEndColTag
153152
)
154153

155154
instance NFData Type where

‎haskell-language-server.cabal

+3-2
Original file line numberDiff line numberDiff line change
@@ -283,7 +283,7 @@ common qualifyImportedNames
283283
-- formatters
284284

285285
common floskell
286-
if flag(floskell) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))
286+
if flag(floskell) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))
287287
build-depends: hls-floskell-plugin ^>=1.0.0.0
288288
cpp-options: -Dfloskell
289289

@@ -433,6 +433,7 @@ test-suite func-test
433433
, data-default
434434
, hspec-expectations
435435
, lens
436+
, lens-aeson
436437
, ghcide
437438
, hls-test-utils ^>= 1.1.0.0
438439
, lsp-types
@@ -472,7 +473,7 @@ test-suite func-test
472473
if flag(eval)
473474
cpp-options: -Deval
474475
-- formatters
475-
if flag(floskell) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))
476+
if flag(floskell) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))
476477
cpp-options: -Dfloskell
477478
if flag(fourmolu) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))
478479
cpp-options: -Dfourmolu

‎hls-plugin-api/hls-plugin-api.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@ library
4949
, hls-graph >=1.4 && < 1.6
5050
, hslogger
5151
, lens
52+
, lens-aeson
5253
, lsp ^>=1.4.0.0
5354
, opentelemetry
5455
, optparse-applicative

‎hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs

+19-20
Original file line numberDiff line numberDiff line change
@@ -5,13 +5,16 @@
55

66
module Ide.Plugin.ConfigUtils where
77

8+
import Control.Lens (at, ix, (&), (?~))
89
import qualified Data.Aeson as A
10+
import Data.Aeson.Lens (_Object)
911
import qualified Data.Aeson.Types as A
1012
import Data.Default (def)
1113
import qualified Data.Dependent.Map as DMap
1214
import qualified Data.Dependent.Sum as DSum
13-
import qualified Data.HashMap.Lazy as HMap
1415
import Data.List (nub)
16+
import Data.String (IsString (fromString))
17+
import qualified Data.Text as T
1518
import Ide.Plugin.Config
1619
import Ide.Plugin.Properties (toDefaultJSON, toVSCodeExtensionSchema)
1720
import Ide.Types
@@ -25,17 +28,12 @@ import Language.LSP.Types
2528
-- | Generates a default 'Config', but remains only effective items
2629
pluginsToDefaultConfig :: IdePlugins a -> A.Value
2730
pluginsToDefaultConfig IdePlugins {..} =
28-
A.Object $
29-
HMap.adjust
30-
( \(unsafeValueToObject -> o) ->
31-
A.Object $ HMap.insert "plugin" elems o -- inplace the "plugin" section with our 'elems', leaving others unchanged
32-
)
33-
"haskell"
34-
(unsafeValueToObject (A.toJSON defaultConfig))
31+
-- Use 'ix' to look at all the "haskell" keys in the outer value (since we're not
32+
-- setting it if missing), then we use '_Object' and 'at' to get at the "plugin" key
33+
-- and actually set it.
34+
A.toJSON defaultConfig & ix "haskell" . _Object . at "plugin" ?~ elems
3535
where
3636
defaultConfig@Config {} = def
37-
unsafeValueToObject (A.Object o) = o
38-
unsafeValueToObject _ = error "impossible"
3937
elems = A.object $ mconcat $ singlePlugin <$> map snd ipMap
4038
-- Splice genericDefaultConfig and dedicatedDefaultConfig
4139
-- Example:
@@ -52,7 +50,7 @@ pluginsToDefaultConfig IdePlugins {..} =
5250
-- }
5351
singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} =
5452
let x = genericDefaultConfig <> dedicatedDefaultConfig
55-
in [pId A..= A.object x | not $ null x]
53+
in [fromString (T.unpack pId) A..= A.object x | not $ null x]
5654
where
5755
(PluginHandlers (DMap.toList -> handlers)) = pluginHandlers
5856
customConfigToDedicatedDefaultConfig (CustomConfig p) = toDefaultJSON p
@@ -107,22 +105,22 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug
107105
(PluginId pId) = pluginId
108106
genericSchema =
109107
let x =
110-
[withIdPrefix "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics]
108+
[toKey' "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics]
111109
<> nub (mconcat (handlersToGenericSchema <$> handlers))
112110
in case x of
113111
-- If the plugin has only one capability, we produce globalOn instead of the specific one;
114112
-- otherwise we don't produce globalOn at all
115-
[_] -> [withIdPrefix "globalOn" A..= schemaEntry "plugin"]
113+
[_] -> [toKey' "globalOn" A..= schemaEntry "plugin"]
116114
_ -> x
117115
dedicatedSchema = customConfigToDedicatedSchema configCustomConfig
118116
handlersToGenericSchema (IdeMethod m DSum.:=> _) = case m of
119-
STextDocumentCodeAction -> [withIdPrefix "codeActionsOn" A..= schemaEntry "code actions"]
120-
STextDocumentCodeLens -> [withIdPrefix "codeLensOn" A..= schemaEntry "code lenses"]
121-
STextDocumentRename -> [withIdPrefix "renameOn" A..= schemaEntry "rename"]
122-
STextDocumentHover -> [withIdPrefix "hoverOn" A..= schemaEntry "hover"]
123-
STextDocumentDocumentSymbol -> [withIdPrefix "symbolsOn" A..= schemaEntry "symbols"]
124-
STextDocumentCompletion -> [withIdPrefix "completionOn" A..= schemaEntry "completions"]
125-
STextDocumentPrepareCallHierarchy -> [withIdPrefix "callHierarchyOn" A..= schemaEntry "call hierarchy"]
117+
STextDocumentCodeAction -> [toKey' "codeActionsOn" A..= schemaEntry "code actions"]
118+
STextDocumentCodeLens -> [toKey' "codeLensOn" A..= schemaEntry "code lenses"]
119+
STextDocumentRename -> [toKey' "renameOn" A..= schemaEntry "rename"]
120+
STextDocumentHover -> [toKey' "hoverOn" A..= schemaEntry "hover"]
121+
STextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols"]
122+
STextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions"]
123+
STextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy"]
126124
_ -> []
127125
schemaEntry desc =
128126
A.object
@@ -132,3 +130,4 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug
132130
"description" A..= A.String ("Enables " <> pId <> " " <> desc)
133131
]
134132
withIdPrefix x = "haskell.plugin." <> pId <> "." <> x
133+
toKey' = fromString . T.unpack . withIdPrefix

‎hls-plugin-api/src/Ide/Plugin/Properties.hs

+14-13
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@
1111
{-# LANGUAGE TypeFamilies #-}
1212
{-# LANGUAGE TypeOperators #-}
1313
{-# LANGUAGE UndecidableInstances #-}
14-
{-# LANGUAGE ViewPatterns #-}
1514
-- See Note [Constraints]
1615
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
1716

@@ -47,6 +46,7 @@ import Data.Function ((&))
4746
import Data.Kind (Constraint, Type)
4847
import qualified Data.Map.Strict as Map
4948
import Data.Proxy (Proxy (..))
49+
import Data.String (IsString (fromString))
5050
import qualified Data.Text as T
5151
import GHC.OverloadedLabels (IsLabel (..))
5252
import GHC.TypeLits
@@ -162,6 +162,7 @@ type HasProperty s k t r = (k ~ 'PropertyKey s t, Elem s r, FindByKeyName s r ~
162162
-- "Description of exampleNumber"
163163
-- 233
164164
-- @
165+
165166
emptyProperties :: Properties '[]
166167
emptyProperties = Properties Map.empty
167168

@@ -235,7 +236,7 @@ parseProperty kn k x = case k of
235236
(SEnum _, EnumMetaData {..}) ->
236237
A.parseEither
237238
( \o -> do
238-
txt <- o A..: keyName
239+
txt <- o A..: key
239240
if txt `elem` enumValues
240241
then pure txt
241242
else
@@ -247,9 +248,9 @@ parseProperty kn k x = case k of
247248
)
248249
x
249250
where
250-
keyName = T.pack $ symbolVal kn
251+
key = fromString $ symbolVal kn
251252
parseEither :: forall a. A.FromJSON a => Either String a
252-
parseEither = A.parseEither (A..: keyName) x
253+
parseEither = A.parseEither (A..: key) x
253254

254255
-- ---------------------------------------------------------------------
255256

@@ -352,26 +353,26 @@ toDefaultJSON :: Properties r -> [A.Pair]
352353
toDefaultJSON (Properties p) = [toEntry s v | (s, v) <- Map.toList p]
353354
where
354355
toEntry :: String -> SomePropertyKeyWithMetaData -> A.Pair
355-
toEntry (T.pack -> s) = \case
356+
toEntry s = \case
356357
(SomePropertyKeyWithMetaData SNumber MetaData {..}) ->
357-
s A..= defaultValue
358+
fromString s A..= defaultValue
358359
(SomePropertyKeyWithMetaData SInteger MetaData {..}) ->
359-
s A..= defaultValue
360+
fromString s A..= defaultValue
360361
(SomePropertyKeyWithMetaData SString MetaData {..}) ->
361-
s A..= defaultValue
362+
fromString s A..= defaultValue
362363
(SomePropertyKeyWithMetaData SBoolean MetaData {..}) ->
363-
s A..= defaultValue
364+
fromString s A..= defaultValue
364365
(SomePropertyKeyWithMetaData (SObject _) MetaData {..}) ->
365-
s A..= defaultValue
366+
fromString s A..= defaultValue
366367
(SomePropertyKeyWithMetaData (SArray _) MetaData {..}) ->
367-
s A..= defaultValue
368+
fromString s A..= defaultValue
368369
(SomePropertyKeyWithMetaData (SEnum _) EnumMetaData {..}) ->
369-
s A..= defaultValue
370+
fromString s A..= defaultValue
370371

371372
-- | Converts a properties definition into kv pairs as vscode schema
372373
toVSCodeExtensionSchema :: T.Text -> Properties r -> [A.Pair]
373374
toVSCodeExtensionSchema prefix (Properties p) =
374-
[(prefix <> T.pack k) A..= toEntry v | (k, v) <- Map.toList p]
375+
[fromString (T.unpack prefix <> k) A..= toEntry v | (k, v) <- Map.toList p]
375376
where
376377
toEntry :: SomePropertyKeyWithMetaData -> A.Value
377378
toEntry = \case

‎hls-plugin-api/src/Ide/Types.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -24,11 +24,11 @@ module Ide.Types
2424
#ifdef mingw32_HOST_OS
2525
import qualified System.Win32.Process as P (getCurrentProcessId)
2626
#else
27+
import Control.Monad (void)
2728
import qualified System.Posix.Process as P (getProcessID)
2829
import System.Posix.Signals
2930
#endif
3031
import Control.Lens ((^.))
31-
import Control.Monad
3232
import Data.Aeson hiding (defaultOptions)
3333
import qualified Data.DList as DList
3434
import qualified Data.Default

‎plugins/hls-brittany-plugin/hls-brittany-plugin.cabal

-1
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ library
2323
, base >=4.12 && <5
2424
, brittany >=0.13.1.0
2525
, filepath
26-
, ghc
2726
, ghc-boot-th
2827
, ghcide >=1.2 && <1.6
2928
, hls-plugin-api >=1.1 && <1.3

0 commit comments

Comments
 (0)