module GDBMI (
GDB,
attach,
detach,
runCommand,
GDBCommand(..),
MIOutput(..),
MIOOB(..),
MIResult(..),
MIKeyVal,
MIValue(..),
parse
) where
import System.IO
import System.Posix.IO (createPipe, fdToHandle)
import System.Posix.Types (ProcessID)
import System.Process (runProcess, ProcessHandle)
import Text.ParserCombinators.Parsec hiding (parse)
import qualified Text.ParserCombinators.Parsec as Parsec (parse)
data GDB = GDB {
gdbPid :: ProcessHandle,
gdbCommand :: Handle,
gdbResponse :: Handle
}
data GDBCommand = CLICommand String
| MICommand String
data MIOutput = MIOutput [MIOOB] (Maybe MIResult) deriving Show
data MIOOB =
MIStatus String
| MIExec String
| MINotify String
| MIConsole String
| MITarget String
| MILog String
deriving (Eq, Show)
data MIResult =
MIDone [MIKeyVal]
| MIError String
deriving (Eq, Show)
type MIKeyVal = (String, MIValue)
data MIValue =
MIString String
| MITuple [MIKeyVal]
deriving (Eq, Show)
attach :: Maybe FilePath
-> ProcessID
-> IO (Either String (GDB, MIOutput))
attach workdir pid = do
(commandR, commandW) <- createPipe >>= asHandles
(responseR, responseW) <- createPipe >>= asHandles
phandle <- runProcess "gdb" ["--interpreter", "mi", "-p", show pid]
workdir Nothing
(Just commandR)
(Just responseW)
Nothing
mapM_ (`hSetBuffering` LineBuffering) [commandW, responseR]
let gdb = GDB phandle commandW responseR
resp <- readResponse gdb
case resp of
Left err -> return $ Left err
Right ok -> return $ Right (gdb, ok)
where
asHandles (f1, f2) = do
h1 <- fdToHandle f1; h2 <- fdToHandle f2; return (h1, h2)
detach :: GDB -> IO ()
detach gdb = hPutStrLn (gdbCommand gdb) "-gdb-exit"
runCommand :: GDBCommand -> GDB -> IO (Either String MIOutput)
runCommand cmd gdb = do
hPutStrLn (gdbCommand gdb) (cmdStr cmd)
readResponse gdb
where
cmdStr (CLICommand str) = str
cmdStr (MICommand str) = '-' : str
readResponse :: GDB -> IO (Either String MIOutput)
readResponse gdb = do
resp <- readResponseLines
case parse "output" (unlines resp) of
Left err -> return $ Left (show err)
Right out -> return $ Right out
where
readResponseLines :: IO [String]
readResponseLines = do
line <- hGetLine (gdbResponse gdb)
if line == "(gdb) "
then return []
else do rest <- readResponseLines
return (line:rest)
p_output = do
oob <- p_oob `sepEndBy` newline
res <- optionMaybe p_result
eof
return $ MIOutput oob res
p_oob = p_console <|> p_log
p_console = do char '~'; str <- p_cstring; return $ MIConsole str
p_log = do char '&'; str <- p_cstring; return $ MILog str
p_result = do
char '^'
res <- p_done <|> p_error
newline; return res
where
p_done = do
string "done"
res <- (do char ','; p_keyval `sepBy` char ',') <|> return []
return $ MIDone res
p_error = do
string "error"
char ','
string "msg="
err <- p_cstring
return $ MIError err
p_keyval = do var <- p_var; char '='; val <- p_val; return $ (var, val) where
p_var = many1 (letter <|> char '-')
p_val = p_const <|> p_tuple
p_const = do str <- p_cstring; return $ MIString str
p_tuple = do
vals <- tuplewrap $ p_keyval `sepBy` char ','
return $ MITuple vals
tuplewrap p = between (char '{') (char '}') p
<|> between (char '[') (char ']') p
p_cstring = between (char '"') (char '"') (many p_cchar) where
p_cchar = p_cbackslash
<|> noneOf "\""
p_cbackslash = do
char '\\'
c <- anyChar
case c of
'\\' -> return '\\'
'n' -> return '\n'
'"' -> return '"'
_ -> fail $ "unknown backslash escape: " ++ show c
parse = Parsec.parse p_output