packages feed

select 0.1 → 0.2

raw patch · 5 files changed

+72/−26 lines, 5 files

Files

example/Example.hs view
@@ -2,12 +2,13 @@  import System.Posix.IO -import qualified System.Posix.IO.Select as S import System.Posix.IO.Select.STM+import Control.Concurrent.STM.RunOrElse import qualified System.Posix.IO.Select.MVar as M import Control.Concurrent import Control.Concurrent.STM.TMVar import Control.Concurrent.STM+import Control.Concurrent.STM.TChan   flags :: OpenFileFlags@@ -18,11 +19,15 @@     newEmptyTMVarIO >>= \t ->     forkIO (interruptor t) >>     putStrLn "The interruptor has been launched." >>+    newTChanIO >>= \c ->+    forkIO (interruptor2 c) >>+    putStrLn "The TChan interruptor has been launched." >>     openFd "fifo" ReadOnly Nothing flags >>= \fd ->      openFd "fifo2" ReadOnly Nothing flags >>= \fd2 ->      openFd "fifo3" ReadOnly Nothing flags >>= \fd3 ->      openFd "fifo4" ReadOnly Nothing flags >>= \fd4 ->      putStrLn "The file was opened, so let the waiting game begin!" >>+    --selectOrReadTChan [fd,fd2,fd3,fd4] [] [] (Time 15 0) c >>= \ret ->     selectOrTakeTMVar [fd,fd2,fd3,fd4] [] [] (Time 15 0) t >>= \ret ->         case ret of           Left 0 -> putStrLn "select() timed out on the files."@@ -32,3 +37,7 @@ interruptor :: TMVar String -> IO () interruptor t = threadDelay (10 * 1000000) >>                 atomically (putTMVar t "Bwahahaha, the interruptor was first!")++interruptor2 :: TChan String -> IO ()+interruptor2 c = threadDelay (10 * 1000000) >>+                 atomically (writeTChan c "Bwhaha, TChan interruptor was first!")
select.cabal view
@@ -1,5 +1,5 @@ Name:                select-Version:             0.1+Version:             0.2 Synopsis:            Give the select(2) POSIX function a simple STM interface Homepage:            http://nonempty.org/software/haskell-select License:             BSD3@@ -23,21 +23,30 @@ 		     ["Control.Concurrent.STM.TMVarIO"] and "Control.Concurrent.MVarIO" put the 		     return value of IO actions into a 'TMVar' or an 'MVar', respectively. 		     .-		     ["System.Posix.IO.Select.STM"] and "System.Posix.IO.Select.MVar" do the above for-		     @select@.+		     ["Control.Concurrent.STM.RunOrElse"] defines functions that give you+		     the return value of whatever finishes first of an IO action and an STM+		     operation. 		     .+		     ["System.Posix.IO.Select.STM"] and "System.Posix.IO.Select.MVar" do the above+		     for the special case @select@.+		     . 		     /NOTE/: I feel I'm occupying prime namespace realestate with a package name 		     like select. I'll happily let myself be chased away if anybody else wants 		     to use this package name. Let me know. 		     .-		     /CAVEAT/: I'm not an experienced Haskeller, and this is my first foray into-		     FFI in general.+		     /NOTE 2/: The vector dependency comes from me not spending time figuring out+		     how to pass lists of data to C without first turning them into vectors. It'll+		     probably disappear soon.+		     .+		     /CAVEAT/: I'm not an experienced Haskeller (as you can tell from note 2), and+		     this is my first foray into FFI in general. Use with caution.    Library   Exposed-modules:     Control.Concurrent.MVarIO,                        Control.Concurrent.STM.TMVarIO,+                       Control.Concurrent.STM.RunOrElse,                        System.Posix.IO.Select,                        System.Posix.IO.Select.STM,                        System.Posix.IO.Select.Types,
+ src/Control/Concurrent/STM/RunOrElse.hs view
@@ -0,0 +1,32 @@+module Control.Concurrent.STM.RunOrElse(runOrElse, runOrTakeTMVar) where++import Control.Applicative+import Control.Concurrent.STM+import Control.Concurrent.STM.TMVarIO++-- | @'runOrElse' action stm@ runs the IO action @action@ and attempts+-- the STM operation @stm@, returning the return value which is+-- available first. If @action@ returns first, then @stm@ is not+-- run. If @stm@ returns first, @action@ may or may not complete, but+-- its return value is discarded.+--+-- 'runOrTakeTMVar' is a special case+-- of this function, where @stm@ is simply 'takeTMVar' applied to the+-- given 'TMVar'.+runOrElse :: IO a -> STM b -> IO (Either a b)+runOrElse action stm = run action >>= \tm ->+                       atomically ((Left <$> takeTMVar tm) `orElse` (Right <$> stm))++-- | This version of 'Control.Concurrent.STM.TMVarIO.run' takes an+-- additional 'TMVar', and returns its content /or/ the result of the+-- IO action, depending on which is available first. Note that the+-- action is /not/ interrupted if the 'TMVar' is the winner, so you+-- may want to make sure it doesn't stick around forever.+--+-- @'runOrTakeTMVar' action tm = 'runOrElse' action ('takeTMVar' tm)@.+--+-- The function was originally made to support+-- 'System.Posix.IO.Select.STM.selectOrTakeTMVar', the reason this+-- library exists.+runOrTakeTMVar :: IO a -> TMVar b -> IO (Either a b)+runOrTakeTMVar action tm = runOrElse action (takeTMVar tm)
src/Control/Concurrent/STM/TMVarIO.hs view
@@ -1,6 +1,6 @@ -- | Perform an IO action, and place its result in a 'TMVar'.  See -- also "Control.Concurrent.MVarIO" for an 'MVar' version.-module Control.Concurrent.STM.TMVarIO (run, runOrTakeTMVar) where+module Control.Concurrent.STM.TMVarIO (run) where  import Data.Functor import Control.Concurrent@@ -14,19 +14,6 @@ run action = newEmptyTMVarIO >>= \tm ->              forkIO (run' action tm) >>              return tm---- | This version of 'run' takes an additional 'TMVar', and returns--- its content /or/ the result of the IO action, depending on which is--- available first. Note that the action is /not/ interrupted if the--- 'TMVar' is the winner, so you may want to make sure it doesn't--- stick around forever.------ The function was made to support--- 'System.Posix.IO.Select.STM.selectOrTakeTMVar', the reason this--- library exists, and may not be useful outside of that context.-runOrTakeTMVar :: IO a -> TMVar b -> IO (Either a b)-runOrTakeTMVar action tm1 = run action >>= \tm2 ->-                            atomically ((Left <$> takeTMVar tm2) `orElse` (Right <$> takeTMVar tm1))  run' :: IO a -> TMVar a -> IO () run' action tm = action >>= \ret ->
src/System/Posix/IO/Select/STM.hs view
@@ -1,11 +1,12 @@ -- | Treat the POSIX @select(2)@ function as a 'TMVar' 'CInt'. -module System.Posix.IO.Select.STM (select, selectOrTakeTMVar, Timeout(Never, Time)) where+module System.Posix.IO.Select.STM (select, selectOrTakeTMVar, selectOrElse, selectOrReadTChan, Timeout(Never, Time)) where  import System.Posix.IO.Select.Types import qualified System.Posix.IO.Select as S import Foreign.C.Types import Control.Concurrent.STM+import qualified Control.Concurrent.STM.RunOrElse as ROE import qualified Control.Concurrent.STM.TMVarIO as TIO import System.Posix.Types @@ -26,12 +27,20 @@ -- returns before the 'TMVar' is available, the 'TMVar' is guaranteed -- to be left in place. --+-- See also 'selectOrReadTChan' and 'selectOrElse'. Note that+-- 'selectOrTakeTMVar' and the former are special cases of the latter.+-- -- (Incidentally, 'selectOrTakeTMVar' is the task I really wanted to -- accomplish, and solving it just turned into this little library). selectOrTakeTMVar :: [Fd] -> [Fd] -> [Fd] -> Timeout -> TMVar a -> IO (Either CInt a)-selectOrTakeTMVar readFds writeFds exceptFds timeout mv = TIO.runOrTakeTMVar (S.select readFds writeFds exceptFds timeout) mv+selectOrTakeTMVar readFds writeFds exceptFds timeout mv = selectOrElse readFds writeFds exceptFds timeout (takeTMVar mv) --- selectOrTakeTMVar :: [Fd] -> [Fd] -> [Fd] -> Timeout -> TMVar a -> IO (Either CInt a)--- selectOrTakeTMVar readFds writeFds exceptFds timeout tMVar1 =---     select readFds writeFds exceptFds timeout >>= \tMVar2 ->---     atomically ((Left <$> takeTMVar tMVar2) `orElse` (Right <$> takeTMVar tMVar1))+-- | Analogous to 'selectOrTakeTMVar', except with a general STM+-- action in place of taking a 'TMVar'.+selectOrElse :: [Fd] -> [Fd] -> [Fd] -> Timeout -> STM a -> IO (Either CInt a)+selectOrElse readFds writeFds exceptFds timeout stm = ROE.runOrElse (S.select readFds writeFds exceptFds timeout) stm++-- | Special case of 'selectOrElse' where the STM action is reading a+-- 'TChan'.+selectOrReadTChan :: [Fd] -> [Fd] -> [Fd] -> Timeout -> TChan a -> IO (Either CInt a)+selectOrReadTChan readFds writeFds exceptFds timeout tc = selectOrElse readFds writeFds exceptFds timeout (readTChan tc)