Out.hs

data CapturedProcess = CapturedProcess {
    _exitCode :: ExitCode
  , _stdOut   :: L.ByteString
  , _stdErr   :: L.ByteString
} deriving (Eq, Show)

makeLenses ''CapturedProcess

readFd :: Fd -> IO L.ByteString
readFd = undefined

captureOutStreams :: IO a
                     -- ^ the action to execute in a subprocess
                     -- and capture its stdout and stderr
                  -> IO (Maybe CapturedProcess)
captureOutStreams action =
  actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
    actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
      pid <- SPPB.forkProcess $ do
        -- don't mess up stdin from the parent
        closeFd stdInput

        -- dup stdout
        void $ dupTo childStdoutWrite stdOutput
        closeFd childStdoutWrite
        closeFd parentStdoutRead

        -- dup stderr
        void $ dupTo childStderrWrite stdError
        closeFd childStderrWrite
        closeFd parentStderrRead

        -- execute the action
        void $ action

      -- close everything we don't need
      closeFd childStdoutWrite
      closeFd childStderrWrite

      SPPB.getProcessStatus True True pid >>= \case
        -- readFd will take care of closing the fd
        Just (SPPB.Exited es) -> do
          stdout' <- readFd parentStdoutRead
          stderr' <- readFd parentStderrRead
          pure $ Just $ CapturedProcess { _exitCode = es
                                        , _stdOut   = stdout'
                                        , _stdErr   = stderr'
                                        }
        _ -> do
          closeFd parentStdoutRead
          closeFd parentStderrRead
          pure $ Nothing

 where
  actionWithPipes a =
    createPipe >>= \(p1, p2) -> (flip finally) (cleanup [p1, p2]) $ a (p1, p2)
  cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd