module Control.Concurrent.Chan.Unagi.Unboxed (
    -- * Creating channels
      newChan
    , InChan(), OutChan()
    , UnagiPrim(..)
    -- * Channel operations
    -- ** Reading
    , readChan
    , readChanOnException
    , tryReadChan
    , Element(..)
    , getChanContents
    -- ** Writing
    , writeChan
    , writeList2Chan
    -- ** Broadcasting
    , dupChan
    ) where

-- Forked from src/Control/Concurrent/Chan/Unagi/Internal.hs at 443465
--
-- TODO additonal functions:
--   - write functions optimized for single-writer
--   - faster write/read-many that increments counter by N
--   - this could be used (or forked) to implement an efficient MPSC concurrent
--     ByteString or Text queue (where writes could be variable-sized chunks
--     and we incrCounter accordingly) without too much trouble. Useful?
--       - likewise a SPMC concurrent bytestring consumer?
--   - ...or interop with 'vector' lib

import Control.Concurrent.Chan.Unagi.Unboxed.Internal
import Control.Concurrent.Chan.Unagi.NoBlocking.Types
-- For 'writeList2Chan', as in vanilla Chan
import System.IO.Unsafe ( unsafeInterleaveIO ) 


-- | Create a new channel, returning its write and read ends.
newChan :: UnagiPrim a=> IO (InChan a, OutChan a)
newChan :: IO (InChan a, OutChan a)
newChan = Int -> IO (InChan a, OutChan a)
forall a. UnagiPrim a => Int -> IO (InChan a, OutChan a)
newChanStarting (Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10) 
    -- lets us test counter overflow in tests and normal course of operation

-- | Return a lazy infinite list representing the contents of the supplied
-- OutChan, much like System.IO.hGetContents.
getChanContents :: UnagiPrim a=> OutChan a -> IO [a]
getChanContents :: OutChan a -> IO [a]
getChanContents OutChan a
ch = IO [a] -> IO [a]
forall a. IO a -> IO a
unsafeInterleaveIO (do
                            a
x  <- IO a -> IO a
forall a. IO a -> IO a
unsafeInterleaveIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ OutChan a -> IO a
forall a. UnagiPrim a => OutChan a -> IO a
readChan OutChan a
ch
                            [a]
xs <- OutChan a -> IO [a]
forall a. UnagiPrim a => OutChan a -> IO [a]
getChanContents OutChan a
ch
                            [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
                        )

-- | Write an entire list of items to a chan type. Writes here from multiple
-- threads may be interleaved, and infinite lists are supported.
writeList2Chan :: UnagiPrim a=> InChan a -> [a] -> IO ()
{-# INLINABLE writeList2Chan #-}
writeList2Chan :: InChan a -> [a] -> IO ()
writeList2Chan InChan a
ch = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> ([a] -> [IO ()]) -> [a] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> IO ()) -> [a] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map (InChan a -> a -> IO ()
forall a. UnagiPrim a => InChan a -> a -> IO ()
writeChan InChan a
ch)