{-# language BangPatterns #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language UnliftedFFITypes #-}
module Posix.MessageQueue
( open
, uninterruptibleReceiveByteArray
, uninterruptibleSendBytes
, AccessMode(..)
, CreationFlags(..)
, StatusFlags(..)
, F.readOnly
, F.writeOnly
, F.readWrite
, F.nonblocking
) where
import Data.Bits ((.|.))
import GHC.Exts (RealWorld,ByteArray#,MutableByteArray#,Addr#)
import GHC.Exts (Int(I#))
import System.Posix.Types (Fd(..),CSsize(..))
import Foreign.C.Types (CInt(..),CSize(..),CUInt(..))
import Foreign.C.Error (Errno,getErrno)
import Foreign.C.String (CString)
import Data.Primitive (MutableByteArray(..),ByteArray(..))
import Data.Bytes.Types (Bytes(Bytes))
import Posix.File.Types (CreationFlags(..),AccessMode(..),StatusFlags(..))
import qualified GHC.Exts as Exts
import qualified Data.Primitive as PM
import qualified Control.Monad.Primitive as PM
import qualified Posix.File.Types as F
foreign import ccall unsafe "mqueue.h mq_receive"
c_unsafe_mq_receive :: Fd -> MutableByteArray# RealWorld
-> CSize -> Addr# -> IO CSsize
foreign import ccall unsafe "mqueue.h mq_send_offset"
c_unsafe_mq_send_offset :: Fd
-> ByteArray# -> Int -> CSize -> CUInt -> IO CInt
foreign import ccall safe "mqueue.h mq_open"
c_safe_mq_open :: CString -> CInt -> IO Fd
open ::
CString
-> AccessMode
-> CreationFlags
-> StatusFlags
-> IO (Either Errno Fd)
open :: CString
-> AccessMode
-> CreationFlags
-> StatusFlags
-> IO (Either Errno Fd)
open !CString
name (AccessMode CInt
x) (CreationFlags CInt
y) (StatusFlags CInt
z) =
CString -> CInt -> IO Fd
c_safe_mq_open CString
name (CInt
x forall a. Bits a => a -> a -> a
.|. CInt
y forall a. Bits a => a -> a -> a
.|. CInt
z) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
uninterruptibleReceiveByteArray ::
Fd
-> CSize
-> IO (Either Errno ByteArray)
uninterruptibleReceiveByteArray :: Fd -> CSize -> IO (Either Errno ByteArray)
uninterruptibleReceiveByteArray !Fd
fd !CSize
len = do
m :: MutableByteArray RealWorld
m@(MutableByteArray MutableByteArray# RealWorld
m# ) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (CSize -> Int
csizeToInt CSize
len)
CSsize
r <- Fd -> MutableByteArray# RealWorld -> CSize -> Addr# -> IO CSsize
c_unsafe_mq_receive Fd
fd MutableByteArray# RealWorld
m# CSize
len Addr#
Exts.nullAddr#
case CSsize
r of
(-1) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
CSsize
_ -> do
let sz :: Int
sz = CSsize -> Int
cssizeToInt CSsize
r
MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray MutableByteArray RealWorld
m Int
sz
ByteArray
a <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
m
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ByteArray
a)
uninterruptibleSendBytes ::
Fd
-> Bytes
-> CUInt
-> IO (Either Errno ())
uninterruptibleSendBytes :: Fd -> Bytes -> CUInt -> IO (Either Errno ())
uninterruptibleSendBytes !Fd
fd (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) CUInt
pri =
Fd -> ByteArray# -> Int -> CSize -> CUInt -> IO CInt
c_unsafe_mq_send_offset Fd
fd ByteArray#
arr Int
off (Int -> CSize
intToCSize Int
len) CUInt
pri
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
shrinkMutableByteArray :: MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray :: MutableByteArray RealWorld -> Int -> IO ()
shrinkMutableByteArray (MutableByteArray MutableByteArray# RealWorld
arr) (I# Int#
sz) =
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
PM.primitive_ (forall d. MutableByteArray# d -> Int# -> State# d -> State# d
Exts.shrinkMutableByteArray# MutableByteArray# RealWorld
arr Int#
sz)
cssizeToInt :: CSsize -> Int
cssizeToInt :: CSsize -> Int
cssizeToInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
csizeToInt :: CSize -> Int
csizeToInt :: CSize -> Int
csizeToInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
intToCSize :: Int -> CSize
intToCSize :: Int -> CSize
intToCSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ CInt
r = if CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd Fd
r = if Fd
r forall a. Ord a => a -> a -> Bool
> (-Fd
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right Fd
r)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno