module Net.Wire where
import Net.Concurrent
import Net.Interface as Net
type Wire m a = Interface m a a
unbounded :: () -> m (Interface m o o)
unbounded () =
do c o
channel <- m (c o)
forall a. m (c a)
forall (c :: * -> *) (io :: * -> *) a. ChannelIO c io => io (c a)
newChan
Interface m o o -> m (Interface m o o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Interface{rx :: m o
rx=c o -> m o
forall a. c a -> m a
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> io a
readChan c o
channel,tx :: o -> m ()
tx=c o -> o -> m ()
forall a. c a -> a -> m ()
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> a -> io ()
writeChan c o
channel}
newWire :: () -> m (Interface m o o)
newWire () = m (Interface m o o) -> m (Interface m o o)
forall {v :: * -> *} {m :: * -> *} {m :: * -> *} {i} {o}.
(MVarIO v m, MVarIO v m) =>
m (Interface m i o) -> m (Interface m i o)
bounded (() -> m (Interface m o o)
forall {c :: * -> *} {m :: * -> *} {m :: * -> *} {o}.
(ChannelIO c m, ChannelIO c m) =>
() -> m (Interface m o o)
unbounded ())
newWire' :: a -> m (Interface m o o)
newWire' a
n = a -> m (Interface m o o) -> m (Interface m o o)
forall {a} {m :: * -> *} {m :: * -> *} {v :: * -> *} {i} {o}.
(Num a, MVarIO v m, MVarIO v m, Ord a, Enum a) =>
a -> m (Interface m i o) -> m (Interface m i o)
bounded' a
n (() -> m (Interface m o o)
forall {c :: * -> *} {m :: * -> *} {m :: * -> *} {o}.
(ChannelIO c m, ChannelIO c m) =>
() -> m (Interface m o o)
unbounded ())
bounded :: m (Interface m i o) -> m (Interface m i o)
bounded m (Interface m i o)
new = Int -> m (Interface m i o) -> m (Interface m i o)
forall {a} {m :: * -> *} {m :: * -> *} {v :: * -> *} {i} {o}.
(Num a, MVarIO v m, MVarIO v m, Ord a, Enum a) =>
a -> m (Interface m i o) -> m (Interface m i o)
bounded' (Int
10::Int) m (Interface m i o)
new
bounded' :: a -> m (Interface m i o) -> m (Interface m i o)
bounded' a
buffersize m (Interface m i o)
newWire =
do Interface m i o
wire <- m (Interface m i o)
newWire
v a
size <- a -> m (v a)
forall a. a -> m (v a)
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => a -> io (v a)
newMVar a
0
let tx :: o -> m ()
tx o
p = do a
current <- v a -> m a
forall a. v a -> m a
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => v a -> io a
takeMVar v a
size
if a
currenta -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
buffersize
then do Interface m i o -> o -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx Interface m i o
wire o
p
v a -> a -> m ()
forall a. v a -> a -> m ()
forall (v :: * -> *) (io :: * -> *) a.
MVarIO v io =>
v a -> a -> io ()
putMVar v a
size (a -> a
forall a. Enum a => a -> a
succ a
current)
else v a -> a -> m ()
forall a. v a -> a -> m ()
forall (v :: * -> *) (io :: * -> *) a.
MVarIO v io =>
v a -> a -> io ()
putMVar v a
size a
current
rx :: m i
rx = do v a -> a -> m ()
forall a. v a -> a -> m ()
forall (v :: * -> *) (io :: * -> *) a.
MVarIO v io =>
v a -> a -> io ()
putMVar v a
size (a -> m ()) -> (a -> a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Enum a => a -> a
pred (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v a -> m a
forall a. v a -> m a
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => v a -> io a
takeMVar v a
size
Interface m i o -> m i
forall (m :: * -> *) i o. Interface m i o -> m i
Net.rx Interface m i o
wire
Interface m i o -> m (Interface m i o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Interface{rx :: m i
rx=m i
rx,tx :: o -> m ()
tx=o -> m ()
tx}
timedWire :: () -> m (TimedInterface m o o)
timedWire () =
do c (Either (r ()) o)
channel <- m (c (Either (r ()) o))
forall a. m (c a)
forall (c :: * -> *) (io :: * -> *) a. ChannelIO c io => io (c a)
newChan
let rxTimeout :: Int -> m (Maybe o)
rxTimeout Int
t =
do r ()
u <- () -> m (r ())
forall a. a -> m (r a)
forall (r :: * -> *) (io :: * -> *) a. RefIO r io => a -> io (r a)
newRef ()
ThreadId
t <- m () -> m ThreadId
forall (io :: * -> *). ForkIO io => io () -> io ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ do Int -> m ()
forall (io :: * -> *). DelayIO io => Int -> io ()
delay Int
t ; c (Either (r ()) o) -> Either (r ()) o -> m ()
forall a. c a -> a -> m ()
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> a -> io ()
writeChan c (Either (r ()) o)
channel (r () -> Either (r ()) o
forall a b. a -> Either a b
Left r ()
u)
let read :: m (Maybe o)
read = do Either (r ()) o
m <- c (Either (r ()) o) -> m (Either (r ()) o)
forall a. c a -> m a
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> io a
readChan c (Either (r ()) o)
channel
case Either (r ()) o
m of
Right o
x -> Maybe o -> m (Maybe o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> Maybe o
forall a. a -> Maybe a
Just o
x)
Left r ()
v | r ()
vr () -> r () -> Bool
forall a. Eq a => a -> a -> Bool
==r ()
u -> Maybe o -> m (Maybe o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe o
forall a. Maybe a
Nothing
| Bool
otherwise -> m (Maybe o)
read
Maybe o
x <- m (Maybe o)
read
ThreadId -> m ()
forall (io :: * -> *). ForkIO io => ThreadId -> io ()
kill ThreadId
t
Maybe o -> m (Maybe o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe o
x
rxWait :: m (Maybe o)
rxWait = do Either (r ()) o
m <- c (Either (r ()) o) -> m (Either (r ()) o)
forall a. c a -> m a
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> io a
readChan c (Either (r ()) o)
channel
case Either (r ()) o
m of
Right o
x -> Maybe o -> m (Maybe o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> Maybe o
forall a. a -> Maybe a
Just o
x)
Either (r ()) o
_ -> m (Maybe o)
rxWait
rx :: Maybe Int -> m (Maybe o)
rx = m (Maybe o) -> (Int -> m (Maybe o)) -> Maybe Int -> m (Maybe o)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Maybe o)
rxWait Int -> m (Maybe o)
forall {m :: * -> *}.
(RefIO r m, ForkIO m, DelayIO m, ChannelIO c m) =>
Int -> m (Maybe o)
rxTimeout
tx :: o -> m ()
tx = c (Either (r ()) o) -> Either (r ()) o -> m ()
forall a. c a -> a -> m ()
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> a -> io ()
writeChan c (Either (r ()) o)
channel (Either (r ()) o -> m ()) -> (o -> Either (r ()) o) -> o -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> Either (r ()) o
forall a b. b -> Either a b
Right
TimedInterface m o o -> m (TimedInterface m o o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Int -> m (Maybe o)) -> (o -> m ()) -> TimedInterface m o o
forall (m :: * -> *) i o.
(Maybe Int -> m (Maybe i)) -> (o -> m ()) -> TimedInterface m i o
TimedInterface Maybe Int -> m (Maybe o)
rx o -> m ()
tx)