Skip to content

Commit 7eeda96

Browse files
pepeiborrapepeiborra
committed
Fix tests
1 parent 549aacc commit 7eeda96

File tree

7 files changed

+22
-22
lines changed

7 files changed

+22
-22
lines changed

‎ghcide/src/Development/IDE/Main.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,7 @@ import Ide.Types (IdeCommand (IdeComman
122122
IdePlugins,
123123
PluginDescriptor (PluginDescriptor, pluginCli),
124124
PluginId (PluginId),
125-
ipMap)
125+
ipMap, pluginId)
126126
import qualified Language.LSP.Server as LSP
127127
import qualified "list-t" ListT
128128
import Numeric.Natural (Natural)
@@ -224,7 +224,7 @@ commandP plugins =
224224

225225
pluginCommands = mconcat
226226
[ command (T.unpack pId) (Custom <$> p)
227-
| (PluginId pId, PluginDescriptor{pluginCli = Just p}) <- ipMap plugins
227+
| PluginDescriptor{pluginCli = Just p, pluginId = PluginId pId} <- ipMap plugins
228228
]
229229

230230

‎ghcide/src/Development/IDE/Plugin/HLS.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,6 @@ import Control.Exception (SomeException)
1313
import Control.Lens ((^.))
1414
import Control.Monad
1515
import qualified Data.Aeson as J
16-
import Data.Bifunctor
1716
import Data.Dependent.Map (DMap)
1817
import qualified Data.Dependent.Map as DMap
1918
import Data.Dependent.Sum
@@ -96,7 +95,7 @@ asGhcIdePlugin recorder (IdePlugins ls) =
9695

9796
mkPlugin :: ([(PluginId, b)] -> Plugin Config) -> (PluginDescriptor IdeState -> b) -> Plugin Config
9897
mkPlugin maker selector =
99-
case map (second selector) ls of
98+
case map (\p -> (pluginId p, selector p)) ls of
10099
-- If there are no plugins that provide a descriptor, use mempty to
101100
-- create the plugin – otherwise we we end up declaring handlers for
102101
-- capabilities that there are no plugins for

‎ghcide/test/exe/Main.hs‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -6750,24 +6750,26 @@ unitTests recorder logger = do
67506750
let expected = "1:2-3:4"
67516751
assertBool (unwords ["expected to find range", expected, "in diagnostic", shown]) $
67526752
expected `isInfixOf` shown
6753-
, testCase "notification handlers run sequentially" $ do
6753+
, testCase "notification handlers run in priority order" $ do
67546754
orderRef <- newIORef []
67556755
let plugins = pluginDescToIdePlugins $
6756-
[ (defaultPluginDescriptor $ fromString $ show i)
6756+
[ (priorityPluginDescriptor i)
67576757
{ pluginNotificationHandlers = mconcat
67586758
[ mkPluginNotificationHandler LSP.STextDocumentDidOpen $ \_ _ _ _ ->
67596759
liftIO $ atomicModifyIORef_ orderRef (i:)
67606760
]
67616761
}
6762-
| i <- [(1::Int)..20]
6762+
| i <- [1..20]
67636763
] ++ Ghcide.descriptors (cmapWithPrio LogGhcIde recorder)
6764+
priorityPluginDescriptor i = (defaultPluginDescriptor $ fromString $ show i){pluginPriority = i}
67646765

67656766
testIde recorder (IDE.testing (cmapWithPrio LogIDEMain recorder) logger){IDE.argsHlsPlugins = plugins} $ do
67666767
_ <- createDoc "A.hs" "haskell" "module A where"
67676768
waitForProgressDone
6768-
actualOrder <- liftIO $ readIORef orderRef
6769+
actualOrder <- liftIO $ reverse <$> readIORef orderRef
67696770

6770-
liftIO $ actualOrder @?= reverse [(1::Int)..20]
6771+
-- Handlers are run in priority descending order
6772+
liftIO $ actualOrder @?= [20, 19 .. 1]
67716773
, ignoreTestBecause "The test fails sometimes showing 10000us" $
67726774
testCase "timestamps have millisecond resolution" $ do
67736775
resolution_us <- findResolution_us 1

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ pluginsToDefaultConfig IdePlugins {..} =
3434
A.toJSON defaultConfig & ix "haskell" . _Object . at "plugin" ?~ elems
3535
where
3636
defaultConfig@Config {} = def
37-
elems = A.object $ mconcat $ singlePlugin <$> map snd ipMap
37+
elems = A.object $ mconcat $ singlePlugin <$> ipMap
3838
-- Splice genericDefaultConfig and dedicatedDefaultConfig
3939
-- Example:
4040
--
@@ -96,7 +96,7 @@ pluginsToDefaultConfig IdePlugins {..} =
9696
-- | Generates json schema used in haskell vscode extension
9797
-- Similar to 'pluginsToDefaultConfig' but simpler, since schema has a flatten structure
9898
pluginsToVSCodeExtensionSchema :: IdePlugins a -> A.Value
99-
pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlugin <$> map snd ipMap
99+
pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlugin <$> ipMap
100100
where
101101
singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} = genericSchema <> dedicatedSchema
102102
where

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

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,6 @@ import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
4242
import Data.Algorithm.Diff
4343
import Data.Algorithm.DiffOutput
4444
import Data.Bifunctor (Bifunctor (first))
45-
import Data.Containers.ListUtils (nubOrdOn)
4645
import qualified Data.HashMap.Strict as H
4746
import Data.String (IsString (fromString))
4847
import qualified Data.Text as T
@@ -159,11 +158,10 @@ clientSupportsDocumentChanges caps =
159158
-- ---------------------------------------------------------------------
160159

161160
pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
162-
pluginDescToIdePlugins plugins =
163-
IdePlugins $ map (\p -> (pluginId p, p)) $ nubOrdOn pluginId plugins
161+
pluginDescToIdePlugins = IdePlugins
164162

165163
idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
166-
idePluginsToPluginDesc (IdePlugins pp) = map snd pp
164+
idePluginsToPluginDesc (IdePlugins pp) = pp
167165

168166
-- ---------------------------------------------------------------------
169167
-- | Returns the current client configuration. It is not wise to permanently
@@ -233,7 +231,7 @@ allLspCmdIds' pid (IdePlugins ls) = mkPlugin (allLspCmdIds pid) (Just . pluginCo
233231

234232

235233
mkPlugin maker selector
236-
= maker $ concatMap (\(pid, p) -> justs (pid, selector p)) ls
234+
= maker $ concatMap (\p -> justs (pluginId p, selector p)) ls
237235

238236

239237
allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text]

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

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ import Control.Monad (void)
5555
import qualified System.Posix.Process as P (getProcessID)
5656
import System.Posix.Signals
5757
#endif
58+
import Control.Arrow ((&&&))
5859
import Control.Lens ((^.))
5960
import Data.Aeson hiding (defaultOptions)
6061
import qualified Data.Default
@@ -112,10 +113,10 @@ newtype IdePlugins ideState = IdePlugins_ { ipMap_ :: HashMap PluginId (PluginDe
112113
deriving newtype (Semigroup, Monoid)
113114

114115
-- | Smart constructor that deduplicates plugins
115-
pattern IdePlugins :: [(PluginId, PluginDescriptor ideState)] -> IdePlugins ideState
116-
pattern IdePlugins{ipMap} <- IdePlugins_ (sortOn (Down . pluginPriority . snd) . HashMap.toList -> ipMap)
116+
pattern IdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
117+
pattern IdePlugins{ipMap} <- IdePlugins_ (sortOn (Down . pluginPriority) . HashMap.elems -> ipMap)
117118
where
118-
IdePlugins ipMap = IdePlugins_{ipMap_ = HashMap.fromList ipMap}
119+
IdePlugins ipMap = IdePlugins_{ipMap_ = HashMap.fromList $ (pluginId &&& id) <$> ipMap}
119120
{-# COMPLETE IdePlugins #-}
120121

121122
-- | Hooks for modifying the 'DynFlags' at different times of the compilation

‎src/Ide/Main.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ import Ide.Arguments
3232
import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig,
3333
pluginsToVSCodeExtensionSchema)
3434
import Ide.Types (IdePlugins, PluginId (PluginId),
35-
ipMap)
35+
ipMap, pluginId)
3636
import Ide.Version
3737
import System.Directory
3838
import qualified System.Directory.Extra as IO
@@ -80,7 +80,7 @@ defaultMain recorder args idePlugins = do
8080

8181
ListPluginsMode -> do
8282
let pluginNames = sort
83-
$ map ((\(PluginId t) -> T.unpack t) . fst)
83+
$ map ((\(PluginId t) -> T.unpack t) . pluginId)
8484
$ ipMap idePlugins
8585
mapM_ putStrLn pluginNames
8686

@@ -118,7 +118,7 @@ runLspMode recorder ghcideArgs@GhcideArguments{..} idePlugins = withTelemetryLog
118118
log Info $ LogDirectory dir
119119

120120
when (isLSP argsCommand) $ do
121-
log Info $ LogLspStart ghcideArgs (map fst $ ipMap idePlugins)
121+
log Info $ LogLspStart ghcideArgs (map pluginId $ ipMap idePlugins)
122122

123123
-- exists so old-style logging works. intended to be phased out
124124
let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack $ LogOther m)

0 commit comments

Comments
 (0)