Adds DebugThreadState (#6)

- Adds a data type to hold the debubgger exeucting thread + output
  event sink

Author: dmjio

dap/exe/Main.hs

@@ -119,7 +119,12 @@ initESTG AttachArgs {..} = do
   let dbgChan = DebuggerChan (dbgCmdO, dbgOutI)
   flip catch handleDebuggerExceptions
     $ registerNewDebugSession __sessionId (ESTG dbgCmdI dbgOutO program)
-    $ liftIO $ loadAndRunProgram True True program [] dbgChan DbgStepByStep False defaultDebugSettings
+      (liftIO $ loadAndRunProgram True True program [] dbgChan DbgStepByStep False defaultDebugSettings)
+      (pure ())
+      -- (forever $ do
+      --     message <- liftIO (Unagi.readChan dbgOutO)
+      --     -- logic goes here for conversion to 'OutputEvent'
+      --     sendOutputEvent defaultOutputEvent)
 ----------------------------------------------------------------------------
 -- | Exception Handler
 handleDebuggerExceptions :: SomeException -> Adaptor ESTG ()

dap/src/DAP/Adaptor.hs

@@ -177,15 +177,20 @@ registerNewDebugSession
   :: SessionId
   -> app
   -> Adaptor app ()
+  -- ^ Action to run debugger (operates in a forked thread that gets killed when disconnect is set)
+  -> Adaptor app ()
   -- ^ Long running operation, meant to be used as a sink for
   -- the debugger to emit events and for the adaptor to forward to the editor
   -- This function should be in a 'forever' loop waiting on the read end of
   -- a debugger channel.
   -> Adaptor app ()
-registerNewDebugSession k v action = do
+registerNewDebugSession k v debuggerExecution outputEventSink = do
   store <- gets appStore
-  tid <- fork (resetAdaptorStatePayload >> action)
-  liftIO . atomically $ modifyTVar' store (H.insert k (tid, v))
+  debuggerThreadState <-
+    DebuggerThreadState
+      <$> fork (debuggerExecution)
+      <*> fork (outputEventSink)
+  liftIO . atomically $ modifyTVar' store (H.insert k (debuggerThreadState, v))
   setDebugSessionId k
   logInfo $ BL8.pack $ "Registered new debug session: " <> unpack k
 ----------------------------------------------------------------------------
@@ -194,7 +199,7 @@ getDebugSession = do
   (_, _, app) <- getDebugSessionWithThreadIdAndSessionId
   pure app
 ----------------------------------------------------------------------------
-getDebugSessionWithThreadIdAndSessionId :: Adaptor app (SessionId, ThreadId, app)
+getDebugSessionWithThreadIdAndSessionId :: Adaptor app (SessionId, DebuggerThreadState, app)
 getDebugSessionWithThreadIdAndSessionId = do
   sessionId <- getDebugSessionId
   appStore <- liftIO . readTVarIO =<< getAppStore
@@ -217,10 +222,11 @@ getDebugSessionWithThreadIdAndSessionId = do
 ----------------------------------------------------------------------------
 destroyDebugSession :: Adaptor app ()
 destroyDebugSession = do
-  (sessionId, tid, app) <- getDebugSessionWithThreadIdAndSessionId
+  (sessionId, DebuggerThreadState {..}, app) <- getDebugSessionWithThreadIdAndSessionId
   store <- getAppStore
   liftIO $ do
-    killThread tid
+    killThread debuggerThread
+    killThread debuggerOutputEventThread
     atomically $ modifyTVar' store (H.delete sessionId)
   logInfo $ BL8.pack $ "SessionId " <> unpack sessionId <> " ended"
 ----------------------------------------------------------------------------

dap/src/DAP/Types.hs

@@ -207,6 +207,8 @@ module DAP.Types
   -- * Loaded Sources Path
   , SourcePath
   , SourceId
+  -- * Debug Thread state
+  , DebuggerThreadState (..)
   ) where
 ----------------------------------------------------------------------------
 import           Data.Word                       ( Word32 )
@@ -336,7 +338,18 @@ type SourceId = Int
 -- The 'ThreadId' is meant to be an asynchronous operation that
 -- allows initalized debuggers to emit custom events
 -- when they receive messages from the debugger
-type AppStore app = TVar (H.HashMap SessionId (ThreadId, app))
+type AppStore app = TVar (H.HashMap SessionId (DebuggerThreadState, app))
+
+-- | 'DebuggerThreadState'
+-- State to hold both the thread that executes the debugger and the thread used
+-- to propagate output events from the debugger + debuggee to the editor (via the
+-- DAP server).
+data DebuggerThreadState
+  = DebuggerThreadState
+  { debuggerThread :: ThreadId
+  , debuggerOutputEventThread :: ThreadId
+  }
+
 ----------------------------------------------------------------------------
 data ServerConfig
   = ServerConfig