{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE PatternGuards              #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE AllowAmbiguousTypes        #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Distributed.Process.ManagedProcess.Server.Priority
-- Copyright   :  (c) Tim Watson 2012 - 2017
-- License     :  BSD3 (see the file LICENSE)
--
-- Maintainer  :  Tim Watson <watson.timothy@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (requires concurrency)
--
-- The Server Portion of the /Managed Process/ API, as presented by the
-- 'GenProcess' monad. These functions are generally intended for internal
-- use, but the API is relatively stable and therefore they have been re-exported
-- here for general use. Note that if you modify a process' internal state
-- (especially that of the internal priority queue) then you are responsible for
-- any alteratoin that makes to the semantics of your processes behaviour.
--
-- See "Control.Distributed.Process.ManagedProcess.Internal.GenProcess"
-----------------------------------------------------------------------------
module Control.Distributed.Process.ManagedProcess.Server.Gen
  ( -- * Server actions
    reply
  , replyWith
  , noReply
  , continue
  , timeoutAfter
  , hibernate
  , stop
  , reject
  , rejectWith
  , become
  , haltNoReply
  , lift
  , Gen.recvLoop
  , Gen.precvLoop
  , Gen.currentTimeout
  , Gen.systemTimeout
  , Gen.drainTimeout
  , Gen.processState
  , Gen.processDefinition
  , Gen.processFilters
  , Gen.processUnhandledMsgPolicy
  , Gen.processQueue
  , Gen.gets
  , Gen.getAndModifyState
  , Gen.modifyState
  , Gen.setUserTimeout
  , Gen.setProcessState
  , GenProcess
  , Gen.peek
  , Gen.push
  , Gen.enqueue
  , Gen.dequeue
  , Gen.addUserTimer
  , Gen.removeUserTimer
  , Gen.eval
  , Gen.act
  , Gen.runAfter
  , Gen.evalAfter
  ) where

import Control.Distributed.Process.Extras
 ( ExitReason
 )
import Control.Distributed.Process.Extras.Time
 ( TimeInterval
 , Delay
 )
import Control.Distributed.Process.ManagedProcess.Internal.Types
 ( lift
 , ProcessAction(..)
 , GenProcess
 , ProcessReply(..)
 , ProcessDefinition
 )
import qualified Control.Distributed.Process.ManagedProcess.Internal.GenProcess as Gen
 ( recvLoop
 , precvLoop
 , currentTimeout
 , systemTimeout
 , drainTimeout
 , processState
 , processDefinition
 , processFilters
 , processUnhandledMsgPolicy
 , processQueue
 , gets
 , getAndModifyState
 , modifyState
 , setUserTimeout
 , setProcessState
 , peek
 , push
 , enqueue
 , dequeue
 , addUserTimer
 , removeUserTimer
 , eval
 , act
 , runAfter
 , evalAfter
 )
import Control.Distributed.Process.ManagedProcess.Internal.GenProcess
 ( processState
 )
import qualified Control.Distributed.Process.ManagedProcess.Server as Server
 ( replyWith
 , continue
 )
import Control.Distributed.Process.Serializable (Serializable)

-- | Reject the message we're currently handling.
reject :: forall r s . String -> GenProcess s (ProcessReply r s)
reject :: forall r s. String -> GenProcess s (ProcessReply r s)
reject String
rs = GenProcess s s
forall s. GenProcess s s
processState GenProcess s s
-> (s -> GenProcess s (ProcessReply r s))
-> GenProcess s (ProcessReply r s)
forall a b.
GenProcess s a -> (a -> GenProcess s b) -> GenProcess s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
st -> Process (ProcessReply r s) -> GenProcess s (ProcessReply r s)
forall a s. Process a -> GenProcess s a
lift (Process (ProcessReply r s) -> GenProcess s (ProcessReply r s))
-> Process (ProcessReply r s) -> GenProcess s (ProcessReply r s)
forall a b. (a -> b) -> a -> b
$ s -> Action s
forall s. s -> Action s
Server.continue s
st Action s
-> (ProcessAction s -> Process (ProcessReply r s))
-> Process (ProcessReply r s)
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessReply r s -> Process (ProcessReply r s)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessReply r s -> Process (ProcessReply r s))
-> (ProcessAction s -> ProcessReply r s)
-> ProcessAction s
-> Process (ProcessReply r s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ProcessAction s -> ProcessReply r s
forall r s. String -> ProcessAction s -> ProcessReply r s
ProcessReject String
rs

-- | Reject the message we're currently handling, giving an explicit reason.
rejectWith :: forall r m s . (Show r) => r -> GenProcess s (ProcessReply m s)
rejectWith :: forall r m s. Show r => r -> GenProcess s (ProcessReply m s)
rejectWith r
rs = String -> GenProcess s (ProcessReply m s)
forall r s. String -> GenProcess s (ProcessReply r s)
reject (r -> String
forall a. Show a => a -> String
show r
rs)

-- | Instructs the process to send a reply and continue running.
reply :: forall r s . (Serializable r) => r -> GenProcess s (ProcessReply r s)
reply :: forall r s. Serializable r => r -> GenProcess s (ProcessReply r s)
reply r
r = GenProcess s s
forall s. GenProcess s s
processState GenProcess s s
-> (s -> GenProcess s (ProcessReply r s))
-> GenProcess s (ProcessReply r s)
forall a b.
GenProcess s a -> (a -> GenProcess s b) -> GenProcess s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
s -> Process (ProcessReply r s) -> GenProcess s (ProcessReply r s)
forall a s. Process a -> GenProcess s a
lift (Process (ProcessReply r s) -> GenProcess s (ProcessReply r s))
-> Process (ProcessReply r s) -> GenProcess s (ProcessReply r s)
forall a b. (a -> b) -> a -> b
$ s -> Action s
forall s. s -> Action s
Server.continue s
s Action s
-> (ProcessAction s -> Process (ProcessReply r s))
-> Process (ProcessReply r s)
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> ProcessAction s -> Process (ProcessReply r s)
forall r s. Serializable r => r -> ProcessAction s -> Reply r s
Server.replyWith r
r

-- | Instructs the process to send a reply /and/ evaluate the 'ProcessAction'.
replyWith :: forall r s . (Serializable r)
         => r
         -> ProcessAction s
         -> GenProcess s (ProcessReply r s)
replyWith :: forall r s.
Serializable r =>
r -> ProcessAction s -> GenProcess s (ProcessReply r s)
replyWith r
r ProcessAction s
s = ProcessReply r s -> GenProcess s (ProcessReply r s)
forall a. a -> GenProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessReply r s -> GenProcess s (ProcessReply r s))
-> ProcessReply r s -> GenProcess s (ProcessReply r s)
forall a b. (a -> b) -> a -> b
$ r -> ProcessAction s -> ProcessReply r s
forall r s. r -> ProcessAction s -> ProcessReply r s
ProcessReply r
r ProcessAction s
s

-- | Instructs the process to skip sending a reply /and/ evaluate a 'ProcessAction'
noReply :: (Serializable r) => ProcessAction s -> GenProcess s (ProcessReply r s)
noReply :: forall r s.
Serializable r =>
ProcessAction s -> GenProcess s (ProcessReply r s)
noReply = ProcessReply r s -> GenProcess s (ProcessReply r s)
forall a. a -> GenProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessReply r s -> GenProcess s (ProcessReply r s))
-> (ProcessAction s -> ProcessReply r s)
-> ProcessAction s
-> GenProcess s (ProcessReply r s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessAction s -> ProcessReply r s
forall r s. ProcessAction s -> ProcessReply r s
NoReply

-- | Halt process execution during a call handler, without paying any attention
-- to the expected return type.
haltNoReply :: forall s r . Serializable r => ExitReason -> GenProcess s (ProcessReply r s)
haltNoReply :: forall s r.
Serializable r =>
ExitReason -> GenProcess s (ProcessReply r s)
haltNoReply ExitReason
r = ExitReason -> GenProcess s (ProcessAction s)
forall s. ExitReason -> GenProcess s (ProcessAction s)
stop ExitReason
r GenProcess s (ProcessAction s)
-> (ProcessAction s -> GenProcess s (ProcessReply r s))
-> GenProcess s (ProcessReply r s)
forall a b.
GenProcess s a -> (a -> GenProcess s b) -> GenProcess s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessAction s -> GenProcess s (ProcessReply r s)
forall r s.
Serializable r =>
ProcessAction s -> GenProcess s (ProcessReply r s)
noReply

-- | Instructs the process to continue running and receiving messages.
continue :: GenProcess s (ProcessAction s)
continue :: forall s. GenProcess s (ProcessAction s)
continue = GenProcess s s
forall s. GenProcess s s
processState GenProcess s s
-> (s -> GenProcess s (ProcessAction s))
-> GenProcess s (ProcessAction s)
forall a b.
GenProcess s a -> (a -> GenProcess s b) -> GenProcess s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessAction s -> GenProcess s (ProcessAction s)
forall a. a -> GenProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessAction s -> GenProcess s (ProcessAction s))
-> (s -> ProcessAction s) -> s -> GenProcess s (ProcessAction s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ProcessAction s
forall s. s -> ProcessAction s
ProcessContinue

-- | Instructs the process loop to wait for incoming messages until 'Delay'
-- is exceeded. If no messages are handled during this period, the /timeout/
-- handler will be called. Note that this alters the process timeout permanently
-- such that the given @Delay@ will remain in use until changed.
--
-- Note that @timeoutAfter NoDelay@ will cause the timeout handler to execute
-- immediately if no messages are present in the process' mailbox.
--
timeoutAfter :: Delay -> GenProcess s (ProcessAction s)
timeoutAfter :: forall s. Delay -> GenProcess s (ProcessAction s)
timeoutAfter Delay
d = GenProcess s s
forall s. GenProcess s s
processState GenProcess s s
-> (s -> GenProcess s (ProcessAction s))
-> GenProcess s (ProcessAction s)
forall a b.
GenProcess s a -> (a -> GenProcess s b) -> GenProcess s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
s -> ProcessAction s -> GenProcess s (ProcessAction s)
forall a. a -> GenProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessAction s -> GenProcess s (ProcessAction s))
-> ProcessAction s -> GenProcess s (ProcessAction s)
forall a b. (a -> b) -> a -> b
$ Delay -> s -> ProcessAction s
forall s. Delay -> s -> ProcessAction s
ProcessTimeout Delay
d s
s

