{-# LINE 1 "src/System/Posix/Poll.hsc" #-}
module System.Posix.Poll (
  Fd(..),
  Event(..),
  Events,
  inp, pri, out, err, hup, nVal,
  ) where



import Foreign.C.Types (CShort, )
import Foreign.Storable
          (Storable(sizeOf, alignment, peek, poke),
           peekByteOff, pokeByteOff, )
import qualified System.Posix.Types as Posix
import Data.Ix (Ix, range, index, inRange, rangeSize, )
import Data.Maybe (fromMaybe, )
import qualified Data.Ix.Enum as IxEnum
import qualified Data.EnumBitSet as EnumSet

data Event 
  = Other Int
  | In
  | Pri
  | Out
  | Err
  | Hup
  | NVal
  deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Eq Event
Eq Event
-> (Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Ord, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

eventFlagSet :: Event -> Events
eventFlagSet :: Event -> Events
eventFlagSet Event
cap =
   case Event
cap of
      Other Int
n -> Int -> Events
forall w a. Bits w => Int -> T w a
EnumSet.singletonByPosition Int
n
      Event
In      -> Events
inp
      Event
Pri     -> Events
pri
      Event
Out     -> Events
out
      Event
Err     -> Events
err
      Event
Hup     -> Events
hup
      Event
NVal    -> Events
nVal

{- |
The Enum instance may not be very efficient,
but it should hardly be used, at all.
Better use constants such as 'inp' and set manipulation.
If the binary logarithm is computed by constant unfolding,
performance would be better, but direct set manipulation is still faster.
We implement the 'Enum' instance in this way,
in order to stay independent from the particular Poll definitions,
that may differ between platforms.
-}
instance Enum Event where
   fromEnum :: Event -> Int
fromEnum Event
cap =
      case Event
cap of
         Other Int
n -> Int
n
         Event
_ -> Events -> Int
forall w a. (Bits w, Storable w) => T w a -> Int
EnumSet.mostSignificantPosition (Event -> Events
eventFlagSet Event
cap)
   toEnum :: Int -> Event
toEnum Int
n =
      Event -> Maybe Event -> Event
forall a. a -> Maybe a -> a
fromMaybe (Int -> Event
Other Int
n) (Maybe Event -> Event) -> Maybe Event -> Event
forall a b. (a -> b) -> a -> b
$
      Events -> [(Events, Event)] -> Maybe Event
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Int -> Events
forall w a. Bits w => Int -> T w a
EnumSet.singletonByPosition Int
n) ([(Events, Event)] -> Maybe Event)
-> [(Events, Event)] -> Maybe Event
forall a b. (a -> b) -> a -> b
$
      (Event -> (Events, Event)) -> [Event] -> [(Events, Event)]
forall a b. (a -> b) -> [a] -> [b]
map (\Event
ev -> (Event -> Events
eventFlagSet Event
ev, Event
ev)) ([Event] -> [(Events, Event)]) -> [Event] -> [(Events, Event)]
forall a b. (a -> b) -> a -> b
$
         Event
In Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:
         Event
Pri Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:
         Event
Out Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:
         Event
Err Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:
         Event
Hup Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:
         Event
NVal Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:
         []

instance Ix Event where
   range :: (Event, Event) -> [Event]
range     = (Event, Event) -> [Event]
forall a. Enum a => (a, a) -> [a]
IxEnum.range
   index :: (Event, Event) -> Event -> Int
index     = (Event, Event) -> Event -> Int
forall a. Enum a => (a, a) -> a -> Int
IxEnum.index
   inRange :: (Event, Event) -> Event -> Bool
inRange   = (Event, Event) -> Event -> Bool
forall a. Enum a => (a, a) -> a -> Bool
IxEnum.inRange
   rangeSize :: (Event, Event) -> Int
rangeSize = (Event, Event) -> Int
forall a. Enum a => (a, a) -> Int
IxEnum.rangeSize

{-
pollMask :: PollEvent -> CShort
pollMask PollIn	  = #{const POLLIN}
pollMask PollPri  = #{const POLLPRI}
pollMask PollOut  = #{const POLLOUT}
pollMask PollErr  = #{const POLLERR}
pollMask PollHup  = #{const POLLHUP}
pollMask PollNVal = #{const POLLNVAL}
-}

inp, pri, out, err, hup, nVal :: Events
inp :: Events
inp  = CShort -> Events
forall word index. word -> T word index
EnumSet.Cons CShort
1
{-# LINE 86 "src/System/Posix/Poll.hsc" #-}
pri  = EnumSet.Cons 2
{-# LINE 87 "src/System/Posix/Poll.hsc" #-}
out  = EnumSet.Cons 4
{-# LINE 88 "src/System/Posix/Poll.hsc" #-}
err  = EnumSet.Cons 8
{-# LINE 89 "src/System/Posix/Poll.hsc" #-}
hup  = EnumSet.Cons 16
{-# LINE 90 "src/System/Posix/Poll.hsc" #-}
nVal = EnumSet.Cons 32
{-# LINE 91 "src/System/Posix/Poll.hsc" #-}


type Events = EnumSet.T CShort Event

data Fd = Fd
  { Fd -> Fd
fd :: Posix.Fd
  , Fd -> Events
events :: Events
  , Fd -> Events
rEvents :: Events
  }

instance Storable Fd where
  sizeOf :: Fd -> Int
sizeOf Fd
_    = (Int
8)
{-# LINE 103 "src/System/Posix/Poll.hsc" #-}
  alignment _ = 4
  peek :: Ptr Fd -> IO Fd
peek Ptr Fd
p      = do
    CInt
f <- (\Ptr Fd
hsc_ptr -> Ptr Fd -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Fd
hsc_ptr Int
0)      Ptr Fd
p
{-# LINE 106 "src/System/Posix/Poll.hsc" #-}
    e <- (\hsc_ptr -> peekByteOff hsc_ptr 4)  p
{-# LINE 107 "src/System/Posix/Poll.hsc" #-}
    r <- (\hsc_ptr -> peekByteOff hsc_ptr 6) p
{-# LINE 108 "src/System/Posix/Poll.hsc" #-}
    return $ Fd (Posix.Fd f) e r
  poke :: Ptr Fd -> Fd -> IO ()
poke Ptr Fd
p (Fd (Posix.Fd CInt
f) Events
e Events
r) = do
    (\Ptr Fd
hsc_ptr -> Ptr Fd -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Fd
hsc_ptr Int
0)      Ptr Fd
p CInt
f
{-# LINE 111 "src/System/Posix/Poll.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4)  p e
{-# LINE 112 "src/System/Posix/Poll.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 6) p r
{-# LINE 113 "src/System/Posix/Poll.hsc" #-}