summaryrefslogtreecommitdiff
path: root/src/GDB.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-01-25 20:23:28 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2023-01-25 20:23:28 +0100
commitaa440ae072ca3dffab6fc2efb96b141de9d944dd (patch)
tree9be8beb9beb86c9084a6d2627fa231a02df5756f /src/GDB.hs
parent29b263f350ea7dccb243ec28f6af7fc5c41f578e (diff)
GDB command completion and history
Diffstat (limited to 'src/GDB.hs')
-rw-r--r--src/GDB.hs21
1 files changed, 17 insertions, 4 deletions
diff --git a/src/GDB.hs b/src/GDB.hs
index 3c60457..ad8ff84 100644
--- a/src/GDB.hs
+++ b/src/GDB.hs
@@ -22,6 +22,7 @@ import Data.Void
import Text.Megaparsec hiding (State)
import Text.Megaparsec.Char
+import System.Console.Haskeline.Completion
import System.Process
import Output
@@ -163,10 +164,14 @@ addInferior gdb process = do
gdbCommand gdb $ "-target-attach --thread-group " <> tgid <> " " <> T.pack (show pid)
gdbCommand gdb $ "-exec-continue --thread-group " <> tgid
+gdbCommandRes :: MonadIO m => GDB -> Text -> m (ResultClass, [(Text, MiValue)])
+gdbCommandRes gdb cmd = do
+ send (gdbProcess gdb) cmd
+ liftIO (takeMVar (gdbResult gdb))
+
gdbCommand :: MonadOutput m => GDB -> Text -> m ()
gdbCommand gdb cmd = do
- send (gdbProcess gdb) cmd
- liftIO (takeMVar (gdbResult gdb)) >>= \case
+ gdbCommandRes gdb cmd >>= \case
(Done, _) -> return ()
(Connected, _) -> outProc OutputChildInfo (gdbProcess gdb) "result connected"
(Error, _) -> outProc OutputError (gdbProcess gdb) $ "command error: " <> cmd
@@ -175,13 +180,21 @@ gdbCommand gdb cmd = do
gdbSession :: MonadOutput m => GDB -> m ()
gdbSession gdb = loop ""
where
- loop prev = outPromptGetLine "gdb> " >>= \case
+ loop prev = outPromptGetLineCompletion (gdbCompletion gdb) "gdb> " >>= \case
Just line -> do
let cmd = if T.null line then prev else line
gdbCommand gdb ("-interpreter-exec console \"" <> cmd <> "\"")
loop cmd
Nothing -> return ()
+gdbCompletion :: GDB -> CompletionFunc IO
+gdbCompletion gdb (revcmd, _) = do
+ gdbCommandRes gdb ("-complete " <> T.pack (show (reverse revcmd))) >>= \case
+ (Done, resp)
+ | Just (MiList matches) <- lookup "matches" resp -> do
+ return ("", map (\(MiString m) -> Completion (T.unpack m) (T.unpack m) False) matches)
+ _ -> return ("", [])
+
type MiParser = ParsecT Void MiStream Identity
@@ -199,7 +212,7 @@ miOutputRecord = choice
]
miResultRecord :: MiParser MiRecord
-miResultRecord = char '^' >> ResultRecord <$> resultClass <*> many result
+miResultRecord = char '^' >> ResultRecord <$> resultClass <*> many (char ',' *> result)
miExecAsync, miStatusAsync, miNotifyAsync :: MiParser MiRecord
miExecAsync = char '*' >> ExecAsyncOutput <$> miString <*> many (char ',' *> result)