content: {-# LANGUAGE OverloadedStrings, OverloadedRecordDot, CPP, DeriveAnyClass, DeriveGeneric, DerivingVia, LambdaCase, RecordWildCards #-}
  module Development.Debug.Adapter.Handles
    ( handleLogger
    , withInterceptedStdout
    , withInterceptedStderr
    , withInterceptedStdoutForwarding
    , withInterceptedStderrForwarding
    ) where
  
  import DAP
  
  
  import System.IO ()
  import DAP.Log
  import qualified Data.Text as T
  import qualified Data.Text.IO as T
  import Control.Concurrent.MVar
  import GHC.IO.Handle.FD
  import GHC.IO.Handle
  import System.Process
  import Control.Exception
  import Control.Monad
  import Control.Concurrent.Async
  
  {- Note [Debugger Handles]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  The debugger executes arbritary user programs which will output to stdout and stderr.
  This output needs to be sent to the debug client. Any output we wish to put in a
  log or elsewhere needs to be directed to another handle.
  
  
  -}
  
  handleLogger :: Handle -> IO (LogAction IO T.Text)
  handleLogger out_handle = do
    handleLock               <- newMVar ()
    return $ LogAction $ \msg -> do
      withLock handleLock $ do
        T.hPutStrLn out_handle msg
  
  -- | Redirect stdout globally, run the continuation with a bypass handle for real stdout.
  withInterceptedStdout :: (Handle -- ^ realStdout, write to this handle sends output to stdout
                            -> Handle -- ^ interceptedStdout, stdout captured from attempting to write to stdout handle.
                            -> IO ()) -> IO ()
  withInterceptedStdout k = do
    withPipe $ \readOutHandle writeOutHandle -> do
      hSetBuffering readOutHandle NoBuffering
      hSetBuffering writeOutHandle LineBuffering
      withStdoutBypass writeOutHandle $ \realStdout -> do
        k realStdout readOutHandle
  
  -- | Redirect stderr globally, run the continuation with a bypass handle for real stderr.
  withInterceptedStderr :: (Handle -- ^ realStderr, write to this handle sends output to stderr
                            -> Handle -- ^ interceptedStderr, stdout captured from attempting to write to stderr handle.
                            -> IO ()) -> IO ()
  withInterceptedStderr k = do
    withPipe $ \readErrHandle writeErrHandle -> do
      hSetBuffering readErrHandle NoBuffering
      hSetBuffering writeErrHandle LineBuffering
      withStderrBypass writeErrHandle $ \realStderr -> do
        k realStderr readErrHandle
  
  -- | Intercept stderr, and spawn a thread which forwards the input
  -- onwards using the supplied IO action.
  withInterceptedStderrForwarding :: (T.Text -> IO ())
                                  -- ^ All stderr input that is intercepted is forwarded to this thread
                                  -> (Handle -> IO ())
                                  -- ^ The continuation receives the REAL STDERR
                                  -> IO ()
  withInterceptedStderrForwarding write_stderr k = do
    withInterceptedStderr $ \realStderr interceptedStderr -> do
        withAsync (forwardingThread write_stderr interceptedStderr) $ \_ -> do
          k realStderr
  
  -- | Intercept stdout, and spawn a thread which forwards the input
  -- onwards using the supplied IO action.
  withInterceptedStdoutForwarding :: (T.Text -> IO ())
                                  -- ^ All stdout input that is intercepted is forwarded to this thread
                                  -> (Handle -> IO ())
                                  -- ^ The continuation receives the REAL STDOUT
                                  -> IO ()
  withInterceptedStdoutForwarding write_stdout k = do
    withInterceptedStdout $ \realStdout interceptedStdout -> do
      withAsync (forwardingThread write_stdout interceptedStdout) $ \_ ->
          k realStdout
  
  --------------------------------------------------------------------------------
  -- Auxiliary
  --------------------------------------------------------------------------------
  
  -- | Temporarily bypass the intercepted stdout/stderr to write directly to the original stdout/stderr.
  -- This is useful for debugging or for sending output that should not be intercepted.
  withStdoutBypass, withStderrBypass
    :: Handle
    -> (Handle -> IO r)
    -> IO r
  withStdoutBypass interceptH = withHandleBypass stdout interceptH
  withStderrBypass interceptH = withHandleBypass stderr interceptH
  
  -- | Capture all output written to a given handle and redirect it to the other
  -- one; the continuation can use the "real" copy of the first handle to write
  -- to it while bypassing the redirection.
  --
  -- This is useful for debugging or for sending output that should not be intercepted.
  withHandleBypass :: Handle
                   -- ^ Text written to this handle...
                   -> Handle
                   -- ^ ...will be redirected to this handle
                   -> (Handle -> IO r)
                   -- ^ Continuation receives as an argument a "real" copy of the handle that is now being redirected.
                   -- If you write to this Handle, it will write to the original one and *bypass* the redirection (ie it will not be redirected)
                   -> IO r
  withHandleBypass originalHandle interceptWriteHandle action =
    bracket setup clean action
    where
      setup = do
        realHandle <- hDuplicate originalHandle
        hFlush originalHandle
        hDuplicateTo interceptWriteHandle originalHandle
        hSetBuffering originalHandle LineBuffering
        return realHandle
  
      clean realHandle = do
        hFlush originalHandle
        hDuplicateTo realHandle originalHandle
        hClose realHandle
  
  -- | Thread to read from the intercepted stdout pipe and forward onwards
  forwardingThread :: (T.Text -> IO ()) -> Handle -> IO ()
  forwardingThread write_action fromPipe = forever $ do
    line <- T.hGetLine fromPipe
    write_action line
  
  
  withPipe :: (Handle -> Handle -> IO r) -> IO r
  withPipe action = bracket createPipe closeBoth (uncurry action)
    where
      closeBoth (readH, writeH) = do
        hClose readH
        hClose writeH
  
  