diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,4 +1,7 @@ +20190505 haskell-debug-adapter-0.0.31.0 + * [MODIFY] refactor some types. + 20190402 haskell-debug-adapter-0.0.30.0 * [INFO] support ghci-dap-0.0.12.0. diff --git a/haskell-debug-adapter.cabal b/haskell-debug-adapter.cabal --- a/haskell-debug-adapter.cabal +++ b/haskell-debug-adapter.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 936ac0a678039fb371ec5218b03ba08c8d2bb157ef6e48a790ee90ffa813d461 +-- hash: bdbb77dee4fb24c9ebba6688c717b597fe7f4a5777a04bae83277c3c8361e821 name: haskell-debug-adapter -version: 0.0.30.0 +version: 0.0.31.0 synopsis: Haskell Debug Adapter. description: Please see README.md category: Development diff --git a/src/Haskell/Debug/Adapter/Application.hs b/src/Haskell/Debug/Adapter/Application.hs --- a/src/Haskell/Debug/Adapter/Application.hs +++ b/src/Haskell/Debug/Adapter/Application.hs @@ -25,7 +25,7 @@ -- | --- +-- defaultAppStores :: S.Handle -> S.Handle -> IO AppStores defaultAppStores inHdl outHdl = do reqStore <- newMVar [] @@ -163,8 +163,7 @@ appMain (WrapRequest (InternalTransitRequest (HdaInternalTransitRequest s))) = transit s appMain reqW = do stateW <- view appStateWAppStores <$> get - - getStateRequestW stateW reqW >>= actionW >>= \case + doActivityW stateW reqW >>= \case Nothing -> return () Just st -> transit st @@ -174,7 +173,7 @@ transit st = actExitState >> updateState st >> actEntryState - + where actExitState = do stateW <- view appStateWAppStores <$> get diff --git a/src/Haskell/Debug/Adapter/State/Contaminated.hs b/src/Haskell/Debug/Adapter/State/Contaminated.hs --- a/src/Haskell/Debug/Adapter/State/Contaminated.hs +++ b/src/Haskell/Debug/Adapter/State/Contaminated.hs @@ -15,16 +15,16 @@ import qualified Haskell.Debug.Adapter.State.Utility as SU --- | +-- | -- -instance AppStateIF ContaminatedState where +instance AppStateIF ContaminatedStateData where -- | -- entryAction ContaminatedState = do liftIO $ L.debugM _LOG_APP "ContaminatedState entryAction called." return () - + -- | -- exitAction ContaminatedState = do @@ -32,49 +32,66 @@ return () - -- | + -- | -- - getStateRequest ContaminatedState (WrapRequest (InitializeRequest req)) = SU.unsupported $ show req - getStateRequest ContaminatedState (WrapRequest (LaunchRequest req)) = SU.unsupported $ show req - getStateRequest ContaminatedState (WrapRequest (DisconnectRequest req)) = SU.unsupported $ show req - getStateRequest ContaminatedState (WrapRequest (PauseRequest req)) = SU.unsupported $ show req - getStateRequest ContaminatedState (WrapRequest (TerminateRequest req)) = return . WrapStateRequest $ Contaminated_Terminate req - - getStateRequest ContaminatedState (WrapRequest (SetBreakpointsRequest req)) = return . WrapStateRequest $ Contaminated_SetBreakpoints req - getStateRequest ContaminatedState (WrapRequest (SetFunctionBreakpointsRequest req)) = return . WrapStateRequest $ Contaminated_SetFunctionBreakpoints req - getStateRequest ContaminatedState (WrapRequest (SetExceptionBreakpointsRequest req)) = return . WrapStateRequest $ Contaminated_SetExceptionBreakpoints req - getStateRequest ContaminatedState (WrapRequest (ConfigurationDoneRequest req)) = SU.unsupported $ show req - getStateRequest ContaminatedState (WrapRequest (ThreadsRequest req)) = return . WrapStateRequest $ Contaminated_Threads req - getStateRequest ContaminatedState (WrapRequest (StackTraceRequest req)) = return . WrapStateRequest $ Contaminated_StackTrace req - getStateRequest ContaminatedState (WrapRequest (ScopesRequest req)) = return . WrapStateRequest $ Contaminated_Scopes req - getStateRequest ContaminatedState (WrapRequest (VariablesRequest req)) = return . WrapStateRequest $ Contaminated_Variables req - getStateRequest ContaminatedState (WrapRequest (ContinueRequest req)) = return . WrapStateRequest $ Contaminated_Continue req - getStateRequest ContaminatedState (WrapRequest (NextRequest req)) = return . WrapStateRequest $ Contaminated_Next req - getStateRequest ContaminatedState (WrapRequest (StepInRequest req)) = return . WrapStateRequest $ Contaminated_StepIn req - getStateRequest ContaminatedState (WrapRequest (EvaluateRequest req)) = return . WrapStateRequest $ Contaminated_Evaluate req - getStateRequest ContaminatedState (WrapRequest (CompletionsRequest req)) = return . WrapStateRequest $ Contaminated_Completions req - getStateRequest ContaminatedState (WrapRequest (InternalTransitRequest req)) = SU.unsupported $ show req - getStateRequest ContaminatedState (WrapRequest (InternalTerminateRequest req)) = return . WrapStateRequest $ Contaminated_InternalTerminate req - getStateRequest ContaminatedState (WrapRequest (InternalLoadRequest req)) = return . WrapStateRequest $ Contaminated_InternalLoad req + doActivity s (WrapRequest r@InitializeRequest{}) = action2 s r + doActivity s (WrapRequest r@LaunchRequest{}) = action2 s r + doActivity s (WrapRequest r@DisconnectRequest{}) = action2 s r + doActivity s (WrapRequest r@PauseRequest{}) = action2 s r + doActivity s (WrapRequest r@TerminateRequest{}) = action2 s r + doActivity s (WrapRequest r@SetBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@ConfigurationDoneRequest{}) = action2 s r + doActivity s (WrapRequest r@ThreadsRequest{}) = action2 s r + doActivity s (WrapRequest r@StackTraceRequest{}) = action2 s r + doActivity s (WrapRequest r@ScopesRequest{}) = action2 s r + doActivity s (WrapRequest r@VariablesRequest{}) = action2 s r + doActivity s (WrapRequest r@ContinueRequest{}) = action2 s r + doActivity s (WrapRequest r@NextRequest{}) = action2 s r + doActivity s (WrapRequest r@StepInRequest{}) = action2 s r + doActivity s (WrapRequest r@EvaluateRequest{}) = action2 s r + doActivity s (WrapRequest r@CompletionsRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalTransitRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalTerminateRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalLoadRequest{}) = action2 s r +-- | +-- default nop. +-- +instance StateActivityIF ContaminatedStateData DAP.InitializeRequest -- | +-- default nop. +-- +instance StateActivityIF ContaminatedStateData DAP.LaunchRequest + +-- | +-- default nop. +-- +instance StateActivityIF ContaminatedStateData DAP.DisconnectRequest + +-- | +-- default nop. +-- +instance StateActivityIF ContaminatedStateData DAP.PauseRequest + +-- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.TerminateRequest where - action (Contaminated_Terminate req) = do +instance StateActivityIF ContaminatedStateData DAP.TerminateRequest where + action2 _ (TerminateRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState TerminateRequest called. " ++ show req SU.terminateRequest req return $ Just Contaminated_Shutdown - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.SetBreakpointsRequest where - action (Contaminated_SetBreakpoints req) = do +instance StateActivityIF ContaminatedStateData DAP.SetBreakpointsRequest where + action2 _ (SetBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState SetBreakpointsRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultSetBreakpointsResponse { @@ -87,12 +104,11 @@ U.addResponse $ SetBreakpointsResponse res return Nothing - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.SetFunctionBreakpointsRequest where - action (Contaminated_SetFunctionBreakpoints req) = do +instance StateActivityIF ContaminatedStateData DAP.SetFunctionBreakpointsRequest where + action2 _ (SetFunctionBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState SetFunctionBreakpointsRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultSetFunctionBreakpointsResponse { @@ -105,12 +121,11 @@ U.addResponse $ SetFunctionBreakpointsResponse res return Nothing - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.SetExceptionBreakpointsRequest where - action (Contaminated_SetExceptionBreakpoints req) = do +instance StateActivityIF ContaminatedStateData DAP.SetExceptionBreakpointsRequest where + action2 _ (SetExceptionBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState SetExceptionBreakpointsRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultSetExceptionBreakpointsResponse { @@ -123,12 +138,16 @@ U.addResponse $ SetExceptionBreakpointsResponse res return Nothing +-- | +-- default nop. +-- +instance StateActivityIF ContaminatedStateData DAP.ConfigurationDoneRequest -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.ThreadsRequest where - action (Contaminated_Threads req) = do +instance StateActivityIF ContaminatedStateData DAP.ThreadsRequest where + action2 _ (ThreadsRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState ThreadsRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultThreadsResponse { @@ -141,12 +160,11 @@ U.addResponse $ ThreadsResponse res return Nothing - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.StackTraceRequest where - action (Contaminated_StackTrace req) = do +instance StateActivityIF ContaminatedStateData DAP.StackTraceRequest where + action2 _ (StackTraceRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState StackTraceRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultStackTraceResponse { @@ -159,13 +177,11 @@ U.addResponse $ StackTraceResponse res return Nothing - - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.ScopesRequest where - action (Contaminated_Scopes req) = do +instance StateActivityIF ContaminatedStateData DAP.ScopesRequest where + action2 _ (ScopesRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState ScopesRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultScopesResponse { @@ -178,13 +194,11 @@ U.addResponse $ ScopesResponse res return Nothing - - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.VariablesRequest where - action (Contaminated_Variables req) = do +instance StateActivityIF ContaminatedStateData DAP.VariablesRequest where + action2 _ (VariablesRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState VariablesRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultVariablesResponse { @@ -197,67 +211,68 @@ U.addResponse $ VariablesResponse res return Nothing - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.ContinueRequest where - action (Contaminated_Continue req) = do +instance StateActivityIF ContaminatedStateData DAP.ContinueRequest where + action2 _ (ContinueRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState ContinueRequest called. " ++ show req restartEvent return $ Just Contaminated_Shutdown - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.NextRequest where - action (Contaminated_Next req) = do +instance StateActivityIF ContaminatedStateData DAP.NextRequest where + action2 _ (NextRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState NextRequest called. " ++ show req restartEvent return $ Just Contaminated_Shutdown - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.StepInRequest where - action (Contaminated_StepIn req) = do +instance StateActivityIF ContaminatedStateData DAP.StepInRequest where + action2 _ (StepInRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState StepInRequest called. " ++ show req restartEvent return $ Just Contaminated_Shutdown - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.EvaluateRequest where - action (Contaminated_Evaluate req) = do +instance StateActivityIF ContaminatedStateData DAP.EvaluateRequest where + action2 _ (EvaluateRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState EvaluateRequest called. " ++ show req SU.evaluateRequest req - -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState DAP.CompletionsRequest where - action (Contaminated_Completions req) = do +instance StateActivityIF ContaminatedStateData DAP.CompletionsRequest where + action2 _ (CompletionsRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState CompletionsRequest called. " ++ show req SU.completionsRequest req -- | --- Any errors should be critical. don't catch anything here. +-- default nop. -- -instance StateRequestIF ContaminatedState HdaInternalTerminateRequest where - action (Contaminated_InternalTerminate req) = do +instance StateActivityIF ContaminatedStateData HdaInternalTransitRequest + +-- | +-- Any errors should be sent back as False result Response +-- +instance StateActivityIF ContaminatedStateData HdaInternalTerminateRequest where + action2 _ (InternalTerminateRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState InternalTerminateRequest called. " ++ show req SU.internalTerminateRequest return $ Just Contaminated_Shutdown - -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF ContaminatedState HdaInternalLoadRequest where - action (Contaminated_InternalLoad req) = do +instance StateActivityIF ContaminatedStateData HdaInternalLoadRequest where + action2 _ (InternalLoadRequest req) = do liftIO $ L.debugM _LOG_APP $ "ContaminatedState InternalLoadRequest called. " ++ show req SU.loadHsFile $ pathHdaInternalLoadRequest req return Nothing diff --git a/src/Haskell/Debug/Adapter/State/DebugRun.hs b/src/Haskell/Debug/Adapter/State/DebugRun.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun.hs @@ -29,7 +29,7 @@ import qualified Haskell.Debug.Adapter.State.Utility as SU -instance AppStateIF DebugRunState where +instance AppStateIF DebugRunStateData where -- | -- entryAction DebugRunState = do @@ -43,36 +43,52 @@ return () - -- | + -- | -- - getStateRequest DebugRunState (WrapRequest (InitializeRequest req)) = SU.unsupported $ show req - getStateRequest DebugRunState (WrapRequest (LaunchRequest req)) = SU.unsupported $ show req - getStateRequest DebugRunState (WrapRequest (DisconnectRequest req)) = SU.unsupported $ show req - getStateRequest DebugRunState (WrapRequest (PauseRequest req)) = SU.unsupported $ show req - - getStateRequest DebugRunState (WrapRequest (TerminateRequest req)) = return . WrapStateRequest $ DebugRun_Terminate req - getStateRequest DebugRunState (WrapRequest (SetBreakpointsRequest req)) = return . WrapStateRequest $ DebugRun_SetBreakpoints req - getStateRequest DebugRunState (WrapRequest (SetFunctionBreakpointsRequest req)) = return . WrapStateRequest $ DebugRun_SetFunctionBreakpoints req - getStateRequest DebugRunState (WrapRequest (SetExceptionBreakpointsRequest req)) = return . WrapStateRequest $ DebugRun_SetExceptionBreakpoints req + doActivity s (WrapRequest r@InitializeRequest{}) = action2 s r + doActivity s (WrapRequest r@LaunchRequest{}) = action2 s r + doActivity s (WrapRequest r@DisconnectRequest{}) = action2 s r + doActivity s (WrapRequest r@PauseRequest{}) = action2 s r + doActivity s (WrapRequest r@TerminateRequest{}) = action2 s r + doActivity s (WrapRequest r@SetBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@ConfigurationDoneRequest{}) = action2 s r + doActivity s (WrapRequest r@ThreadsRequest{}) = action2 s r + doActivity s (WrapRequest r@StackTraceRequest{}) = action2 s r + doActivity s (WrapRequest r@ScopesRequest{}) = action2 s r + doActivity s (WrapRequest r@VariablesRequest{}) = action2 s r + doActivity s (WrapRequest r@ContinueRequest{}) = action2 s r + doActivity s (WrapRequest r@NextRequest{}) = action2 s r + doActivity s (WrapRequest r@StepInRequest{}) = action2 s r + doActivity s (WrapRequest r@EvaluateRequest{}) = action2 s r + doActivity s (WrapRequest r@CompletionsRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalTransitRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalTerminateRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalLoadRequest{}) = action2 s r - getStateRequest DebugRunState (WrapRequest (ConfigurationDoneRequest req)) = SU.unsupported $ show req +-- | +-- default nop. +-- +instance StateActivityIF DebugRunStateData DAP.InitializeRequest - getStateRequest DebugRunState (WrapRequest (ThreadsRequest req)) = return . WrapStateRequest $ DebugRun_Threads req - getStateRequest DebugRunState (WrapRequest (StackTraceRequest req)) = return . WrapStateRequest $ DebugRun_StackTrace req - getStateRequest DebugRunState (WrapRequest (ScopesRequest req)) = return . WrapStateRequest $ DebugRun_Scopes req - getStateRequest DebugRunState (WrapRequest (VariablesRequest req)) = return . WrapStateRequest $ DebugRun_Variables req - getStateRequest DebugRunState (WrapRequest (ContinueRequest req)) = return . WrapStateRequest $ DebugRun_Continue req - getStateRequest DebugRunState (WrapRequest (NextRequest req)) = return . WrapStateRequest $ DebugRun_Next req - getStateRequest DebugRunState (WrapRequest (StepInRequest req)) = return . WrapStateRequest $ DebugRun_StepIn req - getStateRequest DebugRunState (WrapRequest (EvaluateRequest req)) = return . WrapStateRequest $ DebugRun_Evaluate req - getStateRequest DebugRunState (WrapRequest (CompletionsRequest req)) = return . WrapStateRequest $ DebugRun_Completions req +-- | +-- default nop. +-- +instance StateActivityIF DebugRunStateData DAP.LaunchRequest - getStateRequest DebugRunState (WrapRequest (InternalTransitRequest req)) = SU.unsupported $ show req - getStateRequest DebugRunState (WrapRequest (InternalTerminateRequest req)) = return . WrapStateRequest $ DebugRun_InternalTerminate req - getStateRequest DebugRunState (WrapRequest (InternalLoadRequest req)) = return . WrapStateRequest $ DebugRun_InternalLoad req +-- | +-- default nop. +-- +instance StateActivityIF DebugRunStateData DAP.DisconnectRequest -- | +-- default nop. -- +instance StateActivityIF DebugRunStateData DAP.PauseRequest + +-- | +-- goEntry :: AppContext () goEntry = view stopOnEntryAppStores <$> get >>= \case True -> stopOnEntry @@ -91,7 +107,7 @@ P.cmdAndOut cmd res <- P.expectH P.stdoutCallBk - + withAdhocAddDapHeader $ filter (U.startswith _DAP_HEADER) res where @@ -123,7 +139,7 @@ P.cmdAndOut cmd res <- P.expectH P.stdoutCallBk - + withAdhocDelDapHeader $ filter (U.startswith _DAP_HEADER) res -- | @@ -156,7 +172,7 @@ return $ U.strip $ func ++ " " ++ funcArgs startDebugDAP args = do - + let dap = ":dap-continue " cmd = dap ++ U.showDAP args dbg = dap ++ show args @@ -164,10 +180,10 @@ P.cmdAndOut cmd U.debugEV _LOG_APP dbg P.expectH $ P.funcCallBk lineCallBk - + return () - + lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s lineCallBk False s @@ -196,46 +212,58 @@ -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.SetBreakpointsRequest where - action (DebugRun_SetBreakpoints req) = do +instance StateActivityIF DebugRunStateData DAP.SetBreakpointsRequest where + action2 _ (SetBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState SetBreakpointsRequest called. " ++ show req SU.setBreakpointsRequest req -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.SetExceptionBreakpointsRequest where - action (DebugRun_SetExceptionBreakpoints req) = do +instance StateActivityIF DebugRunStateData DAP.SetExceptionBreakpointsRequest where + action2 _ (SetExceptionBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState SetExceptionBreakpointsRequest called. " ++ show req SU.setExceptionBreakpointsRequest req -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.SetFunctionBreakpointsRequest where - action (DebugRun_SetFunctionBreakpoints req) = do +instance StateActivityIF DebugRunStateData DAP.SetFunctionBreakpointsRequest where + action2 _ (SetFunctionBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState SetFunctionBreakpointsRequest called. " ++ show req SU.setFunctionBreakpointsRequest req -- | +-- default nop. -- -instance StateRequestIF DebugRunState DAP.EvaluateRequest where - action (DebugRun_Evaluate req) = do +instance StateActivityIF DebugRunStateData DAP.ConfigurationDoneRequest + +-- | +-- Any errors should be sent back as False result Response +-- +instance StateActivityIF DebugRunStateData DAP.EvaluateRequest where + action2 _ (EvaluateRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState EvaluateRequest called. " ++ show req SU.evaluateRequest req -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.CompletionsRequest where - action (DebugRun_Completions req) = do +instance StateActivityIF DebugRunStateData DAP.CompletionsRequest where + action2 _ (CompletionsRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState CompletionsRequest called. " ++ show req SU.completionsRequest req +-- | +-- default nop. +-- +instance StateActivityIF DebugRunStateData HdaInternalTransitRequest -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState HdaInternalLoadRequest where - action (DebugRun_InternalLoad req) = do +instance StateActivityIF DebugRunStateData HdaInternalLoadRequest where + action2 _ (InternalLoadRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState InternalLoadRequest called. " ++ show req SU.loadHsFile $ pathHdaInternalLoadRequest req return $ Just DebugRun_Contaminated diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/Continue.hs b/src/Haskell/Debug/Adapter/State/DebugRun/Continue.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/Continue.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/Continue.hs @@ -16,9 +16,10 @@ import qualified Haskell.Debug.Adapter.GHCi as P -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.ContinueRequest where - action (DebugRun_Continue req) = do +instance StateActivityIF DebugRunStateData DAP.ContinueRequest where + action2 _ (ContinueRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState ContinueRequest called. " ++ show req app req @@ -26,7 +27,7 @@ -- app :: DAP.ContinueRequest -> AppContext (Maybe StateTransit) app req = flip catchError errHdl $ do - + let args = DAP.argumentsContinueRequest req dap = ":dap-continue " cmd = dap ++ U.showDAP args @@ -46,7 +47,7 @@ U.addResponse $ ContinueResponse res return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/InternalTerminate.hs b/src/Haskell/Debug/Adapter/State/DebugRun/InternalTerminate.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/InternalTerminate.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/InternalTerminate.hs @@ -13,13 +13,12 @@ import qualified Haskell.Debug.Adapter.State.Utility as SU -- | --- Any errors should be critical. don't catch anything here. +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState HdaInternalTerminateRequest where - action (DebugRun_InternalTerminate req) = do +instance StateActivityIF DebugRunStateData HdaInternalTerminateRequest where + action2 _ (InternalTerminateRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState InternalTerminateRequest called. " ++ show req app req - -- | -- diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/Next.hs b/src/Haskell/Debug/Adapter/State/DebugRun/Next.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/Next.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/Next.hs @@ -16,9 +16,10 @@ import qualified Haskell.Debug.Adapter.GHCi as P -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.NextRequest where - action (DebugRun_Next req) = do +instance StateActivityIF DebugRunStateData DAP.NextRequest where + action2 _ (NextRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState NextRequest called. " ++ show req app req @@ -26,7 +27,7 @@ -- app :: DAP.NextRequest -> AppContext (Maybe StateTransit) app req = flip catchError errHdl $ do - + let args = DAP.argumentsNextRequest req dap = ":dap-next " cmd = dap ++ U.showDAP args @@ -46,7 +47,7 @@ U.addResponse $ NextResponse res return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s @@ -63,7 +64,7 @@ Left err -> errHdl err >> return () Right (Left err) -> errHdl err >> return () Right (Right body) -> U.handleStoppedEventBody body - + -- | -- diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/Scopes.hs b/src/Haskell/Debug/Adapter/State/DebugRun/Scopes.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/Scopes.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/Scopes.hs @@ -15,11 +15,12 @@ import qualified Haskell.Debug.Adapter.Utility as U import qualified Haskell.Debug.Adapter.GHCi as P + -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.ScopesRequest where - --action :: (StateRequest s r) -> AppContext () - action (DebugRun_Scopes req) = do +instance StateActivityIF DebugRunStateData DAP.ScopesRequest where + action2 _ (ScopesRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState ScopesRequest called. " ++ show req app req @@ -27,7 +28,7 @@ -- app :: DAP.ScopesRequest -> AppContext (Maybe StateTransit) app req = flip catchError errHdl $ do - + let args = DAP.argumentsScopesRequest req dap = ":dap-scopes " cmd = dap ++ U.showDAP args @@ -38,7 +39,7 @@ P.expectH $ P.funcCallBk lineCallBk return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/StackTrace.hs b/src/Haskell/Debug/Adapter/State/DebugRun/StackTrace.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/StackTrace.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/StackTrace.hs @@ -15,10 +15,12 @@ import qualified Haskell.Debug.Adapter.Utility as U import qualified Haskell.Debug.Adapter.GHCi as P + -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.StackTraceRequest where - action (DebugRun_StackTrace req) = do +instance StateActivityIF DebugRunStateData DAP.StackTraceRequest where + action2 _ (StackTraceRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState StackTraceRequest called. " ++ show req app req @@ -26,7 +28,7 @@ -- app :: DAP.StackTraceRequest -> AppContext (Maybe StateTransit) app req = flip catchError errHdl $ do - + let args = DAP.argumentsStackTraceRequest req dap = ":dap-stacktrace " cmd = dap ++ U.showDAP args @@ -37,7 +39,7 @@ P.expectH $ P.funcCallBk lineCallBk return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/StepIn.hs b/src/Haskell/Debug/Adapter/State/DebugRun/StepIn.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/StepIn.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/StepIn.hs @@ -16,10 +16,10 @@ import qualified Haskell.Debug.Adapter.GHCi as P -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.StepInRequest where - --action :: (StateRequest s r) -> AppContext () - action (DebugRun_StepIn req) = do +instance StateActivityIF DebugRunStateData DAP.StepInRequest where + action2 _ (StepInRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState StepInRequest called. " ++ show req app req @@ -27,7 +27,7 @@ -- app :: DAP.StepInRequest -> AppContext (Maybe StateTransit) app req = flip catchError errHdl $ do - + let args = DAP.argumentsStepInRequest req dap = ":dap-step-in " cmd = dap ++ U.showDAP args @@ -47,7 +47,7 @@ U.addResponse $ StepInResponse res return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/Terminate.hs b/src/Haskell/Debug/Adapter/State/DebugRun/Terminate.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/Terminate.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/Terminate.hs @@ -14,13 +14,12 @@ import qualified Haskell.Debug.Adapter.State.Utility as SU -- | --- Any errors should be critical. don't catch anything here. +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.TerminateRequest where - action (DebugRun_Terminate req) = do +instance StateActivityIF DebugRunStateData DAP.TerminateRequest where + action2 _ (TerminateRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState TerminateRequest called. " ++ show req app req - -- | -- diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/Threads.hs b/src/Haskell/Debug/Adapter/State/DebugRun/Threads.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/Threads.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/Threads.hs @@ -12,9 +12,10 @@ import qualified Haskell.Debug.Adapter.Utility as U -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.ThreadsRequest where - action (DebugRun_Threads req) = do +instance StateActivityIF DebugRunStateData DAP.ThreadsRequest where + action2 _ (ThreadsRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState ThreadsRequest called. " ++ show req app req @@ -30,5 +31,5 @@ } U.addResponse $ ThreadsResponse res - + return Nothing diff --git a/src/Haskell/Debug/Adapter/State/DebugRun/Variables.hs b/src/Haskell/Debug/Adapter/State/DebugRun/Variables.hs --- a/src/Haskell/Debug/Adapter/State/DebugRun/Variables.hs +++ b/src/Haskell/Debug/Adapter/State/DebugRun/Variables.hs @@ -16,9 +16,10 @@ import qualified Haskell.Debug.Adapter.GHCi as P -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF DebugRunState DAP.VariablesRequest where - action (DebugRun_Variables req) = do +instance StateActivityIF DebugRunStateData DAP.VariablesRequest where + action2 _ (VariablesRequest req) = do liftIO $ L.debugM _LOG_APP $ "DebugRunState VariablesRequest called. " ++ show req app req @@ -26,7 +27,7 @@ -- app :: DAP.VariablesRequest -> AppContext (Maybe StateTransit) app req = flip catchError errHdl $ do - + let args = DAP.argumentsVariablesRequest req dap = ":dap-variables " cmd = dap ++ U.showDAP args @@ -37,7 +38,7 @@ P.expectH $ P.funcCallBk lineCallBk return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s diff --git a/src/Haskell/Debug/Adapter/State/GHCiRun.hs b/src/Haskell/Debug/Adapter/State/GHCiRun.hs --- a/src/Haskell/Debug/Adapter/State/GHCiRun.hs +++ b/src/Haskell/Debug/Adapter/State/GHCiRun.hs @@ -13,7 +13,7 @@ import qualified Haskell.Debug.Adapter.State.Utility as SU import qualified Haskell.Debug.Adapter.Utility as U -instance AppStateIF GHCiRunState where +instance AppStateIF GHCiRunStateData where -- | -- entryAction GHCiRunState = do @@ -27,79 +27,90 @@ return () - -- | + -- | -- - getStateRequest GHCiRunState (WrapRequest (InitializeRequest req)) = SU.unsupported $ show req - getStateRequest GHCiRunState (WrapRequest (LaunchRequest req)) = SU.unsupported $ show req - getStateRequest GHCiRunState (WrapRequest (DisconnectRequest req)) = SU.unsupported $ show req - getStateRequest GHCiRunState (WrapRequest (PauseRequest req)) = SU.unsupported $ show req - - getStateRequest GHCiRunState (WrapRequest (TerminateRequest req)) = return . WrapStateRequest $ GHCiRun_Terminate req - getStateRequest GHCiRunState (WrapRequest (SetBreakpointsRequest req)) = return . WrapStateRequest $ GHCiRun_SetBreakpoints req - getStateRequest GHCiRunState (WrapRequest (SetFunctionBreakpointsRequest req)) = return . WrapStateRequest $ GHCiRun_SetFunctionBreakpoints req - getStateRequest GHCiRunState (WrapRequest (SetExceptionBreakpointsRequest req)) = return . WrapStateRequest $ GHCiRun_SetExceptionBreakpoints req - getStateRequest GHCiRunState (WrapRequest (ConfigurationDoneRequest req)) = return . WrapStateRequest $ GHCiRun_ConfigurationDone req - - getStateRequest GHCiRunState (WrapRequest (ThreadsRequest req)) = return . WrapStateRequest $ GHCiRun_Threads req - getStateRequest GHCiRunState (WrapRequest (StackTraceRequest req)) = return . WrapStateRequest $ GHCiRun_StackTrace req - getStateRequest GHCiRunState (WrapRequest (ScopesRequest req)) = return . WrapStateRequest $ GHCiRun_Scopes req - getStateRequest GHCiRunState (WrapRequest (VariablesRequest req)) = return . WrapStateRequest $ GHCiRun_Variables req + doActivity s (WrapRequest r@InitializeRequest{}) = action2 s r + doActivity s (WrapRequest r@LaunchRequest{}) = action2 s r + doActivity s (WrapRequest r@DisconnectRequest{}) = action2 s r + doActivity s (WrapRequest r@PauseRequest{}) = action2 s r + doActivity s (WrapRequest r@TerminateRequest{}) = action2 s r + doActivity s (WrapRequest r@SetBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@ConfigurationDoneRequest{}) = action2 s r + doActivity s (WrapRequest r@ThreadsRequest{}) = action2 s r + doActivity s (WrapRequest r@StackTraceRequest{}) = action2 s r + doActivity s (WrapRequest r@ScopesRequest{}) = action2 s r + doActivity s (WrapRequest r@VariablesRequest{}) = action2 s r + doActivity s (WrapRequest r@ContinueRequest{}) = action2 s r + doActivity s (WrapRequest r@NextRequest{}) = action2 s r + doActivity s (WrapRequest r@StepInRequest{}) = action2 s r + doActivity s (WrapRequest r@EvaluateRequest{}) = action2 s r + doActivity s (WrapRequest r@CompletionsRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalTransitRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalTerminateRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalLoadRequest{}) = action2 s r - getStateRequest GHCiRunState (WrapRequest (ContinueRequest req)) = return . WrapStateRequest $ GHCiRun_Continue req - getStateRequest GHCiRunState (WrapRequest (NextRequest req)) = return . WrapStateRequest $ GHCiRun_Next req - getStateRequest GHCiRunState (WrapRequest (StepInRequest req)) = return . WrapStateRequest $ GHCiRun_StepIn req +-- | +-- default nop. +-- +instance StateActivityIF GHCiRunStateData DAP.InitializeRequest - getStateRequest GHCiRunState (WrapRequest (EvaluateRequest req)) = return . WrapStateRequest $ GHCiRun_Evaluate req - getStateRequest GHCiRunState (WrapRequest (CompletionsRequest req)) = return . WrapStateRequest $ GHCiRun_Completions req +-- | +-- default nop. +-- +instance StateActivityIF GHCiRunStateData DAP.LaunchRequest - getStateRequest GHCiRunState (WrapRequest (InternalTransitRequest req)) = SU.unsupported $ show req +-- | +-- default nop. +-- +instance StateActivityIF GHCiRunStateData DAP.DisconnectRequest - getStateRequest GHCiRunState (WrapRequest (InternalTerminateRequest req)) = return . WrapStateRequest $ GHCiRun_InternalTerminate req - getStateRequest GHCiRunState (WrapRequest (InternalLoadRequest req)) = return . WrapStateRequest $ GHCiRun_InternalLoad req +-- | +-- default nop. +-- +instance StateActivityIF GHCiRunStateData DAP.PauseRequest +-- | +-- Any errors should be sent back as False result Response +-- +instance StateActivityIF GHCiRunStateData DAP.TerminateRequest where + action2 _ (TerminateRequest req) = do + liftIO $ L.debugM _LOG_APP $ "GHCiRunState TerminateRequest called. " ++ show req + SU.terminateRequest req + + return $ Just GHCiRun_Shutdown + -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.SetBreakpointsRequest where - action (GHCiRun_SetBreakpoints req) = do +instance StateActivityIF GHCiRunStateData DAP.SetBreakpointsRequest where + action2 _ (SetBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState SetBreakpointsRequest called. " ++ show req SU.setBreakpointsRequest req -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.SetExceptionBreakpointsRequest where - action (GHCiRun_SetExceptionBreakpoints req) = do +instance StateActivityIF GHCiRunStateData DAP.SetExceptionBreakpointsRequest where + action2 _ (SetExceptionBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState SetExceptionBreakpointsRequest called. " ++ show req SU.setExceptionBreakpointsRequest req -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.SetFunctionBreakpointsRequest where - action (GHCiRun_SetFunctionBreakpoints req) = do +instance StateActivityIF GHCiRunStateData DAP.SetFunctionBreakpointsRequest where + action2 _ (SetFunctionBreakpointsRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState SetFunctionBreakpointsRequest called. " ++ show req SU.setFunctionBreakpointsRequest req - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.TerminateRequest where - action (GHCiRun_Terminate req) = do - liftIO $ L.debugM _LOG_APP $ "GHCiRunState TerminateRequest called. " ++ show req - - SU.terminateRequest req - - return $ Just GHCiRun_Shutdown - - --- | --- Any errors should be sent back as False result Response --- -instance StateRequestIF GHCiRunState DAP.ThreadsRequest where - action (GHCiRun_Threads req) = do +instance StateActivityIF GHCiRunStateData DAP.ThreadsRequest where + action2 _ (ThreadsRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState ThreadsRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultThreadsResponse { @@ -112,13 +123,11 @@ U.addResponse $ ThreadsResponse res return Nothing - - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.StackTraceRequest where - action (GHCiRun_StackTrace req) = do +instance StateActivityIF GHCiRunStateData DAP.StackTraceRequest where + action2 _ (StackTraceRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState StackTraceRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultStackTraceResponse { @@ -131,13 +140,11 @@ U.addResponse $ StackTraceResponse res return Nothing - - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.ScopesRequest where - action (GHCiRun_Scopes req) = do +instance StateActivityIF GHCiRunStateData DAP.ScopesRequest where + action2 _ (ScopesRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState ScopesRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultScopesResponse { @@ -150,13 +157,11 @@ U.addResponse $ ScopesResponse res return Nothing - - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.VariablesRequest where - action (GHCiRun_Variables req) = do +instance StateActivityIF GHCiRunStateData DAP.VariablesRequest where + action2 _ (VariablesRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState VariablesRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultVariablesResponse { @@ -170,12 +175,11 @@ return Nothing - -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.ContinueRequest where - action (GHCiRun_Continue req) = do +instance StateActivityIF GHCiRunStateData DAP.ContinueRequest where + action2 _ (ContinueRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState ContinueRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultContinueResponse { @@ -192,8 +196,8 @@ -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.NextRequest where - action (GHCiRun_Next req) = do +instance StateActivityIF GHCiRunStateData DAP.NextRequest where + action2 _ (NextRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState NextRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultNextResponse { @@ -210,8 +214,8 @@ -- | -- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.StepInRequest where - action (GHCiRun_StepIn req) = do +instance StateActivityIF GHCiRunStateData DAP.StepInRequest where + action2 _ (StepInRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState StepInRequest called. " ++ show req resSeq <- U.getIncreasedResponseSequence let res = DAP.defaultStepInResponse { @@ -225,37 +229,43 @@ return $ Just GHCiRun_DebugRun - -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.EvaluateRequest where - action (GHCiRun_Evaluate req) = do +instance StateActivityIF GHCiRunStateData DAP.EvaluateRequest where + action2 _ (EvaluateRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState EvaluateRequest called. " ++ show req SU.evaluateRequest req -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.CompletionsRequest where - action (GHCiRun_Completions req) = do +instance StateActivityIF GHCiRunStateData DAP.CompletionsRequest where + action2 _ (CompletionsRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState CompletionsRequest called. " ++ show req SU.completionsRequest req +-- | +-- default nop. +-- +instance StateActivityIF GHCiRunStateData HdaInternalTransitRequest -- | --- Any errors should be critical. don't catch anything here. +-- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState HdaInternalTerminateRequest where - action (GHCiRun_InternalTerminate req) = do +instance StateActivityIF GHCiRunStateData HdaInternalTerminateRequest where + action2 _ (InternalTerminateRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState InternalTerminateRequest called. " ++ show req SU.internalTerminateRequest return $ Just GHCiRun_Shutdown - -- | +-- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState HdaInternalLoadRequest where - action (GHCiRun_InternalLoad req) = do - liftIO $ L.debugM _LOG_APP $ "GHCiRunState InternalLoadRequest called. " ++ show req - SU.loadHsFile $ pathHdaInternalLoadRequest req - return $ Just GHCiRun_Contaminated +instance StateActivityIF GHCiRunStateData HdaInternalLoadRequest where + action2 _ (InternalLoadRequest req) = do + liftIO $ L.debugM _LOG_APP $ "GHCiRunState InternalTerminateRequest called. " ++ show req + SU.internalTerminateRequest + return $ Just GHCiRun_Shutdown + diff --git a/src/Haskell/Debug/Adapter/State/GHCiRun/ConfigurationDone.hs b/src/Haskell/Debug/Adapter/State/GHCiRun/ConfigurationDone.hs --- a/src/Haskell/Debug/Adapter/State/GHCiRun/ConfigurationDone.hs +++ b/src/Haskell/Debug/Adapter/State/GHCiRun/ConfigurationDone.hs @@ -15,10 +15,10 @@ import qualified Haskell.Debug.Adapter.Utility as U -- | --- Any errors should be critical. don't catch anything here. +-- Any errors should be sent back as False result Response -- -instance StateRequestIF GHCiRunState DAP.ConfigurationDoneRequest where - action (GHCiRun_ConfigurationDone req) = do +instance StateActivityIF GHCiRunStateData DAP.ConfigurationDoneRequest where + action2 _ (ConfigurationDoneRequest req) = do liftIO $ L.debugM _LOG_APP $ "GHCiRunState ConfigurationDoneRequest called. " ++ show req app req @@ -40,7 +40,7 @@ } U.addResponse $ ConfigurationDoneResponse res - + -- launch response must be sent after configuration done response. reqSeq <- view launchReqSeqAppStores <$> get resSeq <- U.getIncreasedResponseSequence diff --git a/src/Haskell/Debug/Adapter/State/Init.hs b/src/Haskell/Debug/Adapter/State/Init.hs --- a/src/Haskell/Debug/Adapter/State/Init.hs +++ b/src/Haskell/Debug/Adapter/State/Init.hs @@ -6,17 +6,17 @@ import Control.Monad.IO.Class import Control.Monad.Except import qualified System.Log.Logger as L +import qualified Haskell.DAP as DAP import Haskell.Debug.Adapter.Type import Haskell.Debug.Adapter.Constant import Haskell.Debug.Adapter.State.Init.Initialize() import Haskell.Debug.Adapter.State.Init.Launch() -import qualified Haskell.Debug.Adapter.State.Utility as SU --- | +-- | -- -instance AppStateIF InitState where +instance AppStateIF InitStateData where -- | -- entryAction InitState = do @@ -29,28 +29,123 @@ liftIO $ L.debugM _LOG_APP "InitState exitAction called." return () - -- | + -- | -- - getStateRequest InitState (WrapRequest (InitializeRequest req)) = return . WrapStateRequest $ Init_Initialize req - getStateRequest InitState (WrapRequest (LaunchRequest req)) = return . WrapStateRequest $ Init_Launch req - getStateRequest InitState (WrapRequest (DisconnectRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (PauseRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (TerminateRequest req)) = SU.unsupported $ show req - - getStateRequest InitState (WrapRequest (SetBreakpointsRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (SetFunctionBreakpointsRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (SetExceptionBreakpointsRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (ConfigurationDoneRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (ThreadsRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (StackTraceRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (ScopesRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (VariablesRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (ContinueRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (NextRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (StepInRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (EvaluateRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (CompletionsRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (InternalTransitRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (InternalTerminateRequest req)) = SU.unsupported $ show req - getStateRequest InitState (WrapRequest (InternalLoadRequest req)) = SU.unsupported $ show req + doActivity s (WrapRequest r@InitializeRequest{}) = action2 s r + doActivity s (WrapRequest r@LaunchRequest{}) = action2 s r + doActivity s (WrapRequest r@DisconnectRequest{}) = action2 s r + doActivity s (WrapRequest r@PauseRequest{}) = action2 s r + doActivity s (WrapRequest r@TerminateRequest{}) = action2 s r + doActivity s (WrapRequest r@SetBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@SetFunctionBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@SetExceptionBreakpointsRequest{}) = action2 s r + doActivity s (WrapRequest r@ConfigurationDoneRequest{}) = action2 s r + doActivity s (WrapRequest r@ThreadsRequest{}) = action2 s r + doActivity s (WrapRequest r@StackTraceRequest{}) = action2 s r + doActivity s (WrapRequest r@ScopesRequest{}) = action2 s r + doActivity s (WrapRequest r@VariablesRequest{}) = action2 s r + doActivity s (WrapRequest r@ContinueRequest{}) = action2 s r + doActivity s (WrapRequest r@NextRequest{}) = action2 s r + doActivity s (WrapRequest r@StepInRequest{}) = action2 s r + doActivity s (WrapRequest r@EvaluateRequest{}) = action2 s r + doActivity s (WrapRequest r@CompletionsRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalTransitRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalTerminateRequest{}) = action2 s r + doActivity s (WrapRequest r@InternalLoadRequest{}) = action2 s r + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.DisconnectRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.PauseRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.TerminateRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.SetBreakpointsRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.SetFunctionBreakpointsRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.SetExceptionBreakpointsRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.ConfigurationDoneRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.ThreadsRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.StackTraceRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.ScopesRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.VariablesRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.ContinueRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.NextRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.StepInRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.EvaluateRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData DAP.CompletionsRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData HdaInternalTransitRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData HdaInternalTerminateRequest + +-- | +-- default nop. +-- +instance StateActivityIF InitStateData HdaInternalLoadRequest + diff --git a/src/Haskell/Debug/Adapter/State/Init/Initialize.hs b/src/Haskell/Debug/Adapter/State/Init/Initialize.hs --- a/src/Haskell/Debug/Adapter/State/Init/Initialize.hs +++ b/src/Haskell/Debug/Adapter/State/Init/Initialize.hs @@ -12,11 +12,13 @@ import qualified Haskell.Debug.Adapter.Utility as U import Haskell.Debug.Adapter.Utility + + -- | -- Any errors should be critical. don't catch anything here. -- -instance StateRequestIF InitState DAP.InitializeRequest where - action (Init_Initialize req) = do +instance StateActivityIF InitStateData DAP.InitializeRequest where + action2 _ (InitializeRequest req) = do liftIO $ L.debugM _LOG_APP $ "InitState InitializeRequest called. " ++ show req app req diff --git a/src/Haskell/Debug/Adapter/State/Init/Launch.hs b/src/Haskell/Debug/Adapter/State/Init/Launch.hs --- a/src/Haskell/Debug/Adapter/State/Init/Launch.hs +++ b/src/Haskell/Debug/Adapter/State/Init/Launch.hs @@ -26,22 +26,22 @@ import qualified Haskell.Debug.Adapter.Logger as L import qualified Haskell.Debug.Adapter.GHCi as P + -- | -- Any errors should be critical. don't catch anything here. -- -instance StateRequestIF InitState DAP.LaunchRequest where - action (Init_Launch req) = do +instance StateActivityIF InitStateData DAP.LaunchRequest where + action2 _ (LaunchRequest req) = do liftIO $ L.debugM _LOG_APP $ "InitState LaunchRequest called. " ++ show req app req - -- | -- @see https://github.com/Microsoft/vscode/issues/4902 -- @see https://microsoft.github.io/debug-adapter-protocol/overview --- +-- app :: DAP.LaunchRequest -> AppContext (Maybe StateTransit) app req = flip catchError errHdl $ do - + setUpConfig req setUpLogger req createTasksJsonFile @@ -66,7 +66,7 @@ -- ConfigurationDone request. initSeq <- U.getIncreasedResponseSequence U.addResponse $ InitializedEvent $ DAP.defaultInitializedEvent {DAP.seqInitializedEvent = initSeq} - + return $ Just Init_GHCiRun where @@ -93,7 +93,7 @@ setUpConfig req = do let args = DAP.argumentsLaunchRequest req appStores <- get - + let wsMVar = appStores^.workspaceAppStores ws = DAP.workspaceLaunchRequestArguments args _ <- liftIO $ takeMVar wsMVar @@ -154,13 +154,13 @@ -- checkDir jsonDir = liftIO (doesDirectoryExist jsonDir) >>= \case False -> throwError $ "setting folder not found. skip saveing tasks.json. DIR:" ++ jsonDir - True -> return () + True -> return () -- | -- checkFile jsonFile = liftIO (doesFileExist jsonFile) >>= \case True -> throwError $ "tasks.json file exists. " ++ jsonFile - False -> return () + False -> return () -- | -- @@ -179,7 +179,7 @@ cmdStr = DAP.ghciCmdLaunchRequestArguments args cmdList = filter (not.null) $ U.split " " cmdStr cmd = head cmdList - + U.debugEV _LOG_APP $ show cmdList opts <- addWithGHC (tail cmdList) diff --git a/src/Haskell/Debug/Adapter/State/Shutdown.hs b/src/Haskell/Debug/Adapter/State/Shutdown.hs --- a/src/Haskell/Debug/Adapter/State/Shutdown.hs +++ b/src/Haskell/Debug/Adapter/State/Shutdown.hs @@ -12,9 +12,9 @@ import Haskell.Debug.Adapter.Constant --- | +-- | -- -instance AppStateIF ShutdownState where +instance AppStateIF ShutdownStateData where -- | -- entryAction ShutdownState = do @@ -24,7 +24,7 @@ return () - + -- | -- exitAction ShutdownState = do @@ -32,10 +32,10 @@ throwError msg - -- | + -- | -- - getStateRequest ShutdownState _ = do + doActivity ShutdownState _ = do let msg = "ShutdownState does not support any request." - throwError msg - + infoEV _LOG_APP msg + return Nothing diff --git a/src/Haskell/Debug/Adapter/State/Utility.hs b/src/Haskell/Debug/Adapter/State/Utility.hs --- a/src/Haskell/Debug/Adapter/State/Utility.hs +++ b/src/Haskell/Debug/Adapter/State/Utility.hs @@ -17,14 +17,6 @@ import qualified Haskell.Debug.Adapter.GHCi as P --- | --- -unsupported :: String -> AppContext WrapStateRequest -unsupported reqStr = do - let msg = "InitState does not support this request. " ++ reqStr - throwError msg - - -- | -- setBreakpointsRequest :: DAP.SetBreakpointsRequest -> AppContext (Maybe StateTransit) @@ -39,7 +31,7 @@ P.expectH $ P.funcCallBk lineCallBk return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s @@ -102,13 +94,13 @@ U.addResponse $ SetExceptionBreakpointsResponse res return Nothing - + where getOptions filters | null filters = ["-fno-break-on-exception", "-fno-break-on-error"] | filters == ["break-on-error"] = ["-fno-break-on-exception", "-fbreak-on-error"] | filters == ["break-on-exception"] = ["-fbreak-on-exception", "-fno-break-on-error"] - | otherwise = ["-fbreak-on-exception", "-fbreak-on-error" ] + | otherwise = ["-fbreak-on-exception", "-fbreak-on-error" ] go opt = do let cmd = ":set " ++ opt @@ -132,7 +124,7 @@ P.expectH $ P.funcCallBk lineCallBk return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s @@ -203,7 +195,7 @@ P.expectH $ P.funcCallBk lineCallBk return Nothing - + where lineCallBk :: Bool -> String -> AppContext () lineCallBk True s = U.sendStdoutEvent s @@ -276,7 +268,7 @@ U.addResponse $ CompletionsResponse res return Nothing - + where -- | -- diff --git a/src/Haskell/Debug/Adapter/Type.hs b/src/Haskell/Debug/Adapter/Type.hs --- a/src/Haskell/Debug/Adapter/Type.hs +++ b/src/Haskell/Debug/Adapter/Type.hs @@ -2,10 +2,10 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} module Haskell.Debug.Adapter.Type where - import Data.Default import Control.Lens import Data.Aeson @@ -17,12 +17,12 @@ import qualified System.IO as S import qualified Data.Text as T import qualified System.Log.Logger as L ---import qualified Data.ByteString as B import qualified System.Process as S import qualified Data.Version as V import qualified Haskell.DAP as DAP import Haskell.Debug.Adapter.TH.Utility +import Haskell.Debug.Adapter.Constant -------------------------------------------------------------------------------- instance FromJSON L.Priority where @@ -38,10 +38,10 @@ toJSON (L.CRITICAL) = String $ T.pack "CRITICAL" toJSON (L.ALERT) = String $ T.pack "ALERT" toJSON (L.EMERGENCY) = String $ T.pack "EMERGENCY" - + -------------------------------------------------------------------------------- -- | Config Data --- +-- data ConfigData = ConfigData { _workDirConfigData :: FilePath , _logFileConfigData :: FilePath @@ -53,7 +53,7 @@ instance Default ConfigData where def = ConfigData { _workDirConfigData = "." - , _logFileConfigData = "haskell-debug-adapter.log" + , _logFileConfigData = "haskell-debug-adapter.log" , _logLevelConfigData = L.WARNING } @@ -84,7 +84,7 @@ } deriving (Show, Read, Eq) $(deriveJSON defaultOptions { fieldLabelModifier = fieldModifier "HdaInternalTransitRequest" } ''HdaInternalTransitRequest) - + data HdaInternalTerminateRequest = HdaInternalTerminateRequest { msgHdaInternalTerminateRequest :: String } deriving (Show, Read, Eq) @@ -99,7 +99,7 @@ -------------------------------------------------------------------------------- -- | DAP Request Data --- +-- $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "Source"} ''DAP.Source) @@ -171,7 +171,7 @@ -- request -data Request a where +data Request a where InitializeRequest :: DAP.InitializeRequest -> Request DAP.InitializeRequest LaunchRequest :: DAP.LaunchRequest -> Request DAP.LaunchRequest DisconnectRequest :: DAP.DisconnectRequest -> Request DAP.DisconnectRequest @@ -194,11 +194,13 @@ InternalTerminateRequest :: HdaInternalTerminateRequest -> Request HdaInternalTerminateRequest InternalLoadRequest :: HdaInternalLoadRequest -> Request HdaInternalLoadRequest +deriving instance Show r => Show (Request r) + data WrapRequest = forall a. WrapRequest (Request a) -------------------------------------------------------------------------------- -- | DAP Response Data --- +-- -- jsonize $(deriveJSON defaultOptions {fieldLabelModifier = rdrop "Response"} ''DAP.Response) @@ -269,7 +271,7 @@ -- response -data Response = +data Response = InitializeResponse DAP.InitializeResponse | LaunchResponse DAP.LaunchResponse | OutputEvent DAP.OutputEvent @@ -300,160 +302,59 @@ -------------------------------------------------------------------------------- -- | State --- -data InitState -data GHCiRunState -data DebugRunState -data ContaminatedState -data ShutdownState +-- +data InitStateData = InitStateData deriving (Show, Eq) +data GHCiRunStateData = GHCiRunStateData deriving (Show, Eq) +data DebugRunStateData = DebugRunStateData deriving (Show, Eq) +data ContaminatedStateData = ContaminatedStateData deriving (Show, Eq) +data ShutdownStateData = ShutdownStateData deriving (Show, Eq) data AppState s where - InitState :: AppState InitState - GHCiRunState :: AppState GHCiRunState - DebugRunState :: AppState DebugRunState - ShutdownState :: AppState ShutdownState - ContaminatedState :: AppState ContaminatedState + InitState :: AppState InitStateData + GHCiRunState :: AppState GHCiRunStateData + DebugRunState :: AppState DebugRunStateData + ShutdownState :: AppState ShutdownStateData + ContaminatedState :: AppState ContaminatedStateData +deriving instance Show s => Show (AppState s) + class AppStateIF s where entryAction :: (AppState s) -> AppContext () exitAction :: (AppState s) -> AppContext () - getStateRequest :: (AppState s) -> WrapRequest -> AppContext WrapStateRequest + doActivity :: (AppState s) -> WrapRequest -> AppContext (Maybe StateTransit) -data WrapAppState = forall s. (AppStateIF s) => WrapAppState (AppState s) +data WrapAppState = forall s. (AppStateIF s) => WrapAppState (AppState s) class WrapAppStateIF s where entryActionW :: s -> AppContext () exitActionW :: s -> AppContext () - getStateRequestW :: s -> WrapRequest -> AppContext WrapStateRequest + doActivityW :: s -> WrapRequest -> AppContext (Maybe StateTransit) instance WrapAppStateIF WrapAppState where entryActionW (WrapAppState s) = entryAction s exitActionW (WrapAppState s) = exitAction s - getStateRequestW (WrapAppState s) r = getStateRequest s r - - --------------------------------------------------------------------------------------- - -data StateRequest s r where - Init_Initialize :: DAP.InitializeRequest -> StateRequest InitState DAP.InitializeRequest - Init_Launch :: DAP.LaunchRequest -> StateRequest InitState DAP.LaunchRequest - Init_Terminate :: DAP.TerminateRequest -> StateRequest InitState DAP.TerminateRequest - Init_SetBreakpoints :: DAP.SetBreakpointsRequest -> StateRequest InitState DAP.SetBreakpointsRequest - Init_SetFunctionBreakpoints :: DAP.SetFunctionBreakpointsRequest -> StateRequest InitState DAP.SetFunctionBreakpointsRequest - Init_SetExceptionBreakpoints :: DAP.SetExceptionBreakpointsRequest -> StateRequest InitState DAP.SetExceptionBreakpointsRequest - Init_ConfigurationDone :: DAP.ConfigurationDoneRequest -> StateRequest InitState DAP.ConfigurationDoneRequest - Init_Threads :: DAP.ThreadsRequest -> StateRequest InitState DAP.ThreadsRequest - Init_StackTrace :: DAP.StackTraceRequest -> StateRequest InitState DAP.StackTraceRequest - Init_Scopes :: DAP.ScopesRequest -> StateRequest InitState DAP.ScopesRequest - Init_Variables :: DAP.VariablesRequest -> StateRequest InitState DAP.VariablesRequest - Init_Continue :: DAP.ContinueRequest -> StateRequest InitState DAP.ContinueRequest - Init_Next :: DAP.NextRequest -> StateRequest InitState DAP.NextRequest - Init_StepIn :: DAP.StepInRequest -> StateRequest InitState DAP.StepInRequest - Init_Evaluate :: DAP.EvaluateRequest -> StateRequest InitState DAP.EvaluateRequest - Init_Completions :: DAP.CompletionsRequest -> StateRequest InitState DAP.CompletionsRequest - Init_InternalTerminate :: HdaInternalTerminateRequest -> StateRequest InitState HdaInternalTerminateRequest - Init_InternalLoad :: HdaInternalLoadRequest -> StateRequest InitState HdaInternalLoadRequest - - GHCiRun_Initialize :: DAP.InitializeRequest -> StateRequest GHCiRunState DAP.InitializeRequest - GHCiRun_Launch :: DAP.LaunchRequest -> StateRequest GHCiRunState DAP.LaunchRequest - GHCiRun_Terminate :: DAP.TerminateRequest -> StateRequest GHCiRunState DAP.TerminateRequest - GHCiRun_SetBreakpoints :: DAP.SetBreakpointsRequest -> StateRequest GHCiRunState DAP.SetBreakpointsRequest - GHCiRun_SetFunctionBreakpoints :: DAP.SetFunctionBreakpointsRequest -> StateRequest GHCiRunState DAP.SetFunctionBreakpointsRequest - GHCiRun_SetExceptionBreakpoints :: DAP.SetExceptionBreakpointsRequest -> StateRequest GHCiRunState DAP.SetExceptionBreakpointsRequest - GHCiRun_ConfigurationDone :: DAP.ConfigurationDoneRequest -> StateRequest GHCiRunState DAP.ConfigurationDoneRequest - GHCiRun_Threads :: DAP.ThreadsRequest -> StateRequest GHCiRunState DAP.ThreadsRequest - GHCiRun_StackTrace :: DAP.StackTraceRequest -> StateRequest GHCiRunState DAP.StackTraceRequest - GHCiRun_Scopes :: DAP.ScopesRequest -> StateRequest GHCiRunState DAP.ScopesRequest - GHCiRun_Variables :: DAP.VariablesRequest -> StateRequest GHCiRunState DAP.VariablesRequest - GHCiRun_Continue :: DAP.ContinueRequest -> StateRequest GHCiRunState DAP.ContinueRequest - GHCiRun_Next :: DAP.NextRequest -> StateRequest GHCiRunState DAP.NextRequest - GHCiRun_StepIn :: DAP.StepInRequest -> StateRequest GHCiRunState DAP.StepInRequest - GHCiRun_Evaluate :: DAP.EvaluateRequest -> StateRequest GHCiRunState DAP.EvaluateRequest - GHCiRun_Completions :: DAP.CompletionsRequest -> StateRequest GHCiRunState DAP.CompletionsRequest - GHCiRun_InternalTerminate :: HdaInternalTerminateRequest -> StateRequest GHCiRunState HdaInternalTerminateRequest - GHCiRun_InternalLoad :: HdaInternalLoadRequest -> StateRequest GHCiRunState HdaInternalLoadRequest - - DebugRun_Initialize :: DAP.InitializeRequest -> StateRequest DebugRunState DAP.InitializeRequest - DebugRun_Launch :: DAP.LaunchRequest -> StateRequest DebugRunState DAP.LaunchRequest - DebugRun_Terminate :: DAP.TerminateRequest -> StateRequest DebugRunState DAP.TerminateRequest - DebugRun_SetBreakpoints :: DAP.SetBreakpointsRequest -> StateRequest DebugRunState DAP.SetBreakpointsRequest - DebugRun_SetFunctionBreakpoints :: DAP.SetFunctionBreakpointsRequest -> StateRequest DebugRunState DAP.SetFunctionBreakpointsRequest - DebugRun_SetExceptionBreakpoints :: DAP.SetExceptionBreakpointsRequest -> StateRequest DebugRunState DAP.SetExceptionBreakpointsRequest - DebugRun_ConfigurationDone :: DAP.ConfigurationDoneRequest -> StateRequest DebugRunState DAP.ConfigurationDoneRequest - DebugRun_Threads :: DAP.ThreadsRequest -> StateRequest DebugRunState DAP.ThreadsRequest - DebugRun_StackTrace :: DAP.StackTraceRequest -> StateRequest DebugRunState DAP.StackTraceRequest - DebugRun_Scopes :: DAP.ScopesRequest -> StateRequest DebugRunState DAP.ScopesRequest - DebugRun_Variables :: DAP.VariablesRequest -> StateRequest DebugRunState DAP.VariablesRequest - DebugRun_Continue :: DAP.ContinueRequest -> StateRequest DebugRunState DAP.ContinueRequest - DebugRun_Next :: DAP.NextRequest -> StateRequest DebugRunState DAP.NextRequest - DebugRun_StepIn :: DAP.StepInRequest -> StateRequest DebugRunState DAP.StepInRequest - DebugRun_Evaluate :: DAP.EvaluateRequest -> StateRequest DebugRunState DAP.EvaluateRequest - DebugRun_Completions :: DAP.CompletionsRequest -> StateRequest DebugRunState DAP.CompletionsRequest - DebugRun_InternalTerminate :: HdaInternalTerminateRequest -> StateRequest DebugRunState HdaInternalTerminateRequest - DebugRun_InternalLoad :: HdaInternalLoadRequest -> StateRequest DebugRunState HdaInternalLoadRequest - - Shutdown_Initialize :: DAP.InitializeRequest -> StateRequest ShutdownState DAP.InitializeRequest - Shutdown_Launch :: DAP.LaunchRequest -> StateRequest ShutdownState DAP.LaunchRequest - Shutdown_Terminate :: DAP.TerminateRequest -> StateRequest ShutdownState DAP.TerminateRequest - Shutdown_SetBreakpoints :: DAP.SetBreakpointsRequest -> StateRequest ShutdownState DAP.SetBreakpointsRequest - Shutdown_SetFunctionBreakpoints :: DAP.SetFunctionBreakpointsRequest -> StateRequest ShutdownState DAP.SetFunctionBreakpointsRequest - Shutdown_SetExceptionBreakpoints :: DAP.SetExceptionBreakpointsRequest -> StateRequest ShutdownState DAP.SetExceptionBreakpointsRequest - Shutdown_ConfigurationDone :: DAP.ConfigurationDoneRequest -> StateRequest ShutdownState DAP.ConfigurationDoneRequest - Shutdown_Threads :: DAP.ThreadsRequest -> StateRequest ShutdownState DAP.ThreadsRequest - Shutdown_StackTrace :: DAP.StackTraceRequest -> StateRequest ShutdownState DAP.StackTraceRequest - Shutdown_Scopes :: DAP.ScopesRequest -> StateRequest ShutdownState DAP.ScopesRequest - Shutdown_Variables :: DAP.VariablesRequest -> StateRequest ShutdownState DAP.VariablesRequest - Shutdown_Continue :: DAP.ContinueRequest -> StateRequest ShutdownState DAP.ContinueRequest - Shutdown_Next :: DAP.NextRequest -> StateRequest ShutdownState DAP.NextRequest - Shutdown_StepIn :: DAP.StepInRequest -> StateRequest ShutdownState DAP.StepInRequest - Shutdown_Evaluate :: DAP.EvaluateRequest -> StateRequest ShutdownState DAP.EvaluateRequest - Shutdown_Completions :: DAP.CompletionsRequest -> StateRequest ShutdownState DAP.CompletionsRequest - Shutdown_InternalTerminate :: HdaInternalTerminateRequest -> StateRequest ShutdownState HdaInternalTerminateRequest - Shutdown_InternalLoad :: HdaInternalLoadRequest -> StateRequest ShutdownState HdaInternalLoadRequest - - Contaminated_Initialize :: DAP.InitializeRequest -> StateRequest ContaminatedState DAP.InitializeRequest - Contaminated_Launch :: DAP.LaunchRequest -> StateRequest ContaminatedState DAP.LaunchRequest - Contaminated_Terminate :: DAP.TerminateRequest -> StateRequest ContaminatedState DAP.TerminateRequest - Contaminated_SetBreakpoints :: DAP.SetBreakpointsRequest -> StateRequest ContaminatedState DAP.SetBreakpointsRequest - Contaminated_SetFunctionBreakpoints :: DAP.SetFunctionBreakpointsRequest -> StateRequest ContaminatedState DAP.SetFunctionBreakpointsRequest - Contaminated_SetExceptionBreakpoints :: DAP.SetExceptionBreakpointsRequest -> StateRequest ContaminatedState DAP.SetExceptionBreakpointsRequest - Contaminated_ConfigurationDone :: DAP.ConfigurationDoneRequest -> StateRequest ContaminatedState DAP.ConfigurationDoneRequest - Contaminated_Threads :: DAP.ThreadsRequest -> StateRequest ContaminatedState DAP.ThreadsRequest - Contaminated_StackTrace :: DAP.StackTraceRequest -> StateRequest ContaminatedState DAP.StackTraceRequest - Contaminated_Scopes :: DAP.ScopesRequest -> StateRequest ContaminatedState DAP.ScopesRequest - Contaminated_Variables :: DAP.VariablesRequest -> StateRequest ContaminatedState DAP.VariablesRequest - Contaminated_Continue :: DAP.ContinueRequest -> StateRequest ContaminatedState DAP.ContinueRequest - Contaminated_Next :: DAP.NextRequest -> StateRequest ContaminatedState DAP.NextRequest - Contaminated_StepIn :: DAP.StepInRequest -> StateRequest ContaminatedState DAP.StepInRequest - Contaminated_Evaluate :: DAP.EvaluateRequest -> StateRequest ContaminatedState DAP.EvaluateRequest - Contaminated_Completions :: DAP.CompletionsRequest -> StateRequest ContaminatedState DAP.CompletionsRequest - Contaminated_InternalTerminate :: HdaInternalTerminateRequest -> StateRequest ContaminatedState HdaInternalTerminateRequest - Contaminated_InternalLoad :: HdaInternalLoadRequest -> StateRequest ContaminatedState HdaInternalLoadRequest - -class StateRequestIF s r where - action :: (StateRequest s r) -> AppContext (Maybe StateTransit) - -data WrapStateRequest = forall s r. (StateRequestIF s r) => WrapStateRequest (StateRequest s r) - -class WrapStateRequestIF w where - actionW :: w -> AppContext (Maybe StateTransit) - -instance WrapStateRequestIF WrapStateRequest where - actionW (WrapStateRequest x) = action x - + doActivityW (WrapAppState s) r = doActivity s r +-- | +-- +class (Show s, Show r) => StateActivityIF s r where + action2 :: (AppState s) -> (Request r) -> AppContext (Maybe StateTransit) + --action2 _ _ = return Nothing + action2 s r = do + liftIO $ L.warningM _LOG_APP $ show s ++ " " ++ show r ++ " not supported. nop." + return Nothing -------------------------------------------------------------------------------- -- | Event --- +-- data Event = CriticalExitEvent deriving (Show, Read, Eq) -------------------------------------------------------------------------------- --- | --- +-- | +-- data GHCiProc = GHCiProc { _wHdLGHCiProc :: S.Handle , _rHdlGHCiProc :: S.Handle @@ -464,14 +365,14 @@ -------------------------------------------------------------------------------- -- | Application Context --- - +-- + type ErrMsg = String -type AppContext = StateT AppStores (ExceptT ErrMsg IO) +type AppContext = StateT AppStores (ExceptT ErrMsg IO) -- | Application Context Data --- +-- data AppStores = AppStores { -- Read Only _appNameAppStores :: String @@ -501,7 +402,7 @@ , _ghciProcAppStores :: MVar GHCiProc --, _ghciStdoutAppStores :: MVar B.ByteString , _ghciVerAppStores :: MVar V.Version - } + } makeLenses ''AppStores makeLenses ''GHCiProc