{- | The main API for creating debuggers. For example, this API can be used
to connect to an instrumented process, query the GC roots and then decode
the first root up to depth 10 and displayed to the user.

@
main = withDebuggeeConnect "\/tmp\/ghc-debug" p1

p1 :: Debuggee -> IO ()
p1 e = do
  pause e
  g <- run e $ do
        precacheBlocks
        (r:_) <- gcRoots
        buildHeapGraph (Just 10) r
  putStrLn (ppHeapGraph (const "") h)
@

-}
module GHC.Debug.Client
  ( -- * Running/Connecting to a debuggee
    Debuggee
  , DebugM
  , debuggeeRun
  , debuggeeConnect
  , debuggeeClose
  , withDebuggeeRun
  , withDebuggeeConnect
  , socketDirectory
  , snapshotRun

    -- * Running DebugM
  , run
  , runTrace
  , runAnalysis

    -- * Pause/Resume
  , pause
  , fork
  , pauseThen
  , resume
  , pausePoll
  , withPause

  -- * Basic Requests
  , version
  , gcRoots
  , allBlocks
  , getSourceInfo
  , savedObjects
  , precacheBlocks
  , dereferenceClosure
  , dereferenceClosures
  , dereferenceStack
  , dereferencePapPayload
  , dereferenceConDesc
  , dereferenceInfoTable

  , Quadtraversable(..)

  -- * Building a Heap Graph
  , buildHeapGraph
  , multiBuildHeapGraph
  , HG.HeapGraph(..)
  , HG.HeapGraphEntry(..)

  -- * Printing a heap graph
  , HG.ppHeapGraph

  -- * Tracing
  , traceWrite
  , traceMsg

  -- * Caching
  , saveCache
  , loadCache

  -- * Types
  , module GHC.Debug.Types.Closures
  , SourceInformation(..)
  , RawBlock(..)
  , BlockPtr
  , StackPtr
  , ClosurePtr
  , InfoTablePtr
  , HG.StackHI
  , HG.PapHI
  , HG.HeapGraphIndex
  ) where

import           GHC.Debug.Types
import           GHC.Debug.Types.Closures
import           GHC.Debug.Convention (socketDirectory)
import GHC.Debug.Client.Monad
import           GHC.Debug.Client.Query
import qualified GHC.Debug.Types.Graph as HG
import Data.List.NonEmpty (NonEmpty)

derefFuncM :: HG.DerefFunction DebugM Size
derefFuncM :: DerefFunction DebugM Size
derefFuncM ClosurePtr
c = do
  SizedClosure
c' <- ClosurePtr -> DebugM SizedClosure
dereferenceClosure ClosurePtr
c
  forall (m :: * -> * -> * -> * -> *) (f :: * -> *) a b c d e g h i.
(Quadtraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> m a c e h
-> f (m b d g i)
quadtraverse PayloadCont -> DebugM PapPayload
dereferencePapPayload ConstrDescCont -> DebugM ConstrDesc
dereferenceConDesc StackCont -> DebugM StackFrames
dereferenceStack forall (f :: * -> *) a. Applicative f => a -> f a
pure SizedClosure
c'

-- | Build a heap graph starting from the given root. The first argument
-- controls how many levels to recurse. You nearly always want to set this
-- to a small number ~ 10, as otherwise you can easily run out of memory.
buildHeapGraph :: Maybe Int -> ClosurePtr -> DebugM (HG.HeapGraph Size)
buildHeapGraph :: Maybe Int -> ClosurePtr -> DebugM (HeapGraph Size)
buildHeapGraph = forall (m :: * -> *) a.
MonadFix m =>
DerefFunction m a -> Maybe Int -> ClosurePtr -> m (HeapGraph a)
HG.buildHeapGraph DerefFunction DebugM Size
derefFuncM

-- | Build a heap graph starting from multiple roots. The first argument
-- controls how many levels to recurse. You nearly always want to set this
-- value to a small number ~ 10 as otherwise you can easily run out of
-- memory.
multiBuildHeapGraph :: Maybe Int -> NonEmpty ClosurePtr -> DebugM (HG.HeapGraph Size)
multiBuildHeapGraph :: Maybe Int -> NonEmpty ClosurePtr -> DebugM (HeapGraph Size)
multiBuildHeapGraph = forall (m :: * -> *) a.
MonadFix m =>
DerefFunction m a
-> Maybe Int -> NonEmpty ClosurePtr -> m (HeapGraph a)
HG.multiBuildHeapGraph DerefFunction DebugM Size
derefFuncM

-- | Perform the given analysis whilst the debuggee is paused, then resume
-- and apply the continuation to the result.
runAnalysis :: DebugM a -> (a -> IO r) -> Debuggee -> IO r
runAnalysis :: forall a r. DebugM a -> (a -> IO r) -> Debuggee -> IO r
runAnalysis DebugM a
a a -> IO r
k Debuggee
e = do
  Debuggee -> IO ()
pause Debuggee
e
  a
r <- forall a. Debuggee -> DebugM a -> IO a
run Debuggee
e DebugM a
a
  Debuggee -> IO ()
resume Debuggee
e
  a -> IO r
k a
r