module GHC.Debug.Client.Search(module GHC.Debug.Client.Search, HeapGraph(..), HeapGraphEntry(..)) where

import GHC.Debug.Types
import GHC.Debug.Types.Graph
import qualified Data.IntMap as IM

-- Find all entries in the HeapGraph matching a specific predicate
findClosures :: (HeapGraphEntry a -> Bool) -> HeapGraph a -> [HeapGraphEntry a]
findClosures :: forall a.
(HeapGraphEntry a -> Bool) -> HeapGraph a -> [HeapGraphEntry a]
findClosures HeapGraphEntry a -> Bool
f = HeapGraph a -> [HeapGraphEntry a]
go
  where
    go :: HeapGraph a -> [HeapGraphEntry a]
go (HeapGraph NonEmpty ClosurePtr
_ IntMap (HeapGraphEntry a)
gs) =
      forall a b. (a -> b -> a) -> a -> IntMap b -> a
IM.foldl' (\[HeapGraphEntry a]
hges HeapGraphEntry a
hge -> if HeapGraphEntry a -> Bool
f HeapGraphEntry a
hge then HeapGraphEntry a
hgeforall a. a -> [a] -> [a]
:[HeapGraphEntry a]
hges else [HeapGraphEntry a]
hges) [] IntMap (HeapGraphEntry a)
gs

findConstructors :: String -> HeapGraph a -> [HeapGraphEntry a]
findConstructors :: forall a. String -> HeapGraph a -> [HeapGraphEntry a]
findConstructors String
con_name HeapGraph a
hg = forall a.
(HeapGraphEntry a -> Bool) -> HeapGraph a -> [HeapGraphEntry a]
findClosures forall {a}. HeapGraphEntry a -> Bool
predicate HeapGraph a
hg
    where
      predicate :: HeapGraphEntry a -> Bool
predicate HeapGraphEntry a
h = forall {pap} {s} {b}. DebugClosure pap ConstrDesc s b -> Bool
checkConstrTable (forall a.
HeapGraphEntry a
-> DebugClosure PapHI ConstrDesc StackHI (Maybe ClosurePtr)
hgeClosure HeapGraphEntry a
h)

      checkConstrTable :: DebugClosure pap ConstrDesc s b -> Bool
checkConstrTable (ConstrClosure StgInfoTableWithPtr
_ [b]
_ [Word]
_ (ConstrDesc String
_ String
_ String
n)) = String
n forall a. Eq a => a -> a -> Bool
== String
con_name
      checkConstrTable DebugClosure pap ConstrDesc s b
_ = Bool
False

findWithInfoTable :: InfoTablePtr -> HeapGraph a -> [HeapGraphEntry a]
findWithInfoTable :: forall a. InfoTablePtr -> HeapGraph a -> [HeapGraphEntry a]
findWithInfoTable InfoTablePtr
itp = forall a.
(HeapGraphEntry a -> Bool) -> HeapGraph a -> [HeapGraphEntry a]
findClosures forall {a}. HeapGraphEntry a -> Bool
p
  where
    p :: HeapGraphEntry a -> Bool
p = (InfoTablePtr
itp forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StgInfoTableWithPtr -> InfoTablePtr
tableId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pap string s b.
DebugClosure pap string s b -> StgInfoTableWithPtr
info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HeapGraphEntry a
-> DebugClosure PapHI ConstrDesc StackHI (Maybe ClosurePtr)
hgeClosure