phi

-----------------------------------------------------------------------------
-- |
-- 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)