module Control.Concurrent.CHPSpec.Channels.Creation (
Chan, Channel(..), newChannel, ChanOpts(..), defaultChanOpts, chanLabel, newChannelWR, newChannelRW,
newChannelList, newChannelListWithLabels, newChannelListWithStem,
labelChannel
) where
import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.CHPSpec.Base
import Control.Concurrent.CHPSpec.Channels.Base
import Control.Concurrent.CHPSpec.CSP
import Control.Concurrent.CHPSpec.Spec
class Channel r w where
newChannel' :: MonadCHP m => ChanOpts a -> m (Chan r w a)
sameChannel :: r a -> w a -> Bool
data ChanOpts a = ChanOpts {
chanOptsPriority :: Int,
chanOptsShow :: a -> String,
chanOptsLabel :: Maybe String }
defaultChanOpts :: ChanOpts a
defaultChanOpts = ChanOpts 0 (const "") Nothing
chanLabel :: Show a => String -> ChanOpts a
chanLabel = ChanOpts 0 show . Just
newChannel :: (MonadCHP m, Channel r w) => m (Chan r w a)
newChannel = newChannel' defaultChanOpts
newChannelRW :: (Channel r w, MonadCHP m) => m (r a, w a)
newChannelRW = do c <- newChannel
return (reader c, writer c)
newChannelWR :: (Channel r w, MonadCHP m) => m (w a, r a)
newChannelWR = do c <- newChannel
return (writer c, reader c)
newChannelList :: (Channel r w, MonadCHP m) => Int -> m [Chan r w a]
newChannelList n = replicateM n newChannel
newChannelListWithStem :: (Channel r w, MonadCHP m) => Int -> String -> m [Chan r w a]
newChannelListWithStem n s = sequence [newChannel' $ ChanOpts 0 (const "") (Just $ s ++ show i) | i <- [0 .. (n 1)]]
newChannelListWithLabels :: (Channel r w, MonadCHP m) => [String] -> m [Chan r w a]
newChannelListWithLabels = mapM (newChannel' . ChanOpts 0 (const "") . Just)
labelChannel :: MonadCHP m => Chan r w a -> String -> m ()
labelChannel c = liftCHP . lift . labelEvent (getChannelIdentifier c)
instance Channel Chanin Chanout where
newChannel' o = do c <- chan (stmChannel) Chanin Chanout
maybe (return ()) (labelChannel c) (chanOptsLabel o)
return c
sameChannel (Chanin x) (Chanout y) = x == y
instance Channel (Shared Chanin) Chanout where
newChannel' o = do
c <- newChannel' o
return $ Chan (getChannelIdentifier c) (Shared (reader c)) (writer c)
sameChannel (Shared (Chanin x)) (Chanout y) = x == y
instance Channel Chanin (Shared Chanout) where
newChannel' o = do
c <- newChannel' o
return $ Chan (getChannelIdentifier c) (reader c) (Shared (writer c))
sameChannel (Chanin x) (Shared (Chanout y)) = x == y
instance Channel (Shared Chanin) (Shared Chanout) where
newChannel' o = do
c <- newChannel' o
return $ Chan (getChannelIdentifier c) (Shared (reader c)) (Shared (writer c))
sameChannel (Shared (Chanin x)) (Shared (Chanout y)) = x == y
chan :: Monad m => m (EventId, c a) -> (c a -> r a) -> (c a -> w a) -> m (Chan r w a)
chan m r w = do (u, x) <- m
return $ Chan u (r x) (w x)