{-# LANGUAGE LambdaCase #-}

module Haskell.Debug.Adapter.Request where

import Control.Monad.IO.Class
import Data.Conduit
import Control.Lens
import Text.Parsec
import Data.Aeson
import qualified Data.ByteString.Lazy as B
import Control.Monad.State.Lazy
import qualified System.Log.Logger as L
import Control.Monad.Except

import qualified Haskell.DAP as DAP
import Haskell.Debug.Adapter.Type
import Haskell.Debug.Adapter.Utility
import Haskell.Debug.Adapter.Constant

-- |
--
run :: AppStores -> IO ()
run :: AppStores -> IO ()
run AppStores
appData = do
  String -> String -> IO ()
L.debugM String
_LOG_REQUEST String
"start request app"
  Either String ((), AppStores)
_ <- AppStores -> AppContext () -> IO (Either String ((), AppStores))
forall a.
AppStores -> AppContext a -> IO (Either String (a, AppStores))
runApp AppStores
appData AppContext ()
app
  String -> String -> IO ()
L.debugM String
_LOG_REQUEST String
"end request app"


-- |
--
app :: AppContext ()
app :: AppContext ()
app = (AppContext () -> (String -> AppContext ()) -> AppContext ())
-> (String -> AppContext ()) -> AppContext () -> AppContext ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip AppContext () -> (String -> AppContext ()) -> AppContext ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError String -> AppContext ()
errHdl (AppContext () -> AppContext ()) -> AppContext () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ do
  ()
_ <- ConduitT () Void AppContext () -> AppContext ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit ConduitT () Void AppContext ()
pipeline
  () -> AppContext ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  where
    pipeline :: ConduitM () Void AppContext ()
    pipeline :: ConduitT () Void AppContext ()
pipeline = ConduitT () ByteString AppContext ()
src ConduitT () ByteString AppContext ()
-> ConduitM ByteString Void AppContext ()
-> ConduitT () Void AppContext ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString WrapRequest AppContext ()
lbs2req ConduitT ByteString WrapRequest AppContext ()
-> ConduitM WrapRequest Void AppContext ()
-> ConduitM ByteString Void AppContext ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM WrapRequest Void AppContext ()
sink

    errHdl :: String -> AppContext ()
errHdl String
msg = do
      String -> String -> AppContext ()
criticalEV String
_LOG_REQUEST String
msg
      Event -> AppContext ()
addEvent Event
CriticalExitEvent


---------------------------------------------------------------------------------
-- |
--
src :: ConduitT () B.ByteString AppContext ()
src :: ConduitT () ByteString AppContext ()
src = do
  IO () -> ConduitT () ByteString AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT () ByteString AppContext ())
-> IO () -> ConduitT () ByteString AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.debugM String
_LOG_REQUEST (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"src start waiting."
  ByteString
bs <- StateT AppStores (ExceptT String IO) ByteString
-> ConduitT () ByteString AppContext ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT AppStores (ExceptT String IO) ByteString
goApp
  ByteString -> ConduitT () ByteString AppContext ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs
  ConduitT () ByteString AppContext ()
src

  where
    goApp :: AppContext B.ByteString
    goApp :: StateT AppStores (ExceptT String IO) ByteString
goApp = do
      ByteString
bs <- AppContext Int
getContentLength AppContext Int
-> (Int -> StateT AppStores (ExceptT String IO) ByteString)
-> StateT AppStores (ExceptT String IO) ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT AppStores (ExceptT String IO) ByteString
getContent
      ByteString -> AppContext ()
stdinLogging ByteString
bs
      ByteString -> StateT AppStores (ExceptT String IO) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs


-- |
--
getContent :: Int -> AppContext B.ByteString
getContent :: Int -> StateT AppStores (ExceptT String IO) ByteString
getContent Int
l = Getting Handle AppStores Handle -> AppStores -> Handle
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Handle AppStores Handle
Lens' AppStores Handle
inHandleAppStores (AppStores -> Handle)
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
           StateT AppStores (ExceptT String IO) Handle
-> (Handle -> StateT AppStores (ExceptT String IO) ByteString)
-> StateT AppStores (ExceptT String IO) ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Handle -> Int -> StateT AppStores (ExceptT String IO) ByteString)
-> Int -> Handle -> StateT AppStores (ExceptT String IO) ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> Int -> StateT AppStores (ExceptT String IO) ByteString
readCharsL Int
l


