module Signal.Connection ( Connection
, multicast
, publish
, connect
, multicastedSignal
, replay
, replayLast
, Channel
, Signal
, Scheduler
, SchedulerIO
, Disposable
) where
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.IO.Class
import Disposable
import Scheduler
import Signal
import Signal.Channel
data Connection s v = Connection {
baseSignal :: Signal s v,
disposable :: TVar Disposable,
channel :: Channel s v,
hasConnected :: TMVar Bool
}
multicast :: Scheduler s => Signal s v -> Channel s v -> IO (Connection s v)
multicast sig chan = do
d <- atomically $ newTVar EmptyDisposable
hc <- atomically $ newTMVar False
return Connection {
baseSignal = sig,
disposable = d,
channel = chan,
hasConnected = hc
}
publish :: Scheduler s => Signal s v -> IO (Connection s v)
publish sig = newChannel >>= multicast sig
replayCapacity :: Scheduler s => ChannelCapacity -> Signal s v -> SchedulerIO s (Signal s v)
replayCapacity c sig = do
chan <- liftIO $ newReplayChannel c
conn <- liftIO $ multicast sig chan
connect conn
return $ multicastedSignal conn
replay :: Scheduler s => Signal s v -> SchedulerIO s (Signal s v)
replay = replayCapacity UnlimitedCapacity
replayLast :: Scheduler s => Signal s v -> SchedulerIO s (Signal s v)
replayLast = replayCapacity $ LimitedCapacity 1
multicastedSignal :: Connection s v -> Signal s v
multicastedSignal conn = snd $ channel conn
connect :: forall s v. Scheduler s => Connection s v -> SchedulerIO s Disposable
connect conn =
let connect' :: SchedulerIO s Disposable
connect' = do
d <- baseSignal conn `subscribe` fst (channel conn)
liftIO $ atomically $ setDisposable d
return d
setDisposable :: Disposable -> STM ()
setDisposable d = do
putTMVar (hasConnected conn) True
writeTVar (disposable conn) d
shouldConnect :: STM (Bool, Disposable)
shouldConnect = do
hc <- takeTMVar $ hasConnected conn
d <- if hc
then putTMVar (hasConnected conn) hc >> return EmptyDisposable
else readTVar $ disposable conn
return (not hc, d)
in do
(shouldConnect, d) <- liftIO $ atomically shouldConnect
if shouldConnect
then connect'
else return d