Interface.hs

{-# LANGUAGE LambdaCase, RecordWildCards #-}
module Development.Debug.Adapter.Interface where

import qualified Data.Text as T
import Control.Concurrent.MVar
import Control.Monad.IO.Class

import DAP

import GHC.Debugger.Interface.Messages as D
import Development.Debug.Adapter
import Development.Debug.Adapter.Exit
import qualified Development.Debug.Adapter.Output as Output

-- | Synchronously send a command to the debugger and await a response
sendSync :: D.Command -> DebugAdaptor Response
sendSync cmd = do
  DAS{..} <- getDebugSession
  liftIO $ putMVar syncRequests cmd
  liftIO (takeMVar syncResponses) >>= handleAbort

-- | Sends a command to the debugger, then runs the given action, and only after running the action it waits for the result of the debugger
sendInterleaved :: D.Command -> DebugAdaptor () -> DebugAdaptor Response
sendInterleaved cmd action = do
  DAS{..} <- getDebugSession
  liftIO $ putMVar syncRequests cmd
  () <- action
  liftIO (takeMVar syncResponses) >>= handleAbort

handleAbort :: Response -> DebugAdaptor Response
handleAbort (Aborted e) = do
  Output.console (T.pack e)
  exitCleanly (Just e)
handleAbort r = return r