-- |
--
getContentLength :: AppContext Int
getContentLength :: AppContext Int
getContentLength = ByteString -> AppContext Int
go ByteString
B.empty
  where
    go :: B.ByteString -> AppContext Int
    go :: ByteString -> AppContext Int
go ByteString
buf = ByteString -> StateT AppStores (ExceptT String IO) ByteString
updateBuf ByteString
buf StateT AppStores (ExceptT String IO) ByteString
-> (ByteString -> AppContext Int) -> AppContext Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> AppContext Int
findLength

    updateBuf :: B.ByteString -> AppContext B.ByteString
    updateBuf :: ByteString -> StateT AppStores (ExceptT String IO) ByteString
updateBuf ByteString
buf = do
      Handle
hdl <- Getting Handle AppStores Handle -> AppStores -> Handle
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Handle AppStores Handle
Lens' AppStores Handle
inHandleAppStores (AppStores -> Handle)
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
      ByteString -> ByteString -> ByteString
B.append ByteString
buf (ByteString -> ByteString)
-> StateT AppStores (ExceptT String IO) ByteString
-> StateT AppStores (ExceptT String IO) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> StateT AppStores (ExceptT String IO) ByteString
readCharL Handle
hdl

    findLength :: B.ByteString -> AppContext Int
    findLength :: ByteString -> AppContext Int
findLength ByteString
buf = case Parsec String () Int -> String -> String -> Either ParseError Int
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () Int
forall u. ParsecT String u Identity Int
parser String
"find ContentLength parser" (ByteString -> String
lbs2str ByteString
buf) of
      Left ParseError
_  -> ByteString -> AppContext Int
go ByteString
buf
      Right Int
l -> Int -> AppContext Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
l

    parser :: ParsecT String u Identity Int
parser = do
      String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
_CONTENT_LENGTH
      String
len <- ParsecT String u Identity Char
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
_TWO_CRLF)
      Int -> ParsecT String u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String u Identity Int)
-> (String -> Int) -> String -> ParsecT String u Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> ParsecT String u Identity Int)
-> String -> ParsecT String u Identity Int
forall a b. (a -> b) -> a -> b
$ String
len


---------------------------------------------------------------------------------
-- |
--
lbs2req :: ConduitT B.ByteString WrapRequest AppContext ()
lbs2req :: ConduitT ByteString WrapRequest AppContext ()
lbs2req = do
  IO () -> ConduitT ByteString WrapRequest AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString WrapRequest AppContext ())
-> IO () -> ConduitT ByteString WrapRequest AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.debugM String
_LOG_REQUEST (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"lbs2req start waiting."
  ConduitT ByteString WrapRequest AppContext (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT ByteString WrapRequest AppContext (Maybe ByteString)
-> (Maybe ByteString
    -> ConduitT ByteString WrapRequest AppContext ())
-> ConduitT ByteString WrapRequest AppContext ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ByteString
Nothing  -> do
      String -> ConduitT ByteString WrapRequest AppContext ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ConduitT ByteString WrapRequest AppContext ())
-> String -> ConduitT ByteString WrapRequest AppContext ()
forall a b. (a -> b) -> a -> b
$ String
"unexpectHed Nothing."
    Just ByteString
reqBS -> do
      IO () -> ConduitT ByteString WrapRequest AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString WrapRequest AppContext ())
-> IO () -> ConduitT ByteString WrapRequest AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.debugM String
_LOG_REQUEST (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"lbs2req get data. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
lbs2str ByteString
reqBS
      StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
-> ConduitT ByteString WrapRequest AppContext (Maybe WrapRequest)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteString
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
goApp ByteString
reqBS) ConduitT ByteString WrapRequest AppContext (Maybe WrapRequest)
-> (Maybe WrapRequest
    -> ConduitT ByteString WrapRequest AppContext ())
