Starting to bring in async streaming command

hie-eg-plugin-async/Haskell/Ide/ExamplePluginAsync.hs

@@ -25,6 +25,7 @@ exampleAsyncDescriptor = PluginDescriptor
       [
         buildCommand (longRunningCmdSync Cmd1) "cmd1" "Long running synchronous command" [] [CtxNone] []
       , buildCommand (longRunningCmdSync Cmd2) "cmd2" "Long running synchronous command" [] [CtxNone] []
+      , buildCommand (streamingCmdAsync (CmdA 3 100)) "cmdA3" "Long running async/streaming command" [] [CtxNone] []
       ]
   , pdExposedServices = []
   , pdUsedServices    = []
@@ -35,6 +36,11 @@ exampleAsyncDescriptor = PluginDescriptor
 data WorkerCmd = Cmd1 | Cmd2
                deriving Show
 
+data WorkerCmdAsync = CmdA
+                       Int -- Number of times to repeat
+                       Int -- delay between repeats
+               deriving Show
+
 -- | Keep track of the communication channesl to the remote process.
 data SubProcess = SubProcess
   { spChIn    :: TChan WorkerCmd
@@ -99,3 +105,26 @@ workerProc cin cout = loop 1
           loop (cnt + 1)
 
 -- ---------------------------------------------------------------------
+
+-- | This command manages interaction with a separate process, doing stuff.
+streamingCmdAsync :: WorkerCmdAsync -> CommandFunc T.Text
+streamingCmdAsync cmd = CmdAsync $ \replyFunc _ctx req -> do
+  tid <- liftIO $ forkIO (workerProcAsync cmd replyFunc)
+  debugm $ "streamingCmdAsync:launched worker as " ++ show tid
+  let tidStr = T.pack (show tid ++ ":")
+  liftIO $ replyFunc (IdeResponseOk $ tidStr <> "started from streamingCmdAsync")
+
+-- | This command manages interaction with a separate process, doing stuff.
+workerProcAsync :: WorkerCmdAsync -> (IdeResponse T.Text -> IO ()) -> IO ()
+workerProcAsync (CmdA num delayMs) replyFunc = do
+  tid <- myThreadId
+  let tidStr = show tid ++ ":"
+  replyFunc (IdeResponseOk $ T.pack $ tidStr <> "starting")
+  let
+    go n = do
+      replyFunc (IdeResponseOk $ T.pack $ tidStr <> "iteration " <> show n)
+      threadDelay (delayMs * 1000)
+  mapM_ go [1..num]
+  replyFunc (IdeResponseOk $ T.pack $ tidStr <> "done")
+
+-- ---------------------------------------------------------------------

src/Haskell/Ide/Engine/Dispatcher.hs

@@ -38,6 +38,7 @@ dispatcher cin = do
 -- | Send a response from the plugin to the designated reply channel
 sendResponse :: (ValidResponse a) => ChannelRequest -> IdeResponse a -> IO ()
 sendResponse req resp = do
+  debugm $ "sendResponse (req,resp)=" ++ show (req,fmap jsWrite resp)
   let cr = CResp (cinPlugin req) (cinReqId req) (fmap jsWrite resp)
   liftIO $ atomically $ writeTChan (cinReplyChan req) cr