dap 0.4.0.0 → 0.5.0.0

raw patch · 4 files changed

+41/−24 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• dap.cabal +1/−1
• src/DAP/Adaptor.hs +17/−12
• src/DAP/Server.hs +14/−11

@@ -1,5 +1,14 @@ # Revision history for dap +## 0.5.0.0 -- 2026-04-15++* No longer print "Handling" messages which cause confusion wrt actual errors occurring (#30)+* Make sure sendError sends ErrorResponse when serviceClient throws an error (#27)++## 0.4.0.0 -- 2026-01-14++* Fix the field names of ExceptionInfoResponse (#26)+ ## 0.3.0.0 -- 2025-10-03  ### Main library changes

@@ -1,5 +1,5 @@ name:               dap-version:            0.4.0.0+version:            0.5.0.0 description:        A library for the Debug Adaptor Protocol (DAP) synopsis:           A debug adaptor protocol library bug-reports:        https://github.com/haskell-debugger/dap/issues

@@ -55,8 +55,8 @@   , sendRaw   -- * Internal function used to execute actions on behalf of the DAP server   -- from child threads (useful for handling asynchronous debugger events).-  , runAdaptorWith-  , runAdaptor+  , runAdaptorPoly+  , runAdaptorRequest   , withRequest   , getHandle   ) where@@ -178,7 +178,7 @@   let emptyState = AdaptorState MessageTypeEvent []   debuggerThreadState <- liftIO $     DebuggerThreadState-      <$> sequence [fork $ action (runAdaptorWith lcl' emptyState) | action <- debuggerConcurrentActions]+      <$> sequence [fork $ action (runAdaptorPoly lcl' emptyState) | action <- debuggerConcurrentActions]   liftIO . atomically $ modifyTVar' store (H.insert k (debuggerThreadState, v))   logInfo $ T.pack $ "Registered new debug session: " <> unpack k   setDebugSessionId k@@ -463,24 +463,29 @@           logError (T.pack reason)           liftIO $ throwIO (ParseException reason) ------------------------------------------------------------------------------- | Evaluates Adaptor action by using and updating the state in the MVar-runAdaptorWith :: AdaptorLocal app request -> AdaptorState -> Adaptor app request () -> IO ()-runAdaptorWith lcl st (Adaptor action) = do+-- | Run an Adaptor for any parametric 'request' (i.e. this function can be+-- used regardless in a non-Request scenario).+runAdaptorPoly :: AdaptorLocal app request -> AdaptorState -> Adaptor app request a -> IO a+runAdaptorPoly lcl st (Adaptor action) = do   (es,final_st) <- runStateT (runReaderT (runExceptT action) lcl) st   case es of     Left err -> error ("runAdaptorWith, unhandled exception:" <> show err)-    Right () -> case final_st of+    Right x -> case final_st of       AdaptorState _ p ->         if null p-          then return ()+          then return x           else error $ "runAdaptorWith, unexpected payload:" <> show p ------------------------------------------------------------------------------- | Utility for evaluating a monad transformer stack-runAdaptor :: AdaptorLocal app Request -> AdaptorState -> Adaptor app Request () -> IO ()-runAdaptor lcl s (Adaptor client) =+-- | Run an Adaptor in the context of replying to a 'Request' (notably, this+-- should be used to run the Adaptor servicing the client ('serviceClient')).+--+-- When 'sendError' is used to throw an error in the Adaptor, we cancel the+-- current pending request with an 'ErrorResponse'.+runAdaptorRequest :: AdaptorLocal app Request -> AdaptorState -> Adaptor app Request () -> IO ()+runAdaptorRequest lcl s (Adaptor client) =   runStateT (runReaderT (runExceptT client) lcl) s >>= \case     (Left (errorMessage, maybeMessage), s') ->-      runAdaptor lcl s' (sendErrorResponse errorMessage maybeMessage)+      runAdaptorRequest lcl s' (sendErrorResponse errorMessage maybeMessage)     (Right (), _) -> pure () ---------------------------------------------------------------------------- 

@@ -24,7 +24,7 @@   , TerminateServer(..)   ) where -----------------------------------------------------------------------------import           Control.Monad              ( when, forever )+import           Control.Monad              ( when ) import           Control.Concurrent         ( ThreadId, myThreadId, throwTo ) import           Control.Concurrent.MVar    ( newMVar ) import           Control.Concurrent.STM     ( newTVarIO )@@ -46,7 +46,7 @@ import           Network.Socket             ( socketToHandle, withSocketsDo, SockAddr ) import           System.IO                  ( hClose, hSetNewlineMode, Handle, Newline(CRLF)                                             , NewlineMode(NewlineMode, outputNL, inputNL)-                                            , IOMode(ReadWriteMode), stderr, hPrint)+                                            , IOMode(ReadWriteMode) ) import           System.IO.Error            ( isEOFError ) import           System.Exit                ( exitWith, ExitCode(ExitSuccess) ) import           Text.Read                  ( readMaybe )@@ -137,15 +137,19 @@ -- because there's no 'Request' to reply to) serviceClient   :: (Command -> Adaptor app Request ())-  -> (ReverseRequestResponse -> Adaptor app r ())-  -> AdaptorLocal app r+  -> (ReverseRequestResponse -> Adaptor app () ())+  -> AdaptorLocal app ()   -> IO ()-serviceClient communicate ackResp lcl = forever $ runAdaptorWith lcl st $ do-    either_nextRequest <- getRequest-    case either_nextRequest of-      Right nextRequest ->-        withRequest nextRequest (communicate (command nextRequest))-      Left rrr -> ackResp rrr+serviceClient communicate ackResp lcl = do+  rrr_or_nextRequest <- runAdaptorPoly lcl st getRequest+  case rrr_or_nextRequest of+    Right nextRequest -> do+      let lcl' = lcl{ request = nextRequest }+      runAdaptorRequest lcl' st $+        communicate (command nextRequest)+    Left rrr ->+      runAdaptorPoly lcl st $ ackResp rrr+  serviceClient communicate ackResp lcl   where     st = AdaptorState MessageTypeResponse [] ----------------------------------------------------------------------------@@ -172,7 +176,6 @@           = logger logAction ERROR address Nothing             $ withBraces             $ T.pack ("Unknown Exception: " <> show e)-  hPrint stderr ("Handling" <> show e)   when shouldLog $ do     dumpError     logger logAction INFO address (Just SENT) (withBraces "Closing Connection")