module Control.Eff.Concurrent.Api.Client
(
cast
, call
, castRegistered
, callRegistered
, ServesApi
, ServerReader
, whereIsServer
, registerServer
)
where
import Control.Eff
import Control.Eff.Reader.Strict
import Control.Eff.Concurrent.Api
import Control.Eff.Concurrent.Api.Internal
import Control.Eff.Concurrent.Process
import Data.Typeable ( Typeable )
import Control.DeepSeq
import GHC.Stack
cast
:: forall r q o
. ( HasCallStack
, SetMember Process (Process q) r
, Member Interrupts r
, Typeable o
, Typeable (Api o 'Asynchronous)
)
=> SchedulerProxy q
-> Server o
-> Api o 'Asynchronous
-> Eff r ()
cast px (Server pid) castMsg = sendMessage px pid (Cast $! castMsg)
call
:: forall result api r q
. ( SetMember Process (Process q) r
, Member Interrupts r
, Typeable api
, Typeable (Api api ( 'Synchronous result))
, Typeable result
, HasCallStack
, NFData result
, Show result
)
=> SchedulerProxy q
-> Server api
-> Api api ( 'Synchronous result)
-> Eff r result
call px (Server pidInternal) req = do
fromPid <- self px
callRef <- makeReference px
let requestMessage = Call callRef fromPid $! req
sendMessage px pidInternal requestMessage
let selectResult :: MessageSelector result
selectResult =
let extractResult :: Response api result -> Maybe result
extractResult (Response _pxResult callRefMsg result) =
if callRefMsg == callRef then Just result else Nothing
in selectMessageWith extractResult
rres <- receiveWithMonitor px pidInternal selectResult
either (interrupt . becauseProcessIsDown) return rres
type ServesApi o r q =
( Typeable o
, SetMember Process (Process q) r
, Member (ServerReader o) r
)
type ServerReader o = Reader (Server o)
registerServer
:: HasCallStack => Server o -> Eff (ServerReader o ': r) a -> Eff r a
registerServer = runReader
whereIsServer :: Member (ServerReader o) e => Eff e (Server o)
whereIsServer = ask
callRegistered
:: ( Typeable reply
, ServesApi o r q
, HasCallStack
, NFData reply
, Show reply
, Member Interrupts r
)
=> SchedulerProxy q
-> Api o ( 'Synchronous reply)
-> Eff r reply
callRegistered px method = do
serverPid <- whereIsServer
call px serverPid method
castRegistered
:: (Typeable o, ServesApi o r q, HasCallStack, Member Interrupts r)
=> SchedulerProxy q
-> Api o 'Asynchronous
-> Eff r ()
castRegistered px method = do
serverPid <- whereIsServer
cast px serverPid method