diff --git a/ghc-debug-brick/src/Main.hs b/ghc-debug-brick/src/Main.hs
index f209da304cb4e1f8a7bc7ba9318f38ea1c0f95d1..5565dc37c382e0d2c205545a303af0dc8df945f1 100644
--- a/ghc-debug-brick/src/Main.hs
+++ b/ghc-debug-brick/src/Main.hs
@@ -106,7 +106,7 @@ myAppDraw (AppState majorState' _) =
                 Searched {} -> "Search Results"
               )
               (pauseModeTree renderIOTree os)
-          , footer fmode
+          , footer (osSize os) (_resultSize os) fmode
           ]]
 
   where
@@ -201,11 +201,12 @@ myAppDraw (AppState majorState' _) =
   labelled lbl w =
     hLimit 17 (txtLabel lbl <+> vLimit 1 (fill ' ')) <+> w <+> vLimit 1 (fill ' ')
 
-footer :: FooterMode -> Widget Name
-footer m = vLimit 1 $
- case m of
+footer :: Int -> Maybe Int -> FooterMode -> Widget Name
+footer n m mode = vLimit 1 $
+ case mode of
    FooterMessage t -> withAttr menuAttr $ hBox [txt t, fill ' ']
-   FooterInfo -> withAttr menuAttr $ hBox [txt "(↑↓): select item | (→): expand | (←): collapse | (^p): command picker | (?): full keybindings", fill ' ']
+   FooterInfo -> withAttr menuAttr $ hBox $ [padRight Max $ txt "(↑↓): select item | (→): expand | (←): collapse | (^p): command picker | (?): full keybindings"]
+                                         ++ [padLeft  Max $ txt (T.pack (show n) <> " items/" <> maybe "inf" (T.pack . show) m <> " max")]
    FooterInput _im form -> renderForm form
 
 footerInput :: FooterInputMode -> FooterMode
@@ -551,10 +552,10 @@ handleMain dbg e = do
             PollTick -> return ()
             ProgressMessage t -> do
               put $ footerMessage t os
-            ProgressFinished  ->
+            ProgressFinished ->
               put $ os
                     & running_task .~ Nothing
-                    & resetFooter
+                    & footerMode .~ FooterInfo
             AsyncFinished action -> action
     _ | Nothing <- view running_task os ->
       case view keybindingsMode os of
diff --git a/ghc-debug-brick/src/Model.hs b/ghc-debug-brick/src/Model.hs
index 993d10ba60103790645ae314a36cf676f915bb72..8521053e1b65c488fc442579e5b1e74aa34a75c0 100644
--- a/ghc-debug-brick/src/Model.hs
+++ b/ghc-debug-brick/src/Model.hs
@@ -12,6 +12,7 @@ module Model
   , module Common
   ) where
 
+import Data.Maybe (fromMaybe)
 import Data.Sequence as Seq
 import Lens.Micro.Platform
 import Data.Time
@@ -23,11 +24,11 @@ import Brick.Forms
 import Brick.BChan
 import Brick (EventM)
 import Brick.Widgets.List
-import IOTree
 
 import Namespace
 import Common
 import Lib
+import IOTree
 import Control.Concurrent
 import qualified Graphics.Vty as Vty
 
@@ -117,6 +118,11 @@ data TreeMode = SavedAndGCRoots
               | Retainer (IOTree (ClosureDetails) Name)
               | Searched (IOTree (ClosureDetails) Name)
 
+treeLength :: TreeMode -> Maybe Int
+treeLength SavedAndGCRoots = Nothing
+treeLength (Retainer tree) = Just $ Prelude.length $ getIOTreeRoots tree
+treeLength (Searched tree) = Just $ Prelude.length $ getIOTreeRoots tree
+
 data FooterMode = FooterInfo
                 | FooterMessage Text
                 | FooterInput FooterInputMode (Form Text () Name)
@@ -185,6 +191,9 @@ data OperationalState = OperationalState
     , _resultSize :: Maybe Int
     }
 
+osSize :: OperationalState -> Int
+osSize os = fromMaybe (Prelude.length (getIOTreeRoots $ _treeSavedAndGCRoots os)) $ treeLength (_treeMode os)
+
 pauseModeTree :: (IOTree ClosureDetails Name -> r) -> OperationalState -> r
 pauseModeTree k (OperationalState _ mode _kb _footer _from roots _ _) = case mode of
   SavedAndGCRoots -> k roots