{-# OPTIONS_GHC -optc-D_GNU_SOURCE #-}
{-# LINE 1 "src/Posix/Poll/Types.hsc" #-}
{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language DataKinds #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language GADTSyntax #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language KindSignatures #-}
{-# language NamedFieldPuns #-}
{-# language TypeApplications #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language PolyKinds #-}
{-# language DataKinds #-}

-- This is needed because hsc2hs does not currently handle ticked
-- promoted data constructors correctly.
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}





-- | All of the data constructors provided by this module are unsafe.
--   Only use them if you really know what you are doing.
module Posix.Poll.Types
  ( PollFd(..)
  , Exchange(..)
  , input
  , output
  , error
  , hangup
  , invalid
  , isSubeventOf
  ) where

import Prelude hiding (truncate,error)

import Data.Bits ((.|.),(.&.))
import Data.Primitive (Prim(..))
import Foreign.C.Types (CInt(..),CShort)
import Foreign.Storable (Storable(..))
import GHC.Exts (Int(I#),Int#,(+#),(*#))
import System.Posix.Types (Fd(..))

import qualified Data.Kind
import qualified Data.Primitive as PM

data PollFd = PollFd
  { PollFd -> Fd
descriptor :: !Fd
    -- ^ The @fd@ field of @struct pollfd@
  , PollFd -> Event 'Request
request :: !(Event Request)
    -- ^ The @events@ field of @struct pollfd@
  , PollFd -> Event 'Response
response :: !(Event Response)
    -- ^ The @revents@ field of @struct pollfd@
  }

newtype Event :: Exchange -> Data.Kind.Type where
  Event :: CShort -> Event e
  deriving newtype (Event a -> Event a -> Bool
(Event a -> Event a -> Bool)
-> (Event a -> Event a -> Bool) -> Eq (Event a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: Exchange). Event a -> Event a -> Bool
$c== :: forall (a :: Exchange). Event a -> Event a -> Bool
== :: Event a -> Event a -> Bool
$c/= :: forall (a :: Exchange). Event a -> Event a -> Bool
/= :: Event a -> Event a -> Bool
Eq,Ptr (Event a) -> IO (Event a)
Ptr (Event a) -> Int -> IO (Event a)
Ptr (Event a) -> Int -> Event a -> IO ()
Ptr (Event a) -> Event a -> IO ()
Event a -> Int
(Event a -> Int)
-> (Event a -> Int)
-> (Ptr (Event a) -> Int -> IO (Event a))
-> (Ptr (Event a) -> Int -> Event a -> IO ())
-> (forall b. Ptr b -> Int -> IO (Event a))
-> (forall b. Ptr b -> Int -> Event a -> IO ())
-> (Ptr (Event a) -> IO (Event a))
-> (Ptr (Event a) -> Event a -> IO ())
-> Storable (Event a)
forall b. Ptr b -> Int -> IO (Event a)
forall b. Ptr b -> Int -> Event a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: Exchange). Ptr (Event a) -> IO (Event a)
forall (a :: Exchange). Ptr (Event a) -> Int -> IO (Event a)
forall (a :: Exchange). Ptr (Event a) -> Int -> Event a -> IO ()
forall (a :: Exchange). Ptr (Event a) -> Event a -> IO ()
forall (a :: Exchange). Event a -> Int
forall (a :: Exchange) b. Ptr b -> Int -> IO (Event a)
forall (a :: Exchange) b. Ptr b -> Int -> Event a -> IO ()
$csizeOf :: forall (a :: Exchange). Event a -> Int
sizeOf :: Event a -> Int
$calignment :: forall (a :: Exchange). Event a -> Int
alignment :: Event a -> Int
$cpeekElemOff :: forall (a :: Exchange). Ptr (Event a) -> Int -> IO (Event a)
peekElemOff :: Ptr (Event a) -> Int -> IO (Event a)
$cpokeElemOff :: forall (a :: Exchange). Ptr (Event a) -> Int -> Event a -> IO ()
pokeElemOff :: Ptr (Event a) -> Int -> Event a -> IO ()
$cpeekByteOff :: forall (a :: Exchange) b. Ptr b -> Int -> IO (Event a)
peekByteOff :: forall b. Ptr b -> Int -> IO (Event a)
$cpokeByteOff :: forall (a :: Exchange) b. Ptr b -> Int -> Event a -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Event a -> IO ()
$cpeek :: forall (a :: Exchange). Ptr (Event a) -> IO (Event a)
peek :: Ptr (Event a) -> IO (Event a)
$cpoke :: forall (a :: Exchange). Ptr (Event a) -> Event a -> IO ()
poke :: Ptr (Event a) -> Event a -> IO ()
Storable,Addr# -> Int# -> Event a
ByteArray# -> Int# -> Event a
Proxy (Event a) -> Int#
Event a -> Int#
(Proxy (Event a) -> Int#)
-> (Event a -> Int#)
-> (Proxy (Event a) -> Int#)
-> (Event a -> Int#)
-> (ByteArray# -> Int# -> Event a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Event a #))
-> (forall s.
    MutableByteArray# s -> Int# -> Event a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> Event a -> State# s -> State# s)
-> (Addr# -> Int# -> Event a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, Event a #))
-> (forall s. Addr# -> Int# -> Event a -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> Event a -> State# s -> State# s)
-> Prim (Event a)
forall s. Addr# -> Int# -> Int# -> Event a -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, Event a #)
forall s. Addr# -> Int# -> Event a -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> Event a -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Event a #)
forall s.
MutableByteArray# s -> Int# -> Event a -> State# s -> State# s
forall a.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
forall (a :: Exchange). Addr# -> Int# -> Event a
forall (a :: Exchange). ByteArray# -> Int# -> Event a
forall (a :: Exchange). Proxy (Event a) -> Int#
forall (a :: Exchange). Event a -> Int#
forall (a :: Exchange) s.
Addr# -> Int# -> Int# -> Event a -> State# s -> State# s
forall (a :: Exchange) s.
Addr# -> Int# -> State# s -> (# State# s, Event a #)
forall (a :: Exchange) s.
Addr# -> Int# -> Event a -> State# s -> State# s
forall (a :: Exchange) s.
MutableByteArray# s
-> Int# -> Int# -> Event a -> State# s -> State# s
forall (a :: Exchange) s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Event a #)
forall (a :: Exchange) s.
MutableByteArray# s -> Int# -> Event a -> State# s -> State# s
$csizeOfType# :: forall (a :: Exchange). Proxy (Event a) -> Int#
sizeOfType# :: Proxy (Event a) -> Int#
$csizeOf# :: forall (a :: Exchange). Event a -> Int#
sizeOf# :: Event a -> Int#
$calignmentOfType# :: forall (a :: Exchange). Proxy (Event a) -> Int#
alignmentOfType# :: Proxy (Event a) -> Int#
$calignment# :: forall (a :: Exchange). Event a -> Int#
alignment# :: Event a -> Int#
$cindexByteArray# :: forall (a :: Exchange). ByteArray# -> Int# -> Event a
indexByteArray# :: ByteArray# -> Int# -> Event a
$creadByteArray# :: forall (a :: Exchange) s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Event a #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Event a #)
$cwriteByteArray# :: forall (a :: Exchange) s.
MutableByteArray# s -> Int# -> Event a -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Event a -> State# s -> State# s
$csetByteArray# :: forall (a :: Exchange) s.
MutableByteArray# s
-> Int# -> Int# -> Event a -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Event a -> State# s -> State# s
$cindexOffAddr# :: forall (a :: Exchange). Addr# -> Int# -> Event a
indexOffAddr# :: Addr# -> Int# -> Event a
$creadOffAddr# :: forall (a :: Exchange) s.
Addr# -> Int# -> State# s -> (# State# s, Event a #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Event a #)
$cwriteOffAddr# :: forall (a :: Exchange) s.
Addr# -> Int# -> Event a -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Event a -> State# s -> State# s
$csetOffAddr# :: forall (a :: Exchange) s.
Addr# -> Int# -> Int# -> Event a -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Event a -> State# s -> State# s
Prim)

instance Semigroup (Event e) where
  Event CShort
a <> :: Event e -> Event e -> Event e
<> Event CShort
b = CShort -> Event e
forall (e :: Exchange). CShort -> Event e
Event (CShort
a CShort -> CShort -> CShort
forall a. Bits a => a -> a -> a
.|. CShort
b)

instance Monoid (Event e) where
  mempty :: Event e
mempty = CShort -> Event e
forall (e :: Exchange). CShort -> Event e
Event CShort
0

data Exchange = Request | Response

instance Storable PollFd where
  sizeOf :: PollFd -> Int
sizeOf PollFd
_ = (Int
8)
{-# LINE 72 "src/Posix/Poll/Types.hsc" #-}
  alignment _ = alignment (undefined :: CInt)
  peek :: Ptr PollFd -> IO PollFd
peek Ptr PollFd
ptr = do
    Fd
descriptor <- (\Ptr PollFd
hsc_ptr -> Ptr PollFd -> Int -> IO Fd
forall b. Ptr b -> Int -> IO Fd
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PollFd
hsc_ptr Int
0) Ptr PollFd
ptr
{-# LINE 75 "src/Posix/Poll/Types.hsc" #-}
    request <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 76 "src/Posix/Poll/Types.hsc" #-}
    response <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
{-# LINE 77 "src/Posix/Poll/Types.hsc" #-}
    let !pollfd = PollFd{descriptor,request,response}
    PollFd -> IO PollFd
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PollFd
pollfd
  poke :: Ptr PollFd -> PollFd -> IO ()
poke Ptr PollFd
ptr PollFd{Fd
$sel:descriptor:PollFd :: PollFd -> Fd
descriptor :: Fd
descriptor,Event 'Request
$sel:request:PollFd :: PollFd -> Event 'Request
request :: Event 'Request
request,Event 'Response
$sel:response:PollFd :: PollFd -> Event 'Response
response :: Event 'Response
response} = do
    (\Ptr PollFd
hsc_ptr -> Ptr PollFd -> Int -> Fd -> IO ()
forall b. Ptr b -> Int -> Fd -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr PollFd
hsc_ptr Int
0) Ptr PollFd
ptr Fd
descriptor
{-# LINE 81 "src/Posix/Poll/Types.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr request
{-# LINE 82 "src/Posix/Poll/Types.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr response
{-# LINE 83 "src/Posix/Poll/Types.hsc" #-}

unI :: Int -> Int#
unI :: Int -> Int#
unI (I# Int#
i) = Int#
i

instance Prim PollFd where
  sizeOf# :: PollFd -> Int#
sizeOf# PollFd
_ = Int -> Int#
unI (Int
8)
{-# LINE 89 "src/Posix/Poll/Types.hsc" #-}
  alignment# _ = alignment# (undefined :: CInt)
  indexByteArray# :: ByteArray# -> Int# -> PollFd
indexByteArray# ByteArray#
arr Int#
i = PollFd
    { $sel:descriptor:PollFd :: Fd
descriptor = (\ByteArray#
hsc_arr Int#
hsc_ix -> ByteArray# -> Int# -> Fd
forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
hsc_arr (Int#
0# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
2#))) ByteArray#
arr Int#
i
{-# LINE 92 "src/Posix/Poll/Types.hsc" #-}
    , request = (\hsc_arr hsc_ix -> indexByteArray# hsc_arr (2# +# (hsc_ix *# 4#))) arr i
{-# LINE 93 "src/Posix/Poll/Types.hsc" #-}
    , response = (\hsc_arr hsc_ix -> indexByteArray# hsc_arr (3# +# (hsc_ix *# 4#))) arr i
{-# LINE 94 "src/Posix/Poll/Types.hsc" #-}
    }
  writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> PollFd -> State# s -> State# s
writeByteArray# MutableByteArray# s
arr Int#
i PollFd{Fd
$sel:descriptor:PollFd :: PollFd -> Fd
descriptor :: Fd
descriptor,Event 'Request
$sel:request:PollFd :: PollFd -> Event 'Request
request :: Event 'Request
request,Event 'Response
$sel:response:PollFd :: PollFd -> Event 'Response
response :: Event 'Response
response} State# s
s0 = case (\MutableByteArray# s
hsc_arr Int#
hsc_ix -> MutableByteArray# s -> Int# -> Fd -> State# s -> State# s
forall s. MutableByteArray# s -> Int# -> Fd -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
hsc_arr (Int#
0# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
2#))) MutableByteArray# s
arr Int#
i Fd
descriptor State# s
s0 of
{-# LINE 96 "src/Posix/Poll/Types.hsc" #-}
    s1 -> case (\hsc_arr hsc_ix -> writeByteArray# hsc_arr (2# +# (hsc_ix *# 4#))) arr i request s1 of
{-# LINE 97 "src/Posix/Poll/Types.hsc" #-}
      s2 -> (\hsc_arr hsc_ix -> writeByteArray# hsc_arr (3# +# (hsc_ix *# 4#))) arr i response s2
{-# LINE 98 "src/Posix/Poll/Types.hsc" #-}
  readByteArray# arr i s0 = case (\hsc_arr hsc_ix -> readByteArray# hsc_arr (0# +# (hsc_ix *# 2#))) arr i s0 of
{-# LINE 99 "src/Posix/Poll/Types.hsc" #-}
    (# s1, descriptor #) -> case (\hsc_arr hsc_ix -> readByteArray# hsc_arr (2# +# (hsc_ix *# 4#))) arr i s1 of
{-# LINE 100 "src/Posix/Poll/Types.hsc" #-}
      (# s2, request #) -> case (\hsc_arr hsc_ix -> readByteArray# hsc_arr (3# +# (hsc_ix *# 4#))) arr i s2 of
{-# LINE 101 "src/Posix/Poll/Types.hsc" #-}
        (# s3, response #) -> (# s3, PollFd{descriptor,request,response} #)
  setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> PollFd -> State# s -> State# s
setByteArray# = MutableByteArray# s
-> Int# -> Int# -> PollFd -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
PM.defaultSetByteArray#
  indexOffAddr# :: Addr# -> Int# -> PollFd
indexOffAddr# Addr#
arr Int#
i = PollFd
    { $sel:descriptor:PollFd :: Fd
descriptor = (\Addr#
hsc_arr Int#
hsc_ix -> Addr# -> Int# -> Fd
forall a. Prim a => Addr# -> Int# -> a
indexOffAddr# Addr#
hsc_arr (Int#
0# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
2#))) Addr#
arr Int#
i
{-# LINE 105 "src/Posix/Poll/Types.hsc" #-}
    , request = (\hsc_arr hsc_ix -> indexOffAddr# hsc_arr (2# +# (hsc_ix *# 4#))) arr i
{-# LINE 106 "src/Posix/Poll/Types.hsc" #-}
    , response = (\hsc_arr hsc_ix -> indexOffAddr# hsc_arr (3# +# (hsc_ix *# 4#))) arr i
{-# LINE 107 "src/Posix/Poll/Types.hsc" #-}
    }
  writeOffAddr# :: forall s. Addr# -> Int# -> PollFd -> State# s -> State# s
writeOffAddr# Addr#
arr Int#
i PollFd{Fd
$sel:descriptor:PollFd :: PollFd -> Fd
descriptor :: Fd
descriptor,Event 'Request
$sel:request:PollFd :: PollFd -> Event 'Request
request :: Event 'Request
request,Event 'Response
$sel:response:PollFd :: PollFd -> Event 'Response
response :: Event 'Response
response} State# s
s0 = case (\Addr#
hsc_arr Int#
hsc_ix -> Addr# -> Int# -> Fd -> State# s -> State# s
forall s. Addr# -> Int# -> Fd -> State# s -> State# s
forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
hsc_arr (Int#
0# Int# -> Int# -> Int#
+# (Int#
hsc_ix Int# -> Int# -> Int#
*# Int#
2#))) Addr#
arr Int#
i Fd
descriptor State# s
s0 of
{-# LINE 109 "src/Posix/Poll/Types.hsc" #-}
    s1 -> case (\hsc_arr hsc_ix -> writeOffAddr# hsc_arr (2# +# (hsc_ix *# 4#))) arr i request s1 of
{-# LINE 110 "src/Posix/Poll/Types.hsc" #-}
      s2 -> (\hsc_arr hsc_ix -> writeOffAddr# hsc_arr (3# +# (hsc_ix *# 4#))) arr i response s2
{-# LINE 111 "src/Posix/Poll/Types.hsc" #-}
  readOffAddr# arr i s0 = case (\hsc_arr hsc_ix -> readOffAddr# hsc_arr (0# +# (hsc_ix *# 2#))) arr i s0 of
{-# LINE 112 "src/Posix/Poll/Types.hsc" #-}
    (# s1, fdVal #) -> case (\hsc_arr hsc_ix -> readOffAddr# hsc_arr (2# +# (hsc_ix *# 4#))) arr i s1 of
{-# LINE 113 "src/Posix/Poll/Types.hsc" #-}
      (# s2, eventsVal #) -> case (\hsc_arr hsc_ix -> readOffAddr# hsc_arr (3# +# (hsc_ix *# 4#))) arr i s2 of
{-# LINE 114 "src/Posix/Poll/Types.hsc" #-}
        (# s3, reventsVal #) -> (# s3, PollFd fdVal eventsVal reventsVal #)
  setOffAddr# :: forall s. Addr# -> Int# -> Int# -> PollFd -> State# s -> State# s
setOffAddr# = Addr# -> Int# -> Int# -> PollFd -> State# s -> State# s
forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
PM.defaultSetOffAddr#

-- | The @POLLIN@ event.
input :: Event e
input :: forall (e :: Exchange). Event e
input = CShort -> Event e
forall (e :: Exchange). CShort -> Event e
Event CShort
1
{-# LINE 120 "src/Posix/Poll/Types.hsc" #-}

-- | The @POLLOUT@ event.
output :: Event e
output :: forall (e :: Exchange). Event e
output = CShort -> Event e
forall (e :: Exchange). CShort -> Event e
Event CShort
4
{-# LINE 124 "src/Posix/Poll/Types.hsc" #-}

-- | The @POLLERR@ event.
error :: Event Response
error :: Event 'Response
error = CShort -> Event 'Response
forall (e :: Exchange). CShort -> Event e
Event CShort
8
{-# LINE 128 "src/Posix/Poll/Types.hsc" #-}

-- | The @POLLHUP@ event.
hangup :: Event Response
hangup :: Event 'Response
hangup = CShort -> Event 'Response
forall (e :: Exchange). CShort -> Event e
Event CShort
16
{-# LINE 132 "src/Posix/Poll/Types.hsc" #-}

-- | The @POLLNVAL@ event.
invalid :: Event Response
invalid :: Event 'Response
invalid = CShort -> Event 'Response
forall (e :: Exchange). CShort -> Event e
Event CShort
32
{-# LINE 136 "src/Posix/Poll/Types.hsc" #-}

-- | Is the first argument a subset of the second argument?
isSubeventOf :: Event e -> Event e -> Bool
isSubeventOf :: forall (a :: Exchange). Event a -> Event a -> Bool
isSubeventOf (Event CShort
a) (Event CShort
b) = CShort
a CShort -> CShort -> CShort
forall a. Bits a => a -> a -> a
.&. CShort
b CShort -> CShort -> Bool
forall a. Eq a => a -> a -> Bool
== CShort
a