{-# LINE 1 "System/Posix/Realtime/MQueue.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "System/Posix/Realtime/MQueue.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Realtime.MQueue
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  William N. Halchin (vigalchin@gmail.com) 
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- POSIX 1003.1b message queue support.  
--
-----------------------------------------------------------------------------


module System.Posix.Realtime.MQueue (


    -- ** Message queue attributes data type
    MQAttributes(..),


    -- ** Opening\/closing\/unlinking mqueues
    mqOpen,              --  Name -> OpenMode -> Maybe FileMode -> Maybe MQAttributes -> IO Fd

    mqClose,             --  mqClose :: Fd -> IO ()

    mqUnlink,            --  mqUnlink :: String -> IO ()


    -- ** Sending\/receiving data
    -- |Programmers using the 'mqSend' and 'mqReceive' API should be aware that
    -- EAGAIN exceptions may occur for non-blocking IO!
    mqSend,              --  mqSend :: Fd -> String -> ByteCount -> Int -> IO ()


    mqReceive,           --  Fd -> ByteCount -> Maybe Int -> IO (String, Int)



    -- **  Getting\/Setting mqueue attributes 
    mqGetAttributes,     --  Fd -> IO MQAttributes

    mqSetAttributes,     --  Fd -> MQAttributes -> IO (MQAttributes)


    -- ** Notify receipt of message
    mqNotify             --  Fd -> Maybe Sigevent -> IO ()

  ) where



import System.IO
import System.IO.Error
import System.Posix.Realtime.RTDataTypes
import System.Posix.IO
import System.Posix.Types
import System.Posix.Error
import System.Posix.Internals

import Foreign
import Foreign.C
import Data.Bits



{-# LINE 69 "System/Posix/Realtime/MQueue.hsc" #-}
import GHC.IO
import GHC.IO.Exception
import GHC.IO.Handle hiding (fdToHandle)
import qualified GHC.IO.Handle

{-# LINE 74 "System/Posix/Realtime/MQueue.hsc" #-}


{-# LINE 79 "System/Posix/Realtime/MQueue.hsc" #-}


{-# LINE 81 "System/Posix/Realtime/MQueue.hsc" #-}

{-# LINE 82 "System/Posix/Realtime/MQueue.hsc" #-}


-- -----------------------------------------------------------------------------


type Name = String


-- Message queue attributes data type
data MQAttributes = 
 MQAttributes {
    flags      :: Int,
    maxMsgNum  :: Int,
    maxMsgSize :: Int,
    curNumMsgs :: Int
 }  deriving Show
  

-- | MQAttributes Storable used to marshall and unmarshall to ANSI C
instance Storable MQAttributes where
    sizeOf (MQAttributes flags maxMsgNum maxMsgSize curNumMsgs) = (64)
{-# LINE 103 "System/Posix/Realtime/MQueue.hsc" #-}
    alignment _ = 1
    poke p_attrs (MQAttributes flags maxMsgNum maxMsgSize curNumMsgs) = do
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0))    p_attrs  flags 
{-# LINE 106 "System/Posix/Realtime/MQueue.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8))   p_attrs  maxMsgNum 
{-# LINE 107 "System/Posix/Realtime/MQueue.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 16))  p_attrs  maxMsgSize 
{-# LINE 108 "System/Posix/Realtime/MQueue.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 24))  p_attrs  curNumMsgs 
{-# LINE 109 "System/Posix/Realtime/MQueue.hsc" #-}
    peek p_attrs = do
      flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p_attrs 
{-# LINE 111 "System/Posix/Realtime/MQueue.hsc" #-}
      maxMsgNum <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p_attrs 
{-# LINE 112 "System/Posix/Realtime/MQueue.hsc" #-}
      maxMsgSize <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p_attrs 
{-# LINE 113 "System/Posix/Realtime/MQueue.hsc" #-}
      curNumMsgs <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p_attrs 
{-# LINE 114 "System/Posix/Realtime/MQueue.hsc" #-}
      return (MQAttributes flags maxMsgNum maxMsgSize curNumMsgs)



-- | Open and optionally create this message queue.  See 'System.Posix.Files'
-- |    for information on how to use the 'FileMode' type.
-- | Note: After referring to several mqueue implementations, it seems that the 
-- |   POSIX standard doesn't tightly constrain "Name"'s syntax. E.g. one Linux
-- |   implementation expects that "Name" starts with a "/". This is a warning
-- |   to the user. The author wasted a fair amount of time on this issue and
-- |   and doesn't wish this on others ... 
mqOpen :: Name
       -> OpenMode
       -> Maybe FileMode -- ^Just x => creates the file with the given modes, Nothing => the file must exist.
       -> Maybe MQAttributes
       -> IO Fd
mqOpen name how maybe_mode (Just attrs) = do
   withCString name $ \ p_name -> do
     allocaBytes (64) $ \ p_attrs -> do
{-# LINE 133 "System/Posix/Realtime/MQueue.hsc" #-}
       poke p_attrs attrs
       mqd <- throwErrnoPathIfMinus1 "mqOpen" name (c_mq_open p_name all_flags mode_w p_attrs)
       return (Fd mqd)
  where
    all_flags  = creat .|. open_mode 

    (creat, mode_w) = case maybe_mode of 
            Nothing -> (0,0)
            Just x  -> ((64), x)
{-# LINE 142 "System/Posix/Realtime/MQueue.hsc" #-}

    open_mode = case how of
           ReadOnly  -> (0)
{-# LINE 145 "System/Posix/Realtime/MQueue.hsc" #-}
           WriteOnly -> (1)
{-# LINE 146 "System/Posix/Realtime/MQueue.hsc" #-}
           ReadWrite -> (2)
{-# LINE 147 "System/Posix/Realtime/MQueue.hsc" #-}
mqOpen name how maybe_mode Nothing = do
   withCString name $ \ p_name -> do
     mqd <- throwErrnoPathIfMinus1 "mqOpen" name (c_mq_open p_name all_flags mode_w nullPtr)
     return (Fd mqd)
  where
    all_flags  = creat .|. open_mode 

    (creat, mode_w) = case maybe_mode of 
            Nothing -> (0,0)
            Just x  -> ((64), x)
{-# LINE 157 "System/Posix/Realtime/MQueue.hsc" #-}

    open_mode = case how of
           ReadOnly  -> (0)
{-# LINE 160 "System/Posix/Realtime/MQueue.hsc" #-}
           WriteOnly -> (1)
{-# LINE 161 "System/Posix/Realtime/MQueue.hsc" #-}
           ReadWrite -> (2)
{-# LINE 162 "System/Posix/Realtime/MQueue.hsc" #-}

foreign import ccall unsafe "bits/mqueue.h mq_open"
    c_mq_open :: CString -> CInt -> CMode -> Ptr MQAttributes -> IO CInt



-- | Close a POSIX mqueue designated by "mqd"
--
mqClose :: Fd -> IO ()
mqClose (Fd mqd) = throwErrnoIfMinus1_ "mqClose" (c_mq_close mqd)

foreign import ccall unsafe "mqueue.h mq_close"
    c_mq_close :: CInt -> IO CInt



-- | Unlink (destroy) an existing POSIX mqueue designated by "name"
--
mqUnlink :: String -> IO ()
mqUnlink name = do
   withCString name $ \ p_name -> do
      throwErrnoPathIfMinus1 "mqUnlink" name (c_mq_unlink p_name)
      return ()

foreign import ccall unsafe "mqueue.h mq_unlink"
    c_mq_unlink :: CString -> IO CInt



-- | Get the attributes for an existing POSIX message queue designated by
-- |   "mqd"
--
mqGetAttributes :: Fd -> IO MQAttributes
mqGetAttributes (Fd mqd) = do
   allocaBytes (64) $ \ p_attrs -> do
{-# LINE 197 "System/Posix/Realtime/MQueue.hsc" #-}
      throwErrnoIfMinus1 "mqGetAttributes" (c_mq_getattr mqd p_attrs)
      mq_attrs <- peek p_attrs
      return (mq_attrs)


foreign import ccall unsafe "mqueue.h mq_getattr"
    c_mq_getattr :: CInt ->  Ptr MQAttributes -> IO CInt




-- | Set the attributes for an existing POSIX mqueue designated by "mqd" and 
-- |   retrieve old attributes
--
mqSetAttributes :: Fd -> MQAttributes -> IO (MQAttributes)
mqSetAttributes (Fd mqd) newAttrs = do
   allocaBytes (64) $ \ p_attrs -> do
{-# LINE 214 "System/Posix/Realtime/MQueue.hsc" #-}
     allocaBytes (64) $ \ p_oldattrs -> do
{-# LINE 215 "System/Posix/Realtime/MQueue.hsc" #-}
        poke p_attrs newAttrs
        throwErrnoIfMinus1 "mqSetAttributes" (c_mq_setattr mqd p_attrs p_oldattrs)
        oldAttrs <- peek p_oldattrs
        return (oldAttrs)


foreign import ccall unsafe "mqueue.h mq_setattr"
    c_mq_setattr :: CInt ->  Ptr MQAttributes -> Ptr MQAttributes -> IO CInt





-- | Retrieve a message from mqueue designated by "mqd"
--
mqReceive :: Fd -> ByteCount -> Maybe Int -> IO (String, Int)
mqReceive (Fd mqd) len (Just prio) = do
    allocaBytes (fromIntegral len) $ \ p_buffer -> do
      with (fromIntegral prio) $ \ p_prio -> do
        rc <- throwErrnoIfMinus1 "mqReceive" (c_mq_receive mqd p_buffer (fromIntegral len) p_prio)
        case fromIntegral rc of
          0 -> ioError (IOError Nothing EOF "mqReceive" "EOF" Nothing Nothing)
          n -> do
           s <- peekCStringLen (p_buffer, fromIntegral n)
           return (s, n)
mqReceive (Fd mqd) len Nothing = do
    allocaBytes (fromIntegral len) $ \ p_buffer -> do
      rc <- throwErrnoIfMinus1 "mqReceive" (c_mq_receive mqd p_buffer (fromIntegral len) nullPtr)
      case fromIntegral rc of
        0 -> ioError (IOError Nothing EOF "mqReceive" "EOF" Nothing Nothing)
        n -> do
         s <- peekCStringLen (p_buffer, fromIntegral n)
         return (s, n)
 
foreign import ccall unsafe "mqueue.h mq_receive"
   c_mq_receive :: CInt -> Ptr CChar -> CSize -> Ptr CInt -> IO CInt



-- | Send a message on mqueue designated by "mqd"
--
mqSend :: Fd -> String -> ByteCount -> Int -> IO ()
mqSend (Fd mqd) msg len prio = do
   withCString msg $ \ p_msg -> do
      throwErrnoPathIfMinus1 "mqSend" msg (c_mq_send mqd p_msg (fromIntegral len) (fromIntegral prio))
      return ()
 
foreign import ccall unsafe "mqueue.h mq_send"
    c_mq_send :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt



-- | Notify a registered process of the new-message-in-empty-queue event!
--
mqNotify :: Fd -> Maybe Sigevent -> IO ()
mqNotify (Fd mqd) Nothing = do 
   throwErrnoIfMinus1 "mqNotify" (c_mq_notify mqd nullPtr)
   return ()
mqNotify (Fd mqd) (Just sigEvent) = do
   allocaBytes (64) $ \ p_sigevent -> do
{-# LINE 275 "System/Posix/Realtime/MQueue.hsc" #-}
      poke p_sigevent sigEvent
      throwErrnoIfMinus1 "mqNotify" (c_mq_notify mqd p_sigevent)
      return ()


foreign import ccall unsafe "mqueue.h mq_notify"
    c_mq_notify :: CInt -> Ptr Sigevent -> IO CInt