{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_HADDOCK hide #-}

module Data.Binary.IO.Internal.AwaitNotify
  ( Await (..)
  , Notify (..)
  , newAwaitNotify
  )
where

import           Data.Word (Word8)
import qualified Foreign
import qualified System.IO as IO
import           System.IO.Unsafe (unsafePerformIO)
import qualified System.Process as Process

-- | Static pointer that points to a single 'Word8'
someWord8Ptr :: Foreign.Ptr Word8
someWord8Ptr :: Ptr Word8
someWord8Ptr = IO (Ptr Word8) -> Ptr Word8
forall a. IO a -> a
unsafePerformIO (Storable Word8 => IO (Ptr Word8)
forall a. Storable a => IO (Ptr a)
Foreign.calloc @Word8)

{-# NOINLINE someWord8Ptr #-}

-- | Await signal from a paired 'Notify'. Returns 'False' if the paired 'Notify' does not exist
-- (any more).
newtype Await = Await
  { Await -> IO Bool
runAwait :: IO Bool }

-- | Notify the paired 'Await'.
newtype Notify = Notify
  { Notify -> IO ()
runNotify :: IO () }

-- | Create a pair of 'Await' and 'Notify.
newAwaitNotify :: IO (Await, Notify)
newAwaitNotify :: IO (Await, Notify)
newAwaitNotify = do
  (Handle
read, Handle
write) <- IO (Handle, Handle)
Process.createPipe

  Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
read BufferMode
IO.NoBuffering
  Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
write BufferMode
IO.NoBuffering

  Handle -> Bool -> IO ()
IO.hSetBinaryMode Handle
read Bool
True
  Handle -> Bool -> IO ()
IO.hSetBinaryMode Handle
write Bool
True

  let notify :: IO ()
notify = Handle -> Ptr Word8 -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
IO.hPutBuf Handle
write Ptr Word8
someWord8Ptr Int
1
  let await :: IO Bool
await  = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
IO.hGetBufSome Handle
read Ptr Word8
someWord8Ptr Int
1

  (Await, Notify) -> IO (Await, Notify)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO Bool -> Await
Await IO Bool
await, IO () -> Notify
Notify IO ()
notify)