-- | Treat the POSIX @select(2)@ function as a 'TMVar' 'CInt'.

module System.Posix.IO.Select.STM (select, selectOrTakeTMVar, 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.TMVarIO as TIO
import System.Posix.Types

-- | This version of 'S.select' immediately returns and makes the
-- return value of the @select(2)@ call available as a 'TMVar'
-- 'CInt'. See 'S.select' for argument information.
select :: [Fd] -> [Fd] -> [Fd] -> Timeout -> IO (TMVar CInt)
select readFds writeFds exceptFds timeout = TIO.run (S.select readFds writeFds exceptFds timeout)

-- | The parameters are the same as for 'select', except for the
-- addition of a 'TMVar'. The function returns as soon as either the
-- @select(2)@ has completed, or the 'TMVar' is full. 
--
-- The return value is either the return value of @select(2)@, or the
-- content of the 'TMVar'. If the 'TMVar' becomes available first,
-- then the @select(2)@ call may hang around forever or until it times
-- out (as specified by the 'Timeout' parameter). If the @select(2)@
-- returns before the 'TMVar' is available, the 'TMVar' is guaranteed
-- to be left in place.
--
-- (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 :: [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))