{-# LANGUAGE CApiFFI #-}

-- |
-- Stream GHC eventlog events to external processes.
module GHC.Eventlog.Socket (
    startWait,
    start,
    wait,
) where

import Foreign.C
import Foreign.Ptr

-- | Start listening for eventlog connections, blocking until a client connects.
startWait :: FilePath  -- ^ File path to the unix domain socket to create.
          -> IO ()
startWait :: FilePath -> IO ()
startWait = Bool -> FilePath -> IO ()
c_start' Bool
True

-- | Start listening for eventlog connections.
start :: FilePath      -- ^ File path to the unix domain socket to create.
      -> IO ()
start :: FilePath -> IO ()
start = Bool -> FilePath -> IO ()
c_start' Bool
False

-- | Wait (block) until a client connects.
wait :: IO ()
wait :: IO ()
wait = IO ()
c_wait

c_start' :: Bool -> FilePath -> IO ()
c_start' :: Bool -> FilePath -> IO ()
c_start' Bool
block FilePath
socketPath =
    FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
socketPath ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
socketPathCString ->
    CString -> Bool -> IO ()
c_start CString
socketPathCString Bool
block

foreign import capi safe "eventlog_socket.h eventlog_socket_start"
    c_start :: CString -> Bool -> IO ()

foreign import capi safe "eventlog_socket.h eventlog_socket_wait"
    c_wait :: IO ()