content: {-# 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
    , debuggeeRun
    , debuggeeConnect
    , debuggeeClose
    -- * Snapshot run
    , snapshotInit
    , snapshotRun
      -- * Logging
    , outputRequestLog
    ) where
  
  import Control.Exception (finally)
  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
  
  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
  
  -- | 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
  
  -- | Connect to a debuggee on the given socket. Use @debuggeeClose@ when you're done.
  debuggeeConnect :: FilePath  -- ^ filename of socket (e.g. @"\/tmp\/ghc-debug"@)
                  -> IO Debuggee
  debuggeeConnect socketName = do
      s <- socket AF_UNIX Stream defaultProtocol
      connect s (SockAddrUnix socketName)
      hdl <- socketToHandle s ReadWriteMode
      new_env <- newEnv @DebugM (SocketMode hdl)
      return (Debuggee new_env)
  
  -- | Create a debuggee by loading a snapshot created by 'snapshot'.
  snapshotInit :: FilePath -> IO Debuggee
  snapshotInit fp = Debuggee <$> newEnv @DebugM (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
  
  