{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

-- | Concurrency primitives abstracted away from the IO monad
module Net.Concurrent where
import Control.Monad.Trans
import Control.Concurrent(ThreadId)

class (Functor io,Monad io) => ForkIO io where
  fork :: io () -> io ThreadId
  kill :: ThreadId -> io ()

class (Functor io,Monad io) => DelayIO io where
  delay :: Int -> io () -- microseconds

class (Functor io,Monad io) => ChannelIO c io | io->c where
  newChan :: io (c a)
  readChan :: c a -> io a
  writeChan :: c a -> a -> io ()
--isEmptyChan :: c a -> io Bool

class (Functor io,Monad io) => MVarIO v io | io->v where
  newEmptyMVar :: io (v a)
  newMVar :: a -> io (v a)
  putMVar :: v a -> a -> io ()
  takeMVar, readMVar :: v a -> io a
--tryPutMVar :: v a -> a -> io Bool
--withMVar :: v a -> (a -> io b) -> io b

  newMVar a
a = do v a
v <- io (v a)
forall a. io (v a)
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => io (v a)
newEmptyMVar
		 v a -> a -> io ()
forall a. v a -> a -> io ()
forall (v :: * -> *) (io :: * -> *) a.
MVarIO v io =>
v a -> a -> io ()
putMVar v a
v a
a
		 v a -> io (v a)
forall a. a -> io a
forall (m :: * -> *) a. Monad m => a -> m a
return v a
v

class (Functor io,Monad io) => RefIO r io | io->r where
  newRef :: a -> io (r a)
  readRef :: r a -> io a
  writeRef :: r a -> a -> io ()

instance (MonadTrans t,Monad m,Functor (t m),Monad (t m),DelayIO m) => DelayIO (t m) where
  delay :: Int -> t m ()
delay = m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> (Int -> m ()) -> Int -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (io :: * -> *). DelayIO io => Int -> io ()
delay

instance (MonadTrans t,Monad m,Functor (t m),Monad (t m),ChannelIO c m) => ChannelIO c (t m) where
  newChan :: forall a. t m (c a)
newChan = m (c a) -> t m (c a)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (c a)
forall a. m (c a)
forall (c :: * -> *) (io :: * -> *) a. ChannelIO c io => io (c a)
newChan
  readChan :: forall a. c a -> t m a
readChan c a
c = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> m a -> t m a
forall a b. (a -> b) -> a -> b
$ c a -> m a
forall a. c a -> m a
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> io a
readChan c a
c
  writeChan :: forall a. c a -> a -> t m ()
writeChan c a
c a
x = m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ c a -> a -> m ()
forall a. c a -> a -> m ()
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> a -> io ()
writeChan c a
c a
x

instance (MonadTrans t,Monad m,Functor (t m),Monad (t m),MVarIO v m) => MVarIO v (t m) where
  newEmptyMVar :: forall a. t m (v a)
newEmptyMVar = m (v a) -> t m (v a)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (v a)
forall a. m (v a)
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => io (v a)
newEmptyMVar
  putMVar :: forall a. v a -> a -> t m ()
putMVar v a
v a
x = m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ v a -> a -> m ()
forall a. v a -> a -> m ()
forall (v :: * -> *) (io :: * -> *) a.
MVarIO v io =>
v a -> a -> io ()
putMVar v a
v a
x
  takeMVar :: forall a. v a -> t m a
takeMVar v a
v = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> m a -> t m a
forall a b. (a -> b) -> a -> 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
v
  readMVar :: forall a. v a -> t m a
readMVar v a
v = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> m a -> t m a
forall a b. (a -> b) -> a -> b
$ v a -> m a
forall a. v a -> m a
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => v a -> io a
readMVar v a
v


instance (MonadTrans t,Monad m,Functor (t m),Monad (t m),RefIO c m) => RefIO c (t m) where
  newRef :: forall a. a -> t m (c a)
newRef = m (c a) -> t m (c a)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (c a) -> t m (c a)) -> (a -> m (c a)) -> a -> t m (c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (c a)
forall a. a -> m (c a)
forall (r :: * -> *) (io :: * -> *) a. RefIO r io => a -> io (r a)
newRef
  readRef :: forall a. c a -> t m a
readRef c a
c = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> m a -> t m a
forall a b. (a -> b) -> a -> b
$ c a -> m a
forall a. c a -> m a
forall (r :: * -> *) (io :: * -> *) a. RefIO r io => r a -> io a
readRef c a
c
  writeRef :: forall a. c a -> a -> t m ()
writeRef c a
c a
x = m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ c a -> a -> m ()
forall a. c a -> a -> m ()
forall (r :: * -> *) (io :: * -> *) a.
RefIO r io =>
r a -> a -> io ()
writeRef c a
c a
x