module Gdbmi.Semantics
(
response_break_insert,
response_data_evaluate_expression,
response_exec_return,
response_stack_list_frames,
response_error,
notification_stopped,
Breakpoint(..), BreakpointType, BreakpointDisp(..), BkptNumber,
Stack(..), Frame(..), Arg(..),
Stopped(..), StopReason(..)
) where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (guard, msum, (<=<))
import Data.List (find)
import Gdbmi.Representation
type BkptNumber = Int
data Breakpoint = Breakpoint {
bkptNumber :: BkptNumber
, bkptType :: BreakpointType
, bkptDisp :: BreakpointDisp
, bkptEnabled :: Bool
, bkptAddress :: String
, bkptFunc :: String
, bkptFile :: String
, bkptFullname :: String
, bkptLine :: Int
, bkptTimes :: Int
, bkptOriginalLocation :: String
}
deriving Show
type BreakpointType = String
data BreakpointDisp
= BreakpointKeep
| BreakpointDel
deriving Show
instance Read BreakpointDisp where
readsPrec _ "del" = [(BreakpointDel, "")]
readsPrec _ "keep" = [(BreakpointKeep, "")]
readsPrec _ _ = []
newtype Stack
= Stack {stackFrames :: [Frame] }
deriving Show
data Frame = Frame {
frameLevel :: Maybe Int
, frameAddr :: String
, frameFunc :: String
, frameArgs :: Maybe [Arg]
, frameFile :: String
, frameFullname :: Maybe String
, frameLine :: Int
} deriving Show
data Stopped = Stopped {
stoppedReason :: StopReason
, stoppedFrame :: Frame
, stoppedThreadId :: Int
, stoppedThreads :: String
, stoppedCore :: Int
}
deriving Show
data StopReason
= BreakpointHit {
bkptHitDisp :: BreakpointDisp
, bkptHitNumber :: BkptNumber
}
| EndSteppingRange
| FunctionFinished
deriving Show
data Arg = Arg {
argName :: String
, argValue :: String
} deriving Show
responseBreakpoint :: Result -> Maybe Breakpoint
responseBreakpoint (Result variable value) = do
guard (variable == "bkpt")
(Tuple rs) <- asTuple value
Breakpoint
<$> get rs tryRead "number"
<*> get rs Just "type"
<*> get rs tryRead "disp"
<*> get rs gdbBool "enabled"
<*> get rs Just "addr"
<*> get rs Just "func"
<*> get rs Just "file"
<*> get rs Just "fullname"
<*> get rs tryRead "line"
<*> get rs tryRead "times"
<*> get rs Just "original-location"
responseStack :: Result -> Maybe Stack
responseStack (Result variable value) = do
guard (variable == "stack")
list <- asList value
case list of
EmptyList -> Just $ Stack []
ResultList is ->
Stack <$> mapM responseFrame is
_ -> Nothing
responseFrame :: Result -> Maybe Frame
responseFrame (Result variable value) = do
guard (variable == "frame")
(Tuple rs) <- asTuple value
Frame
<$> Just (get rs tryRead "level")
<*> get rs Just "addr"
<*> get rs Just "func"
<*> Just (msum (map responseArgs rs))
<*> get rs Just "file"
<*> Just (get rs Just "fullname")
<*> get rs tryRead "line"
responseStopped :: [Result] -> Maybe Stopped
responseStopped rs = do
Stopped
<$> responseStopReason rs
<*> msum (map responseFrame rs)
<*> get rs tryRead "thread-id"
<*> get rs Just "stopped-threads"
<*> get rs tryRead "core"
responseStopReason :: [Result] -> Maybe StopReason
responseStopReason rs = do
reason <- find (("reason"==) . resVariable) rs >>= asConst . resValue
case reason of
"breakpoint-hit" ->
BreakpointHit
<$> get rs tryRead "disp"
<*> get rs tryRead "bkptno"
"end-stepping-range" -> Just EndSteppingRange
"function-finished" -> Just FunctionFinished
_ -> Nothing
responseArgs :: Result -> Maybe [Arg]
responseArgs (Result variable value) = do
guard (variable == "args")
list <- asList value
case list of
EmptyList -> Just []
ValueList is -> do
mapM ((responseArg . tupleResults) <=< asTuple) is
_ -> Nothing
responseArg :: [Result] -> Maybe Arg
responseArg rs = do
Arg
<$> get rs Just "name"
<*> get rs Just "value"
response_stack_list_frames :: [Result] -> Maybe Stack
response_stack_list_frames [item] = responseStack item
response_stack_list_frames _ = Nothing
response_break_insert :: [Result] -> Maybe Breakpoint
response_break_insert [item] = responseBreakpoint item
response_break_insert _ = Nothing
response_data_evaluate_expression :: [Result] -> Maybe String
response_data_evaluate_expression [(Result variable value)] = do
guard (variable == "value")
asConst value
response_data_evaluate_expression _ = Nothing
response_exec_return :: [Result] -> Maybe Frame
response_exec_return [item] = responseFrame item
response_exec_return _ = Nothing
response_error :: [Result] -> Maybe String
response_error [(Result variable value)] = do
guard (variable == "msg")
asConst value
response_error _ = Nothing
notification_stopped :: [Result] -> Maybe Stopped
notification_stopped items = responseStopped items
get :: [Result] -> (String -> Maybe a) -> (String -> Maybe a)
get rs parse key = find ((key==) . resVariable) rs >>= asConst . resValue >>= parse
tryRead :: Read a => String -> Maybe a
tryRead str = case readsPrec 0 str of
[(x, "")] -> Just x
_ -> Nothing
gdbBool :: String -> Maybe Bool
gdbBool "y" = Just True
gdbBool "n" = Just False
gdbBool _ = Nothing