-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Distributed.Process.Extras.UnsafePrimitives
-- Copyright   :  (c) Tim Watson 2013 - 2017
-- License     :  BSD3 (see the file LICENSE)
--
-- Maintainer  :  Tim Watson <watson.timothy@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (requires concurrency)
--
-- [Unsafe Messaging Primitives Using NFData]
--
-- This module mirrors "Control.Distributed.Process.UnsafePrimitives", but
-- attempts to provide a bit more safety by forcing evaluation before sending.
-- This is handled using @NFData@, by means of the @NFSerializable@ type class.
--
-- Note that we /still/ cannot guarantee that both the @NFData@ and @Binary@
-- instances will evaluate your data the same way, therefore these primitives
-- still have certain risks and potential side effects. Use with caution.
--
-----------------------------------------------------------------------------
module Control.Distributed.Process.Extras.UnsafePrimitives
  ( send
  , nsend
  , sendToAddr
  , sendChan
  , wrapMessage
  ) where

import Control.DeepSeq (($!!))
import Control.Distributed.Process
  ( Process
  , ProcessId
  , SendPort
  , Message
  )
import Control.Distributed.Process.Extras.Internal.Types
  ( NFSerializable
  , Addressable
  , Resolvable(..)
  )
import qualified Control.Distributed.Process.UnsafePrimitives as Unsafe

send :: NFSerializable m => ProcessId -> m -> Process ()
send :: forall m. NFSerializable m => ProcessId -> m -> Process ()
send ProcessId
pid m
msg = ProcessId -> m -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
Unsafe.send ProcessId
pid (m -> Process ()) -> m -> Process ()
forall a b. NFData a => (a -> b) -> a -> b
$!! m
msg

nsend :: NFSerializable a => String -> a -> Process ()
nsend :: forall a. NFSerializable a => String -> a -> Process ()
nsend String
name a
msg = String -> a -> Process ()
forall a. Serializable a => String -> a -> Process ()
Unsafe.nsend String
name (a -> Process ()) -> a -> Process ()
forall a b. NFData a => (a -> b) -> a -> b
$!! a
msg

sendToAddr :: (Addressable a, NFSerializable m) => a -> m -> Process ()
sendToAddr :: forall a m.
(Addressable a, NFSerializable m) =>
a -> m -> Process ()
sendToAddr a
addr m
msg = do
  Maybe ProcessId
mPid <- a -> Process (Maybe ProcessId)
forall a. Resolvable a => a -> Process (Maybe ProcessId)
resolve a
addr
  case Maybe ProcessId
mPid of
    Maybe ProcessId
Nothing -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just ProcessId
p  -> ProcessId -> m -> Process ()
forall m. NFSerializable m => ProcessId -> m -> Process ()
send ProcessId
p m
msg

sendChan :: (NFSerializable m) => SendPort m -> m -> Process ()
sendChan :: forall m. NFSerializable m => SendPort m -> m -> Process ()
sendChan SendPort m
port m
msg = SendPort m -> m -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
Unsafe.sendChan SendPort m
port (m -> Process ()) -> m -> Process ()
forall a b. NFData a => (a -> b) -> a -> b
$!! m
msg

-- | Create an unencoded @Message@ for any @Serializable@ type.
wrapMessage :: NFSerializable a => a -> Message
wrapMessage :: forall a. NFSerializable a => a -> Message
wrapMessage a
msg = a -> Message
forall a. Serializable a => a -> Message
Unsafe.wrapMessage (a -> Message) -> a -> Message
forall a b. NFData a => (a -> b) -> a -> b
$!! a
msg