Merge pull request #32 from Saizan/client-caps

keep track of clientCapabilities

Author: alt-romes

src/DAP/Adaptor.hs

@@ -59,6 +59,7 @@ module DAP.Adaptor
   , runAdaptorRequest
   , withRequest
   , getHandle
+  , getClientCapabilities
   ) where
 ----------------------------------------------------------------------------
 import           Control.Concurrent.Lifted  ( fork, killThread )
@@ -230,6 +231,9 @@ getAppStore = asks appStore
 getCommand :: Adaptor app Request Command
 getCommand = command <$> asks request
 ----------------------------------------------------------------------------
+getClientCapabilities :: Adaptor app request (Maybe InitializeRequestArguments)
+getClientCapabilities = asks clientCapabilities
+-------------------------------------------------------------------------------
 -- | 'sendRaw' (internal use only)
 -- Sends a raw JSON payload to the editor. No "seq", "type" or "command" fields are set.
 -- The message is still encoded with the ProtocolMessage Header, byte count, and CRLF.

src/DAP/Server.hs

@@ -37,7 +37,7 @@ import           Control.Exception          ( Exception
                                             , toException
                                             , throwIO )
 import           Control.Monad              ( void )
-import           Data.Aeson                 ( decodeStrict, eitherDecode, Value, FromJSON )
+import           Data.Aeson                 ( decodeStrict, eitherDecode, Value, FromJSON, Result (..), fromJSON )
 import           Data.Aeson.Encode.Pretty   ( encodePretty )
 import           Data.ByteString            ( ByteString )
 import           Data.Char                  ( isDigit )
@@ -124,6 +124,7 @@ initAdaptorState logAction handle address appStore serverConfig = do
   handleLock               <- newMVar ()
   sessionId                <- newIORef Nothing
   let request = ()
+  let clientCapabilities = Nothing
   pure AdaptorLocal
     { ..
     }
@@ -142,16 +143,21 @@ serviceClient
   -> IO ()
 serviceClient communicate ackResp lcl = do
   rrr_or_nextRequest <- runAdaptorPoly lcl st getRequest
-  case rrr_or_nextRequest of
+  lcl' <- case rrr_or_nextRequest of
     Right nextRequest -> do
-      let lcl' = lcl{ request = nextRequest }
+      let lcl' = lcl{ request = nextRequest, clientCapabilities = clientCaps nextRequest }
       runAdaptorRequest lcl' st $
         communicate (command nextRequest)
-    Left rrr ->
+      pure (void lcl')
+    Left rrr -> do
       runAdaptorPoly lcl st $ ackResp rrr
-  serviceClient communicate ackResp lcl
+      pure lcl
+  serviceClient communicate ackResp lcl'
   where
     st = AdaptorState MessageTypeResponse []
+    clientCaps Request{command = CommandInitialize, args = Just (fromJSON -> Success v) }
+      = Just v
+    clientCaps _ = clientCapabilities lcl
 ----------------------------------------------------------------------------
 -- | Handle exceptions from client threads, parse and log accordingly.
 -- Detects if client failed with `TerminateServer` and kills the server accordingly by sending an exception to the main thread.

src/DAP/Types.hs

@@ -14,6 +14,7 @@
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DeriveFunctor              #-}
 {-# LANGUAGE LambdaCase                 #-}
 ----------------------------------------------------------------------------
 module DAP.Types
@@ -299,9 +300,13 @@ data AdaptorLocal app request = AdaptorLocal
   , logAction          :: LogAction IO DAPLog
     -- ^ Where to send log output
     --
+  , clientCapabilities  :: Maybe InitializeRequestArguments
+    -- ^ Taken from Initialize Command Requests
+
   , request             :: request
     -- ^ Connection Request information, if we are responding to a request.
   }
+  deriving Functor
 
 ----------------------------------------------------------------------------
 type SessionId = Text