{-# LANGUAGE LambdaCase, DataKinds, TypeFamilies #-}

-- | Higher-level interface to evaluating things in the (possibly remote) debuggee process
module GHC.Debugger.Runtime.Eval
  (
    -- * Raw evaluation
    evalExpr, evalString

    -- ** Error handling
  , handleSingStatus
  , BadEvalStatus(..)

    -- ** Re-exports
  , EvalExpr(..)
  ) where

import GHC
import GHCi.RemoteTypes
import GHCi.Message
import Control.Exception
import GHC.Driver.Env
import GHC.Driver.Config
import Control.Monad.IO.Class
import qualified GHC.Runtime.Interpreter as Interp

import GHC.Debugger.Monad

-- * Evaluating things on debuggee ---------------------------------------------

-- | Evaluate a raw 'EvalExpr' which represents a debuggee expression of type @IO [a]@
evalExpr :: EvalExpr ForeignHValue -> Debugger (Either BadEvalStatus [ForeignHValue])
evalExpr :: EvalExpr ForeignHValue
-> Debugger (Either BadEvalStatus [ForeignHValue])
evalExpr EvalExpr ForeignHValue
eval_expr = do
  hsc_env <- Debugger HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  let eval_opts = DynFlags -> EvalStep -> EvalOpts
initEvalOpts (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) EvalStep
EvalStepNone
  handleMultiStatus <$>
    liftIO (Interp.evalStmt (hscInterp hsc_env) eval_opts eval_expr)

-- | Evaluate a foreign value of type @IO String@ to a @String@
evalString :: ForeignRef (IO String) -> Debugger String
evalString :: ForeignRef (IO String) -> Debugger String
evalString ForeignRef (IO String)
string_fhv = do
  hsc_env <- Debugger HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  liftIO $
    Interp.evalString (hscInterp hsc_env) (castForeignRef string_fhv)

-- ** Handling evaluation results ----------------------------------------------

-- | Handle the 'EvalStatus_' of an evaluation using 'EvalStepNone' which returns a single value
handleSingStatus :: Either BadEvalStatus [ForeignHValue] -> Either BadEvalStatus ForeignHValue
handleSingStatus :: Either BadEvalStatus [ForeignHValue]
-> Either BadEvalStatus ForeignHValue
handleSingStatus Either BadEvalStatus [ForeignHValue]
status =
  case Either BadEvalStatus [ForeignHValue]
status of
    Right [ForeignHValue
sing]  -> ForeignHValue -> Either BadEvalStatus ForeignHValue
forall a b. b -> Either a b
Right ForeignHValue
sing
    Right []      -> BadEvalStatus -> Either BadEvalStatus ForeignHValue
forall a b. a -> Either a b
Left BadEvalStatus
EvalReturnedNoResults
    Right (ForeignHValue
_:ForeignHValue
_:[ForeignHValue]
_) -> BadEvalStatus -> Either BadEvalStatus ForeignHValue
forall a b. a -> Either a b
Left BadEvalStatus
EvalReturnedTooManyResults
    Left BadEvalStatus
e -> BadEvalStatus -> Either BadEvalStatus ForeignHValue
forall a b. a -> Either a b
Left BadEvalStatus
e

-- | Handle the 'EvalStatus_' of an evaluation using 'EvalStepNone' which returns a list of values
handleMultiStatus :: EvalStatus_ [ForeignHValue] [HValueRef] -> Either BadEvalStatus [ForeignHValue]
handleMultiStatus :: EvalStatus_ [ForeignHValue] [HValueRef]
-> Either BadEvalStatus [ForeignHValue]
handleMultiStatus EvalStatus_ [ForeignHValue] [HValueRef]
status =
  case EvalStatus_ [ForeignHValue] [HValueRef]
status of
    EvalComplete Word64
_ (EvalSuccess [ForeignHValue]
res) -> [ForeignHValue] -> Either BadEvalStatus [ForeignHValue]
forall a b. b -> Either a b
Right [ForeignHValue]
res
    EvalComplete Word64
_ (EvalException SerializableException
e) ->
      BadEvalStatus -> Either BadEvalStatus [ForeignHValue]
forall a b. a -> Either a b
Left (SomeException -> BadEvalStatus
EvalRaisedException (SerializableException -> SomeException
fromSerializableException SerializableException
e))
    EvalBreak {} ->
      --TODO: Could we accidentally hit this if we set a breakpoint regardless of whether EvalStep=None? perhaps.
      BadEvalStatus -> Either BadEvalStatus [ForeignHValue]
forall a b. a -> Either a b
Left BadEvalStatus
EvalHitUnexpectedBreakpoint

--------------------------------------------------------------------------------
-- * Exceptions
--------------------------------------------------------------------------------

data BadEvalStatus
  = EvalRaisedException SomeException
  | EvalHitUnexpectedBreakpoint
  | EvalReturnedNoResults
  | EvalReturnedTooManyResults
  deriving Int -> BadEvalStatus -> ShowS
[BadEvalStatus] -> ShowS
BadEvalStatus -> String
(Int -> BadEvalStatus -> ShowS)
-> (BadEvalStatus -> String)
-> ([BadEvalStatus] -> ShowS)
-> Show BadEvalStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BadEvalStatus -> ShowS
showsPrec :: Int -> BadEvalStatus -> ShowS
$cshow :: BadEvalStatus -> String
show :: BadEvalStatus -> String
$cshowList :: [BadEvalStatus] -> ShowS
showList :: [BadEvalStatus] -> ShowS
Show

instance Exception BadEvalStatus