diff options
Diffstat (limited to 'lib/Phi/Phi.hs')
| -rw-r--r-- | lib/Phi/Phi.hs | 16 |
1 files changed, 10 insertions, 6 deletions
diff --git a/lib/Phi/Phi.hs b/lib/Phi/Phi.hs index 3f4b59b..ab384a0 100644 --- a/lib/Phi/Phi.hs +++ b/lib/Phi/Phi.hs @@ -8,15 +8,16 @@ module Phi.Phi ( Phi , dupPhi , sendMessage , receiveMessage + , messageAvailable ) where -import Control.Concurrent.Chan +import Control.Concurrent.STM import Control.Monad import Control.Monad.IO.Class import Data.Typeable -data Phi = Phi (Chan Message) +data Phi = Phi (TChan Message) data Message = forall a. (Typeable a, Show a) => Message a deriving instance Show Message @@ -27,13 +28,16 @@ fromMessage :: (Typeable a, Show a) => Message -> Maybe a fromMessage (Message m) = cast m initPhi :: MonadIO m => m Phi -initPhi = liftM Phi $ liftIO newChan +initPhi = liftM Phi $ liftIO $ atomically newTChan dupPhi :: MonadIO m => Phi -> m Phi -dupPhi (Phi chan) = liftM Phi $ liftIO $ dupChan chan +dupPhi (Phi chan) = liftM Phi $ liftIO $ atomically $ dupTChan chan sendMessage :: (MonadIO m, Typeable a, Show a) => Phi -> a -> m () -sendMessage (Phi chan) = liftIO . writeChan chan . Message +sendMessage (Phi chan) = liftIO . atomically . writeTChan chan . Message receiveMessage :: MonadIO m => Phi -> m Message -receiveMessage (Phi chan) = liftIO $ readChan chan +receiveMessage (Phi chan) = liftIO $ atomically $ readTChan chan + +messageAvailable :: MonadIO m => Phi -> m Bool +messageAvailable (Phi chan) = liftIO $ liftM not $ atomically $ isEmptyTChan chan |