{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE StandaloneDeriving        #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE DeriveFunctor             #-}

-- | shared, internal types for the Async package
module Control.Distributed.Process.Async.Internal.Types
 ( -- * Exported types
    Async(..)
  , AsyncRef
  , AsyncTask(..)
  , AsyncResult(..)
  , CancelWait(..)
  ) where

import Control.Concurrent.STM
import Control.Distributed.Process
import Control.Distributed.Process.Serializable
  ( Serializable
  , SerializableDict
  )
import Data.Binary
import Data.Typeable (Typeable)

import GHC.Generics

-- | A reference to an asynchronous action
type AsyncRef = ProcessId

-- | An handle for an asynchronous action spawned by 'async'.
-- Asynchronous operations are run in a separate process, and
-- operations are provided for waiting for asynchronous actions to
-- complete and obtaining their results (see e.g. 'wait').
--
-- Handles of this type cannot cross remote boundaries, nor are they
-- @Serializable@.
data Async a = Async {
    forall a. Async a -> AsyncRef
_asyncWorker  :: AsyncRef
  , forall a. Async a -> AsyncRef
_asyncMonitor :: AsyncRef
  , forall a. Async a -> STM (AsyncResult a)
_asyncWait    :: STM (AsyncResult a)
  } deriving ((forall a b. (a -> b) -> Async a -> Async b)
-> (forall a b. a -> Async b -> Async a) -> Functor Async
forall a b. a -> Async b -> Async a
forall a b. (a -> b) -> Async a -> Async b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Async a -> Async b
fmap :: forall a b. (a -> b) -> Async a -> Async b
$c<$ :: forall a b. a -> Async b -> Async a
<$ :: forall a b. a -> Async b -> Async a
Functor)

instance Eq (Async a) where
  Async AsyncRef
a AsyncRef
b STM (AsyncResult a)
_ == :: Async a -> Async a -> Bool
== Async AsyncRef
c AsyncRef
d STM (AsyncResult a)
_  =  AsyncRef
a AsyncRef -> AsyncRef -> Bool
forall a. Eq a => a -> a -> Bool
== AsyncRef
c Bool -> Bool -> Bool
&& AsyncRef
b AsyncRef -> AsyncRef -> Bool
forall a. Eq a => a -> a -> Bool
== AsyncRef
d

instance Ord (Async a) where
  compare :: Async a -> Async a -> Ordering
compare (Async AsyncRef
a AsyncRef
b STM (AsyncResult a)
_) (Async AsyncRef
c AsyncRef
d STM (AsyncResult a)
_) = AsyncRef
a AsyncRef -> AsyncRef -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` AsyncRef
c Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> AsyncRef
b AsyncRef -> AsyncRef -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` AsyncRef
d

-- | A task to be performed asynchronously.
data AsyncTask a =
    AsyncTask {
        forall a. AsyncTask a -> Process a
asyncTask :: Process a -- ^ the task to be performed
      }
  | AsyncRemoteTask {
        forall a. AsyncTask a -> Static (SerializableDict a)
asyncTaskDict :: Static (SerializableDict a)
          -- ^ the serializable dict required to spawn a remote process
      , forall a. AsyncTask a -> NodeId
asyncTaskNode :: NodeId
          -- ^ the node on which to spawn the asynchronous task
      , forall a. AsyncTask a -> Closure (Process a)
asyncTaskProc :: Closure (Process a)
          -- ^ the task to be performed, wrapped in a closure environment
      }

-- | Represents the result of an asynchronous action, which can be in one of
-- several states at any given time.
data AsyncResult a =
    AsyncDone a                 -- ^ a completed action and its result
  | AsyncFailed DiedReason      -- ^ a failed action and the failure reason
  | AsyncLinkFailed DiedReason  -- ^ a link failure and the reason
  | AsyncCancelled              -- ^ a cancelled action
  | AsyncPending                -- ^ a pending action (that is still running)
    deriving (Typeable, (forall x. AsyncResult a -> Rep (AsyncResult a) x)
-> (forall x. Rep (AsyncResult a) x -> AsyncResult a)
-> Generic (AsyncResult a)
forall x. Rep (AsyncResult a) x -> AsyncResult a
forall x. AsyncResult a -> Rep (AsyncResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AsyncResult a) x -> AsyncResult a
forall a x. AsyncResult a -> Rep (AsyncResult a) x
$cfrom :: forall a x. AsyncResult a -> Rep (AsyncResult a) x
from :: forall x. AsyncResult a -> Rep (AsyncResult a) x
$cto :: forall a x. Rep (AsyncResult a) x -> AsyncResult a
to :: forall x. Rep (AsyncResult a) x -> AsyncResult a
Generic, (forall a b. (a -> b) -> AsyncResult a -> AsyncResult b)
-> (forall a b. a -> AsyncResult b -> AsyncResult a)
-> Functor AsyncResult
forall a b. a -> AsyncResult b -> AsyncResult a
forall a b. (a -> b) -> AsyncResult a -> AsyncResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AsyncResult a -> AsyncResult b
fmap :: forall a b. (a -> b) -> AsyncResult a -> AsyncResult b
$c<$ :: forall a b. a -> AsyncResult b -> AsyncResult a
<$ :: forall a b. a -> AsyncResult b -> AsyncResult a
Functor)


instance Serializable a => Binary (AsyncResult a) where

deriving instance Eq a => Eq (AsyncResult a)
deriving instance Show a => Show (AsyncResult a)

-- | A message to cancel Async operations
data CancelWait = CancelWait
    deriving (Typeable, (forall x. CancelWait -> Rep CancelWait x)
-> (forall x. Rep CancelWait x -> CancelWait) -> Generic CancelWait
forall x. Rep CancelWait x -> CancelWait
forall x. CancelWait -> Rep CancelWait x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CancelWait -> Rep CancelWait x
from :: forall x. CancelWait -> Rep CancelWait x
$cto :: forall x. Rep CancelWait x -> CancelWait
to :: forall x. Rep CancelWait x -> CancelWait
Generic)
instance Binary CancelWait