content: {-# LANGUAGE RecordWildCards, OverloadedRecordDot, DuplicateRecordFields #-}
  module Development.Debug.Adapter.Evaluation where
  
  import qualified Data.Text as T
  import qualified Data.Map as M
  import qualified Data.IntSet as IS
  
  import DAP
  
  import GHC.Debugger.Interface.Messages
  import Development.Debug.Adapter
  import Development.Debug.Adapter.Interface
  import qualified Development.Debug.Adapter.Output as Output
  
  --------------------------------------------------------------------------------
  -- * Executing debuggee
  --------------------------------------------------------------------------------
  
  -- | Start executing from entry point
  --
  -- TODO:
  --  [ ] Consider using Output events for debuggee evaluation.
  startExecution :: DebugAdaptor EvalResult
  startExecution = do
    DAS{entryFile, entryPoint, entryArgs} <- getDebugSession
    let entry
          | entryPoint == "main" = MainEntry Nothing
          | otherwise            = FunctionEntry entryPoint
    DidExec er <- sendSync DebugExecution{entryPoint = entry, entryFile, runArgs = entryArgs}
    return er
  
  --------------------------------------------------------------------------------
  -- * Eval
  --------------------------------------------------------------------------------
  
  -- | Command for evaluation (includes evaluation-on-hover)
  commandEvaluate :: DebugAdaptor ()
  commandEvaluate = do
    EvaluateArguments {..} <- getArguments
    DidEval er <- sendSync (DoEval (T.unpack evaluateArgumentsExpression))
    case er of
      EvalStopped{} -> error "impossible, execution is resumed automatically for 'DoEval'"
      EvalAbortedWith e -> do
        -- Evaluation failed, we report it but don't terminate.
        sendEvaluateResponse EvaluateResponse
          { evaluateResponseResult  = T.pack e
          , evaluateResponseType    = T.pack ""
          , evaluateResponsePresentationHint    = Nothing
          , evaluateResponseVariablesReference  = 0
          , evaluateResponseNamedVariables      = Nothing
          , evaluateResponseIndexedVariables    = Nothing
          , evaluateResponseMemoryReference     = Nothing
          }
      _ -> do
        sendEvaluateResponse EvaluateResponse
          { evaluateResponseResult  = T.pack $ resultVal er
          , evaluateResponseType    = T.pack $ resultType er
          , evaluateResponsePresentationHint    = Nothing
          , evaluateResponseVariablesReference  = 0
          , evaluateResponseNamedVariables      = Nothing
          , evaluateResponseIndexedVariables    = Nothing
          , evaluateResponseMemoryReference     = Nothing
          }
  
  --------------------------------------------------------------------------------
  -- * Utils
  --------------------------------------------------------------------------------
  
  -- | Handle an EvalResult by sending a stopped or exited event.
  --
  -- In particular, the result of evaluation is ignored by this function.
  -- The 'EvaluateRequest' handler inspects the EvalResult itself and reports on the result.
  handleEvalResult :: Bool {-^ Whether we are "stepping" -} -> EvalResult -> DebugAdaptor ()
  handleEvalResult stepping er = case er of
    EvalAbortedWith e -> do
      Output.console (T.pack e)
      sendTerminatedEvent defaultTerminatedEvent
      sendExitedEvent (ExitedEvent 43)
    EvalCompleted{resultVal, resultType} -> do
      Output.console (T.pack $ "Evaluation returned: " ++ resultVal ++ " :: " ++ resultType)
      sendTerminatedEvent defaultTerminatedEvent
      sendExitedEvent (ExitedEvent 0)
    EvalException{resultVal, resultType} -> do
      Output.stderr (T.pack $ "Uncaught exception of type " ++ resultType ++ " was thrown!")
      Output.stderr (T.pack resultVal)
      sendTerminatedEvent defaultTerminatedEvent
      sendExitedEvent (ExitedEvent 42)
    EvalStopped {breakId = Nothing} ->
      sendStoppedEvent
        defaultStoppedEvent {
          stoppedEventAllThreadsStopped = True
        , stoppedEventReason = StoppedEventReasonException
        , stoppedEventHitBreakpointIds = []
        }
    EvalStopped {breakId = Just bid} -> do
      DAS{breakpointMap} <- getDebugSession
      sendStoppedEvent
        defaultStoppedEvent {
          stoppedEventAllThreadsStopped = True
           -- could be more precise here by saying "function breakpoint" rather than always "breakpoint"
        , stoppedEventReason
            = if stepping then StoppedEventReasonStep
                          else StoppedEventReasonBreakpoint
        , stoppedEventHitBreakpointIds
            = maybe [] IS.toList (M.lookup bid breakpointMap)
        }
  
  