-- | Instructs the process to /hibernate/ for the given 'TimeInterval'. Note
-- that no messages will be removed from the mailbox until after hibernation has
-- ceased. This is equivalent to calling @threadDelay@.
--
hibernate :: TimeInterval -> GenProcess s (ProcessAction s)
hibernate :: forall s. TimeInterval -> GenProcess s (ProcessAction s)
hibernate TimeInterval
d = GenProcess s s
forall s. GenProcess s s
processState GenProcess s s
-> (s -> GenProcess s (ProcessAction s))
-> GenProcess s (ProcessAction s)
forall a b.
GenProcess s a -> (a -> GenProcess s b) -> GenProcess s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
s -> ProcessAction s -> GenProcess s (ProcessAction s)
forall a. a -> GenProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessAction s -> GenProcess s (ProcessAction s))
-> ProcessAction s -> GenProcess s (ProcessAction s)
forall a b. (a -> b) -> a -> b
$ TimeInterval -> s -> ProcessAction s
forall s. TimeInterval -> s -> ProcessAction s
ProcessHibernate TimeInterval
d s
s

-- | The server loop will execute against the supplied 'ProcessDefinition', allowing
-- the process to change its behaviour (in terms of message handlers, exit handling,
-- termination, unhandled message policy, etc)
become :: forall s . ProcessDefinition s -> GenProcess s (ProcessAction s)
become :: forall s. ProcessDefinition s -> GenProcess s (ProcessAction s)
become ProcessDefinition s
def = GenProcess s s
forall s. GenProcess s s
processState GenProcess s s
-> (s -> GenProcess s (ProcessAction s))
-> GenProcess s (ProcessAction s)
forall a b.
GenProcess s a -> (a -> GenProcess s b) -> GenProcess s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
st -> ProcessAction s -> GenProcess s (ProcessAction s)
forall a. a -> GenProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessAction s -> GenProcess s (ProcessAction s))
-> ProcessAction s -> GenProcess s (ProcessAction s)
forall a b. (a -> b) -> a -> b
$ ProcessDefinition s -> s -> ProcessAction s
forall s. ProcessDefinition s -> s -> ProcessAction s
ProcessBecome ProcessDefinition s
def s
st

-- | Instructs the process to terminate, giving the supplied reason. If a valid
-- 'shutdownHandler' is installed, it will be called with the 'ExitReason'
-- returned from this call, along with the process state.
stop :: ExitReason -> GenProcess s (ProcessAction s)
stop :: forall s. ExitReason -> GenProcess s (ProcessAction s)
stop ExitReason
r = ProcessAction s -> GenProcess s (ProcessAction s)
forall a. a -> GenProcess s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessAction s -> GenProcess s (ProcessAction s))
-> ProcessAction s -> GenProcess s (ProcessAction s)
forall a b. (a -> b) -> a -> b
$ ExitReason -> ProcessAction s
forall s. ExitReason -> ProcessAction s
ProcessStop ExitReason
r