Skip to content

Commit dfe6e37

Browse files
jneirajneira
committed
Use compat module
1 parent 08c5d94 commit dfe6e37

File tree

6 files changed

+56
-52
lines changed

6 files changed

+56
-52
lines changed

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

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,34 +1,32 @@
11
module Control.Concurrent.Strict
22
(modifyVar', modifyVarIO'
33
,modifyVar, modifyVar_
4-
,module Control.Concurrent.Extra
54
) where
65

7-
import Control.Concurrent.Extra hiding (modifyVar, modifyVar_)
86
import qualified Control.Concurrent.Extra as Extra
97
import Control.Exception (evaluate)
108
import Control.Monad (void)
119
import Data.Tuple.Extra (dupe)
1210

1311
-- | Strict modification that returns the new value
14-
modifyVar' :: Var a -> (a -> a) -> IO a
12+
modifyVar' :: Extra.Var a -> (a -> a) -> IO a
1513
modifyVar' var upd = modifyVarIO' var (pure . upd)
1614

1715
-- | Strict modification that returns the new value
18-
modifyVarIO' :: Var a -> (a -> IO a) -> IO a
16+
modifyVarIO' :: Extra.Var a -> (a -> IO a) -> IO a
1917
modifyVarIO' var upd = do
2018
res <- Extra.modifyVar var $ \v -> do
2119
v' <- upd v
2220
pure $ dupe v'
2321
evaluate res
2422

25-
modifyVar :: Var a -> (a -> IO (a, b)) -> IO b
23+
modifyVar :: Extra.Var a -> (a -> IO (a, b)) -> IO b
2624
modifyVar var upd = do
2725
(new, res) <- Extra.modifyVar var $ \old -> do
2826
(new,res) <- upd old
2927
return (new, (new, res))
3028
void $ evaluate new
3129
return res
3230

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

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

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import Retrie.ExactPrint (Annotated)
3131

3232
import Development.IDE.GHC.Compat
3333
import Development.IDE.GHC.Util
34+
import Ide.Compat (toJsonKey)
3435