-> ConduitT ByteString WrapRequest AppContext ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe WrapRequest
Nothing -> () -> ConduitT ByteString WrapRequest AppContext ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just WrapRequest
rq -> WrapRequest -> ConduitT ByteString WrapRequest AppContext ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield WrapRequest
rq
      ConduitT ByteString WrapRequest AppContext ()
lbs2req

  where
    goApp :: B.ByteString -> AppContext (Maybe WrapRequest)
    goApp :: ByteString
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
goApp ByteString
reqBS = (StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
 -> (String
     -> StateT AppStores (ExceptT String IO) (Maybe WrapRequest))
 -> StateT AppStores (ExceptT String IO) (Maybe WrapRequest))
-> (String
    -> StateT AppStores (ExceptT String IO) (Maybe WrapRequest))
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
-> (String
    -> StateT AppStores (ExceptT String IO) (Maybe WrapRequest))
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError String -> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
forall a. String -> StateT AppStores (ExceptT String IO) (Maybe a)
errHdl (StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
 -> StateT AppStores (ExceptT String IO) (Maybe WrapRequest))
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
forall a b. (a -> b) -> a -> b
$ do
      Request
req <- ByteString -> AppContext Request
decodeRequest ByteString
reqBS
      WrapRequest
reqW <- ByteString -> Request -> AppContext WrapRequest
createWrapRequest ByteString
reqBS Request
req
      Maybe WrapRequest
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WrapRequest
 -> StateT AppStores (ExceptT String IO) (Maybe WrapRequest))
-> Maybe WrapRequest
-> StateT AppStores (ExceptT String IO) (Maybe WrapRequest)
forall a b. (a -> b) -> a -> b
$ WrapRequest -> Maybe WrapRequest
forall a. a -> Maybe a
Just WrapRequest
reqW

    -- |
    --
    errHdl :: String -> StateT AppStores (ExceptT String IO) (Maybe a)
errHdl String
msg = do
      String -> String -> AppContext ()
warnEV String
_LOG_REQUEST String
msg
      Maybe a -> StateT AppStores (ExceptT String IO) (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- |
--
decodeRequest :: B.ByteString -> AppContext DAP.Request
decodeRequest :: ByteString -> AppContext Request
decodeRequest ByteString
bs = Either String Request -> AppContext Request
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String Request -> AppContext Request)
-> Either String Request -> AppContext Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Request
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs

-- |
--
createWrapRequest :: B.ByteString -> DAP.Request -> AppContext WrapRequest
createWrapRequest :: ByteString -> Request -> AppContext WrapRequest
createWrapRequest ByteString
bs Request
req
  | String
"initialize" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request InitializeRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request InitializeRequest -> WrapRequest)
-> (InitializeRequest -> Request InitializeRequest)
-> InitializeRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitializeRequest -> Request InitializeRequest
InitializeRequest (InitializeRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) InitializeRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String InitializeRequest
-> StateT AppStores (ExceptT String IO) InitializeRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String InitializeRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"launch"     String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request LaunchRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request LaunchRequest -> WrapRequest)
-> (LaunchRequest -> Request LaunchRequest)
-> LaunchRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LaunchRequest -> Request LaunchRequest
LaunchRequest (LaunchRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) LaunchRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String LaunchRequest
-> StateT AppStores (ExceptT String IO) LaunchRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String LaunchRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"disconnect" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request DisconnectRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request DisconnectRequest -> WrapRequest)
-> (DisconnectRequest -> Request DisconnectRequest)
-> DisconnectRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisconnectRequest -> Request DisconnectRequest
DisconnectRequest (DisconnectRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) DisconnectRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String DisconnectRequest
-> StateT AppStores (ExceptT String IO) DisconnectRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String DisconnectRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"pause" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request PauseRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request PauseRequest -> WrapRequest)
-> (PauseRequest -> Request PauseRequest)
-> PauseRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PauseRequest -> Request PauseRequest
PauseRequest (PauseRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) PauseRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String PauseRequest
-> StateT AppStores (ExceptT String IO) PauseRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String PauseRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"terminate" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request TerminateRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request TerminateRequest -> WrapRequest)
-> (TerminateRequest -> Request TerminateRequest)
-> TerminateRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TerminateRequest -> Request TerminateRequest
TerminateRequest (TerminateRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) TerminateRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String TerminateRequest
-> StateT AppStores (ExceptT String IO) TerminateRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String TerminateRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"setBreakpoints" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request SetBreakpointsRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request SetBreakpointsRequest -> WrapRequest)
-> (SetBreakpointsRequest -> Request SetBreakpointsRequest)
-> SetBreakpointsRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetBreakpointsRequest -> Request SetBreakpointsRequest
SetBreakpointsRequest (SetBreakpointsRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) SetBreakpointsRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String SetBreakpointsRequest
-> StateT AppStores (ExceptT String IO) SetBreakpointsRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String SetBreakpointsRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"setFunctionBreakpoints" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request SetFunctionBreakpointsRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request SetFunctionBreakpointsRequest -> WrapRequest)
-> (SetFunctionBreakpointsRequest
    -> Request SetFunctionBreakpointsRequest)
-> SetFunctionBreakpointsRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetFunctionBreakpointsRequest
-> Request SetFunctionBreakpointsRequest
SetFunctionBreakpointsRequest (SetFunctionBreakpointsRequest -> WrapRequest)
-> StateT
     AppStores (ExceptT String IO) SetFunctionBreakpointsRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String SetFunctionBreakpointsRequest
-> StateT
     AppStores (ExceptT String IO) SetFunctionBreakpointsRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String SetFunctionBreakpointsRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"setExceptionBreakpoints" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request SetExceptionBreakpointsRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request SetExceptionBreakpointsRequest -> WrapRequest)
-> (SetExceptionBreakpointsRequest
    -> Request SetExceptionBreakpointsRequest)
-> SetExceptionBreakpointsRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetExceptionBreakpointsRequest
-> Request SetExceptionBreakpointsRequest
SetExceptionBreakpointsRequest (SetExceptionBreakpointsRequest -> WrapRequest)
-> StateT
     AppStores (ExceptT String IO) SetExceptionBreakpointsRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String SetExceptionBreakpointsRequest
-> StateT
     AppStores (ExceptT String IO) SetExceptionBreakpointsRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String SetExceptionBreakpointsRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"configurationDone" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request ConfigurationDoneRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request ConfigurationDoneRequest -> WrapRequest)
