packages feed

ghc-debug-brick 0.4.0.1 → 0.5.0.0

raw patch · 5 files changed

+37/−6 lines, 5 filesdep ~brickdep ~ghc-debug-clientdep ~ghc-debug-common

Dependency ranges changed: brick, ghc-debug-client, ghc-debug-common, ghc-debug-convention

Files

CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for ghc-debug-brick +## 0.5.0.0 -- 2023-06-06++* Add find closure by info table address+ ## 0.4.0.1 -- 2023-03-09  * Fix snapshot mode
ghc-debug-brick.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                ghc-debug-brick-version:             0.4.0.1+version:             0.5.0.0 synopsis:            A simple TUI using ghc-debug description:         A simple TUI using ghc-debug bug-reports:         https://gitlab.haskell.org/ghc/ghc-debug/-/issues@@ -19,7 +19,7 @@                      , Common                      , Lib   build-depends:       base >=4.16 && <5-                     , brick ^>= 1.3+                     , brick >= 1.3                      , containers                      , directory                      , filepath@@ -29,9 +29,9 @@                      , time                      , deepseq                      , microlens-                     , ghc-debug-client == 0.4.0.1-                     , ghc-debug-common == 0.4.0.0-                     , ghc-debug-convention == 0.4.0.0+                     , ghc-debug-client == 0.5.0.0+                     , ghc-debug-common == 0.5.0.0+                     , ghc-debug-convention == 0.5.0.0                      , unordered-containers                      , exceptions                      , contra-tracer
src/Lib.hs view
@@ -71,6 +71,7 @@   , retainersOfConstructor   , retainersOfAddress   , retainersOfConstructorExact+  , retainersOfInfoTable      -- * Snapshot   , snapshot@@ -254,6 +255,13 @@   run dbg $ do     roots <- GD.gcRoots     stack <- GD.findRetainersOfConstructorExact (Just 100) roots con_name+    traverse (\cs -> zipWith Closure cs <$> (GD.dereferenceClosures cs)) stack++retainersOfInfoTable :: Maybe [ClosurePtr] -> Debuggee -> InfoTablePtr -> IO [[Closure]]+retainersOfInfoTable mroots dbg info_ptr = do+  run dbg $ do+    roots <- maybe GD.gcRoots return mroots+    stack <- GD.findRetainersOfInfoTable (Just 100) roots info_ptr     traverse (\cs -> zipWith Closure cs <$> (GD.dereferenceClosures cs)) stack  -- -- | Request the description for an info table.
src/Main.hs view
@@ -40,6 +40,7 @@ import Data.Maybe import qualified Data.Foldable as F +import GHC.Debug.Types.Ptr(readInfoTablePtr) import IOTree import Lib as GD import Model@@ -618,6 +619,8 @@             (modify $ footerMode .~ footerInput FSearch)   , Command "Find Address" (Vty.EvKey (KChar 'a') [Vty.MCtrl])             (modify $ footerMode .~ footerInput FAddress)+  , Command "Find Info Table" (Vty.EvKey (KChar 'i') [Vty.MCtrl])+            (modify $ footerMode .~ footerInput FInfoTable)   , Command "Write Profile" (Vty.EvKey (KChar 'w') [Vty.MCtrl])             (modify $ footerMode .~ footerInput FProfile)   , Command "Find Retainers" (Vty.EvKey (KChar 'f') [Vty.MCtrl])@@ -691,6 +694,21 @@    case readClosurePtr address of     Just cp -> do       asyncAction "Finding address" os (map head <$> (liftIO $ retainersOfAddress Nothing dbg [cp])) $ \cps -> do+        let cps' = (zipWith (\n cp' -> (T.pack (show n),cp')) [0 :: Int ..]) cps+        res <- liftIO $ mapM (completeClosureDetails dbg Nothing) cps'+        let tree = mkIOTree dbg Nothing res getChildren id+        put (os & resetFooter+                & treeMode .~ Searched tree+            )+    Nothing -> put (os & resetFooter)++dispatchFooterInput dbg FInfoTable form = do+   os <- get+   let address = T.unpack (formState form)+   case readInfoTablePtr address of+    Just info_ptr -> do+      mb_src <- liftIO $ infoSourceLocation dbg info_ptr+      asyncAction ("Finding info table " <> T.pack (show info_ptr ++ maybe "" ((" " ++) . show) mb_src)) os (map head <$> (liftIO $ retainersOfInfoTable Nothing dbg info_ptr)) $ \cps -> do         let cps' = (zipWith (\n cp' -> (T.pack (show n),cp')) [0 :: Int ..]) cps         res <- liftIO $ mapM (completeClosureDetails dbg Nothing) cps'         let tree = mkIOTree dbg Nothing res getChildren id
src/Model.hs view
@@ -125,7 +125,7 @@ isFocusedFooter (FooterInput {}) = True isFocusedFooter _ = False -data FooterInputMode = FAddress | FSearch | FProfile | FRetainer | FRetainerExact | FSnapshot+data FooterInputMode = FAddress | FSearch | FInfoTable | FProfile | FRetainer | FRetainerExact | FSnapshot  data Command = Command { commandDescription :: Text                        , commandKey :: Vty.Event@@ -141,6 +141,7 @@ formatFooterMode :: FooterInputMode -> Text formatFooterMode FAddress = "address (0x..): " formatFooterMode FSearch = "search: "+formatFooterMode FInfoTable = "info table pointer (0x..): " formatFooterMode FProfile = "filename: " formatFooterMode FRetainer = "constructor name: " formatFooterMode FRetainerExact = "closure name: "