3536
import Control.DeepSeq
3637
import Data.Aeson
@@ -132,11 +133,11 @@ srcSpanEndColTag = "srcSpanEndCol"
132133
instance ToJSON RealSrcSpan where
133134
toJSON spn =
134135
object
135-
[ srcSpanFileTag .= unpackFS (srcSpanFile spn)
136-
, srcSpanStartLineTag .= srcSpanStartLine spn
137-
, srcSpanStartColTag .= srcSpanStartCol spn
138-
, srcSpanEndLineTag .= srcSpanEndLine spn
139-
, srcSpanEndColTag .= srcSpanEndCol spn
136+
[ toJsonKey srcSpanFileTag .= unpackFS (srcSpanFile spn)
137+
, toJsonKey srcSpanStartLineTag .= srcSpanStartLine spn
138+
, toJsonKey srcSpanStartColTag .= srcSpanStartCol spn
139+
, toJsonKey srcSpanEndLineTag .= srcSpanEndLine spn
140+
, toJsonKey srcSpanEndColTag .= srcSpanEndCol spn
140141
]
141142

142143
instance FromJSON RealSrcSpan where

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ source-repository head
2626

2727
library
2828
exposed-modules:
29+
Ide.Compat
2930
Ide.Logger
3031
Ide.Plugin.Config
3132
Ide.Plugin.ConfigUtils

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

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
{-# LANGUAGE CPP #-}
2+
module Ide.Compat where
3+
4+
#if MIN_VERSION_aeson(2,0,0)
5+
import Data.Aeson.Key as A (Key)
6+
import qualified Data.Aeson.Key as A.Key
7+
import qualified Data.Aeson.KeyMap as Map
8+
#else
9+
import qualified Data.HashMap.Lazy as Map
10+
#endif
11+
import Data.Text as T
12+
13+
#if MIN_VERSION_aeson(2,0,0)
14+
toJsonKey :: T.Text -> A.Key
15+
toJsonKey = A.Key.fromText
16+
#else
17+
toJsonKey :: T.Text -> T.Text
18+
toJsonKey = id
19+
#endif
20+
21+
#if MIN_VERSION_aeson(2,0,0)
22+
toJsonKey :: T.Text -> A.Key
23+
toJsonKey = A.Key.fromText
24+
#else
25+
toJsonKey :: T.Text -> T.Text
26+
toJsonKey = id
27+
#endif

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

Lines changed: 13 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE GADTs #-}
32
{-# LANGUAGE OverloadedStrings #-}
43
{-# LANGUAGE RecordWildCards #-}
@@ -11,29 +10,17 @@ import qualified Data.Aeson.Types as A
1110
import Data.Default (def)
1211
import qualified Data.Dependent.Map as DMap
1312
import qualified Data.Dependent.Sum as DSum
14-
#if MIN_VERSION_aeson(2,0,0)
15-
import qualified Data.Aeson.Key as A.Key
16-
import qualified Data.Aeson.KeyMap as Map
17-
#else
18-
import qualified Data.HashMap.Lazy as Map
19-
#endif
2013
import Data.Functor.Identity
14+
import qualified Data.HashMap.Lazy as Map
2115
import Data.List (nub)
2216
import Data.Maybe (fromJust)
2317
import Data.Text (Text)
18+
import Ide.Compat (toKey)
2419
import Ide.Plugin.Config
2520
import Ide.Plugin.Properties (toDefaultJSON, toVSCodeExtensionSchema)
2621
import Ide.Types
2722
import Language.LSP.Types
2823

29-
#if MIN_VERSION_aeson(2,0,0)
30-
toKey :: Text -> A.Key
31-
toKey = A.Key.fromText
32-
#else
33-
toKey :: Text -> Text
34-
toKey = id
35-
#endif
36-
3724
-- Attention:
3825
-- 'diagnosticsOn' will never be added into the default config or the schema,
3926
-- since diagnostics emit in arbitrary shake rules -- we don't know
@@ -124,22 +111,22 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug
124111
(PluginId pId) = pluginId
125112
genericSchema =
126113
let x =
127-
[withIdPrefix "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics]
114+
[toKey' "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics]
128115
<> nub (mconcat (handlersToGenericSchema <$> handlers))
129116
in case x of
130117
-- If the plugin has only one capability, we produce globalOn instead of the specific one;
131118
-- otherwise we don't produce globalOn at all
132-
[_] -> [withIdPrefix "globalOn" A..= schemaEntry "plugin"]
119+
[_] -> [toKey' "globalOn" A..= schemaEntry "plugin"]
133120
_ -> x
134121
dedicatedSchema = customConfigToDedicatedSchema configCustomConfig
135122
handlersToGenericSchema (IdeMethod m DSum.:=> _) = case m of
136-
STextDocumentCodeAction -> [withIdPrefix "codeActionsOn" A..= schemaEntry "code actions"]
137-
STextDocumentCodeLens -> [withIdPrefix "codeLensOn" A..= schemaEntry "code lenses"]
138-
STextDocumentRename -> [withIdPrefix "renameOn" A..= schemaEntry "rename"]
139-
STextDocumentHover -> [withIdPrefix "hoverOn" A..= schemaEntry "hover"]
140-
STextDocumentDocumentSymbol -> [withIdPrefix "symbolsOn" A..= schemaEntry "symbols"]
141-
STextDocumentCompletion -> [withIdPrefix "completionOn" A..= schemaEntry "completions"]
142-
STextDocumentPrepareCallHierarchy -> [withIdPrefix "callHierarchyOn" A..= schemaEntry "call hierarchy"]
123+
STextDocumentCodeAction -> [toKey' "codeActionsOn" A..= schemaEntry "code actions"]
124+
STextDocumentCodeLens -> [toKey' "codeLensOn" A..= schemaEntry "code lenses"]
125+
STextDocumentRename -> [toKey' "renameOn" A..= schemaEntry "rename"]
126+
STextDocumentHover -> [toKey' "hoverOn" A..= schemaEntry "hover"]
127+
STextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols"]
128+
STextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions"]
129+
STextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy"]
143130
_ -> []
144131
schemaEntry desc =
145132
A.object
@@ -148,4 +135,5 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug
148135
"default" A..= True,
149136
"description" A..= A.String ("Enables " <> pId <> " " <> desc)
150137
]
151-
withIdPrefix x = toKey $ "haskell.plugin." <> pId <> "." <> x
138+
withIdPrefix x = "haskell.plugin." <> pId <> "." <> x
139+
toKey' = toJsonKey . withIdPrefix

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

Lines changed: 5 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE ConstraintKinds #-}
32
{-# LANGUAGE DataKinds #-}
43
{-# LANGUAGE FlexibleContexts #-}
@@ -42,9 +41,6 @@ module Ide.Plugin.Properties
4241
where
4342

4443
import qualified Data.Aeson as A
45-
#if MIN_VERSION_aeson(2,0,0)
46-
import qualified Data.Aeson.Key as A.Key
47-
#endif
4844
import qualified Data.Aeson.Types as A
4945
import Data.Either (fromRight)
5046
import Data.Function ((&))
@@ -54,6 +50,7 @@ import Data.Proxy (Proxy (..))
5450
import qualified Data.Text as T
5551
import GHC.OverloadedLabels (IsLabel (..))
5652
import GHC.TypeLits
53+
import Ide.Types (toJsonKey)
5754
import Unsafe.Coerce (unsafeCoerce)
5855

5956
-- | Types properties may have
@@ -167,14 +164,6 @@ type HasProperty s k t r = (k ~ 'PropertyKey s t, Elem s r, FindByKeyName s r ~
167164
-- 233
168165
-- @
169166

170-
#if MIN_VERSION_aeson(2,0,0)
171-
toKey :: String -> A.Key
172-
toKey = A.Key.fromString
173-
#else
174-
toKey :: String -> T.Text
175-
toKey = T.pack
176-
#endif
177-
178167
emptyProperties :: Properties '[]
179168
emptyProperties = Properties Map.empty
180169

@@ -248,7 +237,7 @@ parseProperty kn k x = case k of
248237
(SEnum _, EnumMetaData {..}) ->
249238
A.parseEither
250239
( \o -> do
251-
txt <- o A..: keyName
240+
txt <- o A..: key
252241
if txt `elem` enumValues
253242
then pure txt
254243
else
@@ -260,7 +249,7 @@ parseProperty kn k x = case k of
260249
)
261250
x
262251
where
263-
keyName = toKey $ symbolVal kn
252+
key = toJsonKey . pack $ symbolVal kn
264253
parseEither :: forall a. A.FromJSON a => Either String a
265254
parseEither = A.parseEither (A..: keyName) x
266255

@@ -365,7 +354,7 @@ toDefaultJSON :: Properties r -> [A.Pair]
365354
toDefaultJSON (Properties p) = [toEntry s v | (s, v) <- Map.toList p]
366355
where
367356
toEntry :: String -> SomePropertyKeyWithMetaData -> A.Pair
368-
toEntry (toKey -> s) = \case
357+
toEntry (toJsonKey . pack -> s) = \case
369358
(SomePropertyKeyWithMetaData SNumber MetaData {..}) ->
370359
s A..= defaultValue
371360
(SomePropertyKeyWithMetaData SInteger MetaData {..}) ->
@@ -384,7 +373,7 @@ toDefaultJSON (Properties p) = [toEntry s v | (s, v) <- Map.toList p]
384373
-- | Converts a properties definition into kv pairs as vscode schema
385374
toVSCodeExtensionSchema :: T.Text -> Properties r -> [A.Pair]
386375
toVSCodeExtensionSchema prefix (Properties p) =
387-
[(toKey $ T.unpack prefix <> k) A..= toEntry v | (k, v) <- Map.toList p]
376+
[(toJsonKey prefix <> k) A..= toEntry v | (k, v) <- Map.toList p]
388377
where
389378
toEntry :: SomePropertyKeyWithMetaData -> A.Value
390379
toEntry = \case

0 commit comments

Comments
 (0)