@@ -13,6 +13,7 @@ import qualified Data.Text as T
13
13
import Data.Default
14
14
import GHC ( TypecheckedModule )
15
15
import GHC.Generics
16
+ import Haskell.Ide.Engine.Ghc
16
17
import Haskell.Ide.Engine.MonadTypes
17
18
import Haskell.Ide.Engine.PluginUtils
18
19
import Haskell.Ide.Engine.Scheduler
@@ -33,7 +34,6 @@ import System.IO
33
34
import Haskell.Ide.Engine.Plugin.ApplyRefact
34
35
import Haskell.Ide.Engine.Plugin.Example2
35
36
-- import Haskell.Ide.Engine.Plugin.HaRe
36
- import Haskell.Ide.Engine.Plugin.Bios
37
37
import Haskell.Ide.Engine.Plugin.Generic
38
38
39
39
{-# ANN module ("HLint: ignore Redundant do" :: String) #-}
@@ -64,7 +64,6 @@ plugins :: IdePlugins
64
64
plugins = pluginDescToIdePlugins
65
65
[applyRefactDescriptor " applyrefact"
66
66
,example2Descriptor " eg2"
67
- ,biosDescriptor " bios"
68
67
]
69
68
70
69
startServer :: IO (Scheduler IO , TChan LogVal , ThreadId )
@@ -90,17 +89,17 @@ logToChan c t = atomically $ writeTChan c t
90
89
91
90
-- ---------------------------------------------------------------------
92
91
93
- dispatchGhcRequest :: ToJSON a
92
+ dispatchGhcRequest :: ( Typeable a , ToJSON a )
94
93
=> TrackingNumber -> Maybe Uri -> String -> Int
95
94
-> Scheduler IO -> TChan LogVal
96
- -> PluginId -> CommandName -> a -> IO ()
97
- dispatchGhcRequest tn uri ctx n scheduler lc plugin com arg = do
95
+ -> IdeGhcM ( IdeResult a ) -> IO ()
96
+ dispatchGhcRequest tn uri ctx n scheduler lc f = do
98
97
let
99
98
logger :: RequestCallback IO DynamicJSON
100
99
logger x = logToChan lc (ctx, Right x)
101
100
102
101
let req = GReq tn " plugin-command" uri Nothing (Just (IdInt n)) logger (toDynJSON (Nothing :: Maybe () )) $
103
- runPluginCommand plugin com (toJSON arg)
102
+ fmap toDynJSON <$> f
104
103
sendRequest scheduler req
105
104
106
105
@@ -163,7 +162,7 @@ funcSpec = describe "functional dispatch" $ do
163
162
show rrr `shouldBe` " Nothing"
164
163
165
164
-- need to typecheck the module to trigger deferred response
166
- dispatchGhcRequest 2 (Just testUri) " req2" 2 scheduler logChan " bios " " check " (toJSON testUri)
165
+ dispatchGhcRequest 2 (Just testUri) " req2" 2 scheduler logChan $ setTypecheckedModule testUri
167
166
168
167
-- And now we get the deferred response (once the module is loaded)
169
168
(" req1" ,Right res) <- atomically $ readTChan logChan
@@ -245,7 +244,7 @@ funcSpec = describe "functional dispatch" $ do
245
244
246
245
it " returns hints as diagnostics" $ do
247
246
248
- dispatchGhcRequest 5 (Just testUri) " r5" 5 scheduler logChan " applyrefact " " lint" testUri
247
+ dispatchGhcRequest 5 (Just testUri) " r5" 5 scheduler logChan $ lint testUri
249
248
250
249
hr5 <- atomically $ readTChan logChan
251
250
unpackRes hr5 `shouldBe` (" r5" ,
@@ -275,7 +274,7 @@ funcSpec = describe "functional dispatch" $ do
275
274
-- (Just $ H.singleton r6uri textEdits)
276
275
-- Nothing
277
276
-- ))
278
- dispatchGhcRequest 6 (Just testUri) " r6" 6 scheduler logChan " bios " " check " (toJSON testUri)
277
+ dispatchGhcRequest 6 (Just testUri) " r6" 6 scheduler logChan $ setTypecheckedModule testUri
279
278
hr6 <- atomically $ readTChan logChan
280
279
unpackRes hr6 `shouldBe` (" r6" ,Nothing :: Maybe Int )
281
280
@@ -285,7 +284,7 @@ funcSpec = describe "functional dispatch" $ do
285
284
286
285
dispatchIdeRequest 7 " req7" scheduler logChan (IdInt 7 ) $ findDef testFailUri (Position 1 2 )
287
286
288
- dispatchGhcRequest 8 (Just testUri) " req8" 8 scheduler logChan " bios " " check " (toJSON testFailUri)
287
+ dispatchGhcRequest 8 (Just testUri) " req8" 8 scheduler logChan $ setTypecheckedModule testFailUri
289
288
290
289
hr7 <- atomically $ readTChan logChan
291
290
unpackRes hr7 `shouldBe` (" req7" , Just ([] :: [Location ]))
0 commit comments