----------------------------------------------------------------------------- -- | -- Module : Control.Behaviour.GenServer -- Copyright : (c) 2020-2021 EMQ Technologies Co., Ltd. -- License : BSD-style (see the LICENSE file) -- -- Maintainer : Feng Lee, feng@emqx.io -- Yang M, yangm@emqx.io -- Stability : experimental -- Portability : portable -- -- The GenServer Behaviour module. -- ----------------------------------------------------------------------------- module Control.Behaviour.GenServer ( class GenServer , Init , HandleCall , HandleCast , handleCall , handleCast -- * start/stop server , start , startWith , startLink , startLinkWith , startMonitor , startMonitorWith , stop , stopPid , stopRef , stopWith -- * client apis , abcast , abcastAt , call , callTo , callRef , callTimeout , cast , castTo , castRef , multiCall , multiCallAt , sendRequest , replyTo -- * init result , initOk , initOkWith , initIgnore , initStop -- * reply funcs , reply , replyWith , noReply , noReplyWith , shutdown -- types , module Control.Behaviour.GenServer.Types ) where import Control.Behaviour.GenServer.Types import Control.Distributed.Node (Node) import Control.Monad (pure) import Control.Process (Process, ExitReason(..)) import Data.Function (($), (<<<)) import Data.Maybe (Maybe(..)) import Data.Pid (Pid) import Data.Ref (Reference) import Data.Timeout (Timeout) import Data.Unit (Unit) import Foreign (ffiIO2) -- | Init callback type Init req st = Process (InitResult req st) -- | HandleCall callback type HandleCall req rep st = req -> From -> st -> Process (Reply req rep st) -- | HandleCast callback type HandleCast req rep st = req -> st -> Process (Reply req rep st) class GenServer req rep st | req -> rep, rep -> st, st -> req where handleCall :: HandleCall req rep st handleCast :: HandleCast req rep st -- | Start a standalone server process. foreign import start :: forall req rep st. GenServer req rep st => (Init req st) -> Process Pid -- | Start a standalone server process with registered name. foreign import startWith :: forall req rep st. GenServer req rep st => Name -> (Init req st) -> Process Pid -- | Start a server process as part of a supervision tree. foreign import startLink :: forall req rep st. GenServer req rep st => (Init req st) -> Process Pid foreign import startLinkWith :: forall req rep st. GenServer req rep st => Name -> (Init req st) -> Process Pid -- | Start and monitor a server process foreign import startMonitor :: forall req rep st. GenServer req rep st => (Init req st) -> Process (Pid, Reference) foreign import startMonitorWith :: forall req rep st. GenServer req rep st => Name -> (Init req st) -> Process (Pid, Reference) -- | Stop the server process. foreign import stop :: Name -> Process () foreign import stopPid :: Pid -> Process () foreign import stopRef :: ServerRef -> Process () -- | Stop the server process with exit reason. foreign import stopWith :: ServerRef -> ExitReason -> Timeout -> Process () -- | Sends an asynchronous request to the GenServer processes. foreign import abcast :: forall req. Name -> req -> Process () -- | Sends an asynchronous request to the GenServer processes at the specified nodes. foreign import abcastAt :: forall req. [Node] -> Name -> req -> Process () -- | Synchronous call to the Name of the GenServer process. foreign import call :: forall req rep. Name -> req -> Process rep -- | Synchronous call to the Server process directly. foreign import callTo :: forall req rep. Pid -> req -> Process rep -- | Synchronous call to the ServerRef of the GenServer process. foreign import callRef :: forall req rep. ServerRef -> req -> Process rep -- | Synchronous call to the ServerRef of the Server process with timeout. foreign import callTimeout :: forall req rep. ServerRef -> req -> Timeout -> Process rep -- | Sends an asynchronous request to the ServerRef of the Server process. foreign import cast :: forall req. Name -> req -> Process () -- | Sends an asynchronous request to the Server process directly. foreign import castTo :: forall req. Pid -> req -> Process () foreign import castRef :: forall req. ServerRef -> req -> Process () foreign import multiCall :: forall req rep. Name -> req -> Process (Replies rep) foreign import multiCallAt :: forall req rep. [Node] -> Name -> req -> Process (Replies rep) foreign import multiCallTimeoutAt :: forall req rep. [Node] -> Name -> req -> Timeout -> Process (Replies rep) foreign import sendRequest :: forall req. ServerRef -> req -> Process RequestId foreign import waitResponse :: forall rep. RequestId -> Timeout -> Process rep initOk :: forall req st. st -> Process (InitResult req st) initOk st = pure $ InitOk st Nothing initOkWith :: forall req st. st -> Action req -> Process (InitResult req st) initOkWith st action = pure $ InitOk st (Just action) initIgnore :: forall req st. Process (InitResult req st) initIgnore = pure InitIgnore initStop :: forall req st. ExitReason -> Process (InitResult req st) initStop = pure <<< InitStop -- | Send a reply to the caller explicitly. replyTo :: forall rep. From -> rep -> Process () replyTo = ffiIO2 :gen_server :reply reply :: forall req rep st. rep -> st -> Process (Reply req rep st) reply rep st = pure $ Reply rep st Nothing replyWith :: forall req rep st. rep -> st -> Action req -> Process (Reply req rep st) replyWith rep st action = pure $ Reply rep st (Just action) noReply :: forall req rep st. st -> Process (Reply req rep st) noReply st = pure $ NoReply st Nothing noReplyWith :: forall req rep st. st -> Action req -> Process (Reply req rep st) noReplyWith st action = pure $ NoReply st (Just action) shutdown :: forall req rep st. Atom -> st -> Process (Reply req rep st) shutdown r = pure <<< Shutdown (ExitReason r)