-- | Pure interface to @fd_set@.
--
-- As far as I can tell, the data structure and functions in
-- "System.Posix.IO.Select.FdSet" are referentially transparent, and
-- it should be OK to escape the 'IO' monad. However, POSIX requires
-- that all operations on @fd_set@s are done with /valid/ file
-- descriptors. This can potentially be hard to ensure with lazy
-- evaluation in a pure setting, so for now this module bears the
-- unsafe label. On Linux, invalid file descriptors /seem/ to be just
-- fine.
--
--  See "System.Posix.IO.Select.FdSet" for documentation in
--  general. All functions here essentially just add
--  'UNSAFE.unsafePerformIO'.
module System.Posix.IO.Select.FdSet.Unsafe (F.FdSet(), fromList, insert, insertList,
                                    elem, remove, removeList, inList,
                                    empty, unsafeToList) where

import Prelude hiding (elem)
import System.Posix.Types
import qualified System.Posix.IO.Select.FdSet as F
import qualified System.IO.Unsafe as UNSAFE

fromList :: [Fd] -> F.FdSet
fromList = UNSAFE.unsafePerformIO . F.fromList

empty :: F.FdSet
empty = UNSAFE.unsafePerformIO F.empty

insert :: Fd -> F.FdSet -> F.FdSet
insert fd fdset = UNSAFE.unsafePerformIO (F.insert fd fdset)

insertList :: [Fd] -> F.FdSet -> F.FdSet
insertList fds fdset = UNSAFE.unsafePerformIO (F.insertList fds fdset)

elem :: Fd -> F.FdSet -> Bool
elem fd fdset = UNSAFE.unsafePerformIO (F.elem fd fdset)

remove :: Fd -> F.FdSet -> F.FdSet
remove fd fdset = UNSAFE.unsafePerformIO (F.remove fd fdset)

removeList :: [Fd] -> F.FdSet -> F.FdSet
removeList fds fdset = UNSAFE.unsafePerformIO (F.removeList fds fdset)

inList :: [Fd] -> F.FdSet -> [Fd]
inList fds fdset = UNSAFE.unsafePerformIO (F.inList fds fdset)

-- toList :: F.FdSet -> [Fd]
-- toList = UNSAFE.unsafePerformIO . F.toList

-- | This converts an 'FdSet' to a list by testing every file
-- descriptor in range for membership, which tends to involve invalid
-- file descriptors, giving undefined behavior according to POSIX. Use
-- 'inList' if possible.
unsafeToList :: F.FdSet -> [Fd]
unsafeToList fdset = inList [(fromIntegral 0)..(F.bound fdset)] fdset