-> (ConfigurationDoneRequest -> Request ConfigurationDoneRequest)
-> ConfigurationDoneRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationDoneRequest -> Request ConfigurationDoneRequest
ConfigurationDoneRequest (ConfigurationDoneRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) ConfigurationDoneRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String ConfigurationDoneRequest
-> StateT AppStores (ExceptT String IO) ConfigurationDoneRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String ConfigurationDoneRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"threads" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request ThreadsRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request ThreadsRequest -> WrapRequest)
-> (ThreadsRequest -> Request ThreadsRequest)
-> ThreadsRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadsRequest -> Request ThreadsRequest
ThreadsRequest (ThreadsRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) ThreadsRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String ThreadsRequest
-> StateT AppStores (ExceptT String IO) ThreadsRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String ThreadsRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"stackTrace" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request StackTraceRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request StackTraceRequest -> WrapRequest)
-> (StackTraceRequest -> Request StackTraceRequest)
-> StackTraceRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackTraceRequest -> Request StackTraceRequest
StackTraceRequest (StackTraceRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) StackTraceRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String StackTraceRequest
-> StateT AppStores (ExceptT String IO) StackTraceRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String StackTraceRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"scopes" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request ScopesRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request ScopesRequest -> WrapRequest)
-> (ScopesRequest -> Request ScopesRequest)
-> ScopesRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopesRequest -> Request ScopesRequest
ScopesRequest (ScopesRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) ScopesRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String ScopesRequest
-> StateT AppStores (ExceptT String IO) ScopesRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String ScopesRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"variables" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request VariablesRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request VariablesRequest -> WrapRequest)
-> (VariablesRequest -> Request VariablesRequest)
-> VariablesRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VariablesRequest -> Request VariablesRequest
VariablesRequest (VariablesRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) VariablesRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String VariablesRequest
-> StateT AppStores (ExceptT String IO) VariablesRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String VariablesRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"continue" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request ContinueRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request ContinueRequest -> WrapRequest)
-> (ContinueRequest -> Request ContinueRequest)
-> ContinueRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContinueRequest -> Request ContinueRequest
ContinueRequest (ContinueRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) ContinueRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String ContinueRequest
-> StateT AppStores (ExceptT String IO) ContinueRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String ContinueRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"next" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request NextRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request NextRequest -> WrapRequest)
-> (NextRequest -> Request NextRequest)
-> NextRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextRequest -> Request NextRequest
NextRequest (NextRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) NextRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String NextRequest
-> StateT AppStores (ExceptT String IO) NextRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String NextRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"stepIn" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request StepInRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request StepInRequest -> WrapRequest)
-> (StepInRequest -> Request StepInRequest)
-> StepInRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StepInRequest -> Request StepInRequest
StepInRequest (StepInRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) StepInRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String StepInRequest
-> StateT AppStores (ExceptT String IO) StepInRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String StepInRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"evaluate" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request EvaluateRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request EvaluateRequest -> WrapRequest)
-> (EvaluateRequest -> Request EvaluateRequest)
-> EvaluateRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluateRequest -> Request EvaluateRequest
EvaluateRequest (EvaluateRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) EvaluateRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String EvaluateRequest
-> StateT AppStores (ExceptT String IO) EvaluateRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String EvaluateRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | String
"completions" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> String
DAP.commandRequest Request
req = Request CompletionsRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest (Request CompletionsRequest -> WrapRequest)
-> (CompletionsRequest -> Request CompletionsRequest)
-> CompletionsRequest
-> WrapRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompletionsRequest -> Request CompletionsRequest
CompletionsRequest (CompletionsRequest -> WrapRequest)
-> StateT AppStores (ExceptT String IO) CompletionsRequest
-> AppContext WrapRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either String CompletionsRequest
-> StateT AppStores (ExceptT String IO) CompletionsRequest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either String CompletionsRequest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs))
  | Bool
otherwise = String -> AppContext WrapRequest
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> AppContext WrapRequest)
-> String -> AppContext WrapRequest
forall a b. (a -> b) -> a -> b
$ String
"unsupported request command. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
lbs2str ByteString
bs


---------------------------------------------------------------------------------
-- |
--
sink :: ConduitT WrapRequest Void AppContext ()
sink :: ConduitM WrapRequest Void AppContext ()
sink = do
  IO () -> ConduitM WrapRequest Void AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitM WrapRequest Void AppContext ())
-> IO () -> ConduitM WrapRequest Void AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.debugM String
_LOG_REQUEST (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"sink start waiting."
  ConduitT WrapRequest Void AppContext (Maybe WrapRequest)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT WrapRequest Void AppContext (Maybe WrapRequest)
-> (Maybe WrapRequest -> ConduitM WrapRequest Void AppContext ())
-> ConduitM WrapRequest Void AppContext ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WrapRequest
Nothing  -> do
      String -> ConduitT WrapRequest Void AppContext Any
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ConduitT WrapRequest Void AppContext Any)
-> String -> ConduitT WrapRequest Void AppContext Any
forall a b. (a -> b) -> a -> b
$ String
"unexpected Nothing."
      () -> ConduitM WrapRequest Void AppContext ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just WrapRequest
req -> do
      AppContext () -> ConduitM WrapRequest Void AppContext ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AppContext () -> ConduitM WrapRequest Void AppContext ())
-> AppContext () -> ConduitM WrapRequest Void AppContext ()
forall a b. (a -> b) -> a -> b
$ WrapRequest -> AppContext ()
goApp WrapRequest
req
      ConduitM WrapRequest Void AppContext ()
sink

  where
    -- |
    --
    goApp :: WrapRequest -> AppContext ()
    goApp :: WrapRequest -> AppContext ()
goApp = WrapRequest -> AppContext ()
addRequest