module Net.Wire where

import Net.Concurrent
import Net.Interface as Net

type Wire m a = Interface m a a

-- | An unbounded buffer
--unbounded :: ChannelIO c m => m (Wire m 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


-- | A bounded buffer that discards input when full
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 -- discard p!
	   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 () -- just something unique
		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)