{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-unused-imports #-} module GHC.Debug.Client.Monad ( DebugMonad(..) , run , DebugM , Debuggee , traceWrite , runTrace -- * Running/Connecting to a debuggee , withDebuggeeRun , withDebuggeeConnect , withDebuggeeConnectTCP , debuggeeRun , debuggeeConnect , debuggeeConnectTCP , debuggeeConnectWithTracer , debuggeeConnectWithTracerTCP , debuggeeClose -- * Snapshot run , snapshotInit , snapshotInitWithTracer , snapshotRun -- * Logging , outputRequestLog ) where import Control.Exception (finally) import Data.Word (Word16) import Network.Socket import System.Process import System.Environment import GHC.Debug.Client.Monad.Class import GHC.Debug.Types (Request(..)) import qualified GHC.Debug.Client.Monad.Simple as S import System.IO import Control.Tracer type DebugM = S.DebugM newtype Debuggee = Debuggee { debuggeeEnv :: DebugEnv DebugM } runTrace :: Debuggee -> DebugM a -> IO a runTrace (Debuggee e) act = do (r, ws) <- runDebugTrace e act mapM_ putStrLn ws return r traceWrite :: DebugMonad m => Show a => a -> m () traceWrite = traceMsg . show -- | Run a @DebugM a@ in the given environment. run :: Debuggee -> DebugM a -> IO a run (Debuggee d) = runDebug d -- | Bracketed version of @debuggeeRun@. Runs a debuggee, connects to it, runs -- the action, kills the process, then closes the debuggee. withDebuggeeRun :: FilePath -- ^ path to executable to run as the debuggee -> FilePath -- ^ filename of socket (e.g. @"\/tmp\/ghc-debug"@) -> (Debuggee -> IO a) -> IO a withDebuggeeRun exeName socketName action = do -- Start the process we want to debug cp <- debuggeeProcess exeName socketName withCreateProcess cp $ \_ _ _ _ -> do -- Now connect to the socket the debuggeeProcess just started withDebuggeeConnect socketName action -- | Bracketed version of @debuggeeConnect@. Connects to a debuggee, runs the -- action, then closes the debuggee. withDebuggeeConnect :: FilePath -- ^ filename of socket (e.g. @"\/tmp\/ghc-debug"@) -> (Debuggee -> IO a) -> IO a withDebuggeeConnect socketName action = do new_env <- debuggeeConnect socketName action new_env `finally` debuggeeClose new_env -- | Bracketed version of @debuggeeConnectTCP@. Connects to a debuggee, runs the -- action, then closes the debuggee. withDebuggeeConnectTCP :: String -- ^ host of the tcp socket (e.g. @"127.0.0.1"@) -> Word16 -- ^ port of the tcp socket (e.g. @1235@) -> (Debuggee -> IO a) -> IO a withDebuggeeConnectTCP host port action = do new_env <- debuggeeConnectTCP host port action new_env `finally` debuggeeClose new_env -- | Run a debuggee and connect to it. Use @debuggeeClose@ when you're done. debuggeeRun :: FilePath -- ^ path to executable to run as the debuggee -> FilePath -- ^ filename of socket (e.g. @"\/tmp\/ghc-debug"@) -> IO Debuggee debuggeeRun exeName socketName = do -- Start the process we want to debug _ <- createProcess =<< debuggeeProcess exeName socketName -- Now connect to the socket the debuggeeProcess just started debuggeeConnect socketName debuggeeConnect :: FilePath -> IO Debuggee debuggeeConnect = debuggeeConnectWithTracer debugTracer debuggeeConnectTCP :: String -> Word16 -> IO Debuggee debuggeeConnectTCP = debuggeeConnectWithTracerTCP debugTracer -- | Connect to a debuggee on the given socket. Use @debuggeeClose@ when you're done. debuggeeConnectWithTracer :: Tracer IO String -> FilePath -- ^ filename of socket (e.g. @"\/tmp\/ghc-debug"@) -> IO Debuggee debuggeeConnectWithTracer tracer socketName = do s <- socket AF_UNIX Stream defaultProtocol connect s (SockAddrUnix socketName) hdl <- socketToHandle s ReadWriteMode new_env <- newEnv @DebugM tracer (SocketMode hdl) return (Debuggee new_env) debuggeeConnectWithTracerTCP :: Tracer IO String -> String -- ^ host of the tcp socket (e.g. @"127.0.0.1"@) -> Word16 -- ^ port of the tcp socket (e.g. @1235@) -> IO Debuggee debuggeeConnectWithTracerTCP tracer host port = do addr:_ <- getAddrInfo (Just defaultHints) (Just host) (Just $ show port) s <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) connect s (addrAddress addr) hdl <- socketToHandle s ReadWriteMode new_env <- newEnv @DebugM tracer (SocketMode hdl) return (Debuggee new_env) -- | Create a debuggee by loading a snapshot created by 'snapshot'. snapshotInit :: FilePath -> IO Debuggee snapshotInit = snapshotInitWithTracer debugTracer snapshotInitWithTracer :: Tracer IO String -> FilePath -> IO Debuggee snapshotInitWithTracer tracer fp = Debuggee <$> newEnv @DebugM tracer (SnapshotMode fp) -- | Start an analysis session using a snapshot. This will not connect to a -- debuggee. The snapshot is created by 'snapshot'. snapshotRun :: FilePath -> (Debuggee -> IO a) -> IO a snapshotRun fp k = do denv <- snapshotInit fp k denv -- | Close the connection to the debuggee. debuggeeClose :: Debuggee -> IO () debuggeeClose d = run d $ request RequestResume debuggeeProcess :: FilePath -> FilePath -> IO CreateProcess debuggeeProcess exe sockName = do e <- getEnvironment return $ (proc exe []) { env = Just (("GHC_DEBUG_SOCKET", sockName) : e) } outputRequestLog :: Debuggee -> IO () outputRequestLog = printRequestLog @DebugM . debuggeeEnv