{- | This module contains some handy conduit abstractions. -}
module OM.Legion.Conduit (
  chanToSource,
  chanToSink,
) where


import Control.Concurrent.Chan (Chan, readChan, writeChan)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Conduit (ConduitT, awaitForever, yield)


{- | Convert a channel into a source conduit. -}
chanToSource :: (MonadIO m) => Chan a -> ConduitT void a m ()
chanToSource :: forall (m :: * -> *) a void.
MonadIO m =>
Chan a -> ConduitT void a m ()
chanToSource Chan a
chan = do
  {-
    Don't use 'Control.Monad.forever' here. For some reason that is unclear to
    me, use of 'forever' creates a space leak, despite the comments in the
    'forever' source code.
    
    The code:

    > forever $ yield =<< liftIO (readChan chan)

    will reliably leak several megabytes of memory over the course of 10k
    messages when tested using the 'legion-discovery' project. This was
    discovered by @-hr@ heap profiling, which pointed to 'chanToSource'
    as the retainer. I think it didn't point to 'forever' as the retainer
    because 'forever' is inlined, and thus does not have a cost-centre
    associated with it.
  -}
  a -> ConduitT void a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (a -> ConduitT void a m ())
-> ConduitT void a m a -> ConduitT void a m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a -> ConduitT void a m a
forall a. IO a -> ConduitT void a m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Chan a -> IO a
forall a. Chan a -> IO a
readChan Chan a
chan)
  Chan a -> ConduitT void a m ()
forall (m :: * -> *) a void.
MonadIO m =>
Chan a -> ConduitT void a m ()
chanToSource Chan a
chan


{- | Convert a channel into a sink conduit. -}
chanToSink :: (MonadIO m) => Chan a -> ConduitT a void m ()
chanToSink :: forall (m :: * -> *) a void.
MonadIO m =>
Chan a -> ConduitT a void m ()
chanToSink Chan a
chan = (a -> ConduitT a void m ()) -> ConduitT a void m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (IO () -> ConduitT a void m ()
forall a. IO a -> ConduitT a void m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT a void m ())
-> (a -> IO ()) -> a -> ConduitT a void m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chan a -> a -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan a
chan)