-- | Functions for creating and running snapshots.
module GHC.Debug.Snapshot ( -- * Generating snapshots
                            snapshot
                          , makeSnapshot
                          -- * Using a snapshot
                          , snapshotRun
                          -- * Low level
                          , traceFrom ) where

import GHC.Debug.Trace
import GHC.Debug.ParTrace
import GHC.Debug.Client.Monad
import GHC.Debug.Client
import Control.Monad.Identity
import Control.Monad.Trans

-- | Make a snapshot of the current heap and save it to the given file.
snapshot :: FilePath -> DebugM ()
snapshot :: FilePath -> DebugM ()
snapshot FilePath
fp = do
  DebugM [RawBlock]
precacheBlocks
  DebugM Version
version
  [ClosurePtr]
rs <- DebugM [ClosurePtr]
gcRoots
  [ClosurePtr]
_so <- DebugM [ClosurePtr]
savedObjects
  [ClosurePtr] -> DebugM ()
tracePar [ClosurePtr]
rs
  forall (m :: * -> *). DebugMonad m => FilePath -> m ()
saveCache FilePath
fp

-- | Traverse the tree from GC roots, to populate the caches
-- with everything necessary.
traceFrom :: [ClosurePtr] -> DebugM ()
traceFrom :: [ClosurePtr] -> DebugM ()
traceFrom [ClosurePtr]
cps = forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (forall (m :: (* -> *) -> * -> *).
C m =>
TraceFunctions m -> [ClosurePtr] -> m DebugM ()
traceFromM TraceFunctions IdentityT
funcs [ClosurePtr]
cps)
  where
    nop :: b -> IdentityT DebugM ()
nop = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    funcs :: TraceFunctions IdentityT
funcs = forall (m :: (* -> *) -> * -> *).
(GenPapPayload ClosurePtr -> m DebugM ())
-> (GenSrtPayload ClosurePtr -> m DebugM ())
-> (GenStackFrames SrtCont ClosurePtr -> m DebugM ())
-> (ClosurePtr -> SizedClosure -> m DebugM () -> m DebugM ())
-> (ClosurePtr -> m DebugM ())
-> (ConstrDesc -> m DebugM ())
-> TraceFunctions m
TraceFunctions forall {b}. b -> IdentityT DebugM ()
nop forall {b}. b -> IdentityT DebugM ()
nop forall {b}. b -> IdentityT DebugM ()
nop ClosurePtr
-> SizedClosure -> IdentityT DebugM () -> IdentityT DebugM ()
clos (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())) forall {b}. b -> IdentityT DebugM ()
nop

    clos :: ClosurePtr -> SizedClosure -> (IdentityT DebugM) ()
              ->  (IdentityT DebugM) ()
    clos :: ClosurePtr
-> SizedClosure -> IdentityT DebugM () -> IdentityT DebugM ()
clos ClosurePtr
_cp SizedClosure
sc IdentityT DebugM ()
k = do
      let itb :: StgInfoTableWithPtr
itb = forall srt pap string s b.
DebugClosure srt pap string s b -> StgInfoTableWithPtr
info (forall srt pap string s b.
DebugClosureWithSize srt pap string s b
-> DebugClosure srt pap string s b
noSize SizedClosure
sc)
      Maybe SourceInformation
_traced <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ SrtCont -> DebugM (Maybe SourceInformation)
getSourceInfo (StgInfoTableWithPtr -> SrtCont
tableId StgInfoTableWithPtr
itb)
      IdentityT DebugM ()
k

-- | Pause the process and create a snapshot of
-- the heap. The snapshot can then be loaded with
-- 'snapshotRun' in order to perform offline analysis.
makeSnapshot :: Debuggee -> FilePath -> IO ()
makeSnapshot :: Debuggee -> FilePath -> IO ()
makeSnapshot Debuggee
e FilePath
fp = forall a r. DebugM a -> (a -> IO r) -> Debuggee -> IO r
runAnalysis (FilePath -> DebugM ()
snapshot FilePath
fp) (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())) Debuggee
e