-- | This module defines 'Requester', which indicates that an action can make
-- requests and receive responses to them.  Typically, this is used for things
-- like a WebSocket, where it's desirable to collect many potential sources of
-- events and send them over a single channel, then distribute the results back
-- out efficiently to their original request sites.
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif
module Reflex.Requester.Class
 ( Requester (..)
 , withRequesting
 , requestingIdentity
 ) where

import Control.Monad.Identity
import Control.Monad.Reader
import qualified Control.Monad.State.Lazy as Lazy
import Control.Monad.State.Strict
import Reflex.Class

-- | A 'Requester' action can trigger requests of type @Request m a@ based on
-- 'Event's, and receive responses of type @Response m a@ in return.  Note that
-- the @a@ type can vary within the 'Requester' action, but will be linked for a
-- given request.  For example, if @Request m@ is 'IO' and @Response m@ is
-- 'Identity', then 'requestingIdentity' has the same type as
-- 'Reflex.PerformEvent.Class.performEvent'.
class (Reflex t, Monad m) => Requester t m | m -> t where
  -- | The type of requests that this 'Requester' can emit
  type Request m :: * -> *
  -- | The type of responses that this 'Requester' can receive
  type Response m :: * -> *
  -- | Emit a request whenever the given 'Event' fires, and return responses in
  -- the resulting 'Event'.
  requesting :: Event t (Request m a) -> m (Event t (Response m a))
  -- | Emit a request whenever the given 'Event' fires, and ignore all responses.
  requesting_ :: Event t (Request m a) -> m ()


instance Requester t m => Requester t (ReaderT r m) where
  type Request (ReaderT r m) = Request m
  type Response (ReaderT r m) = Response m
  requesting :: Event t (Request (ReaderT r m) a)
-> ReaderT r m (Event t (Response (ReaderT r m) a))
requesting = m (Event t (Response m a)) -> ReaderT r m (Event t (Response m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t (Response m a))
 -> ReaderT r m (Event t (Response m a)))
-> (Event t (Request m a) -> m (Event t (Response m a)))
-> Event t (Request m a)
-> ReaderT r m (Event t (Response m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m (Event t (Response m a))
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m (Event t (Response m a))
requesting
  requesting_ :: Event t (Request (ReaderT r m) a) -> ReaderT r m ()
requesting_ = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (Event t (Request m a) -> m ())
-> Event t (Request m a)
-> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m ()
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m ()
requesting_

instance Requester t m => Requester t (StateT s m) where
  type Request (StateT s m) = Request m
  type Response (StateT s m) = Response m
  requesting :: Event t (Request (StateT s m) a)
-> StateT s m (Event t (Response (StateT s m) a))
requesting = m (Event t (Response m a)) -> StateT s m (Event t (Response m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t (Response m a)) -> StateT s m (Event t (Response m a)))
-> (Event t (Request m a) -> m (Event t (Response m a)))
-> Event t (Request m a)
-> StateT s m (Event t (Response m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m (Event t (Response m a))
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m (Event t (Response m a))
requesting
  requesting_ :: Event t (Request (StateT s m) a) -> StateT s m ()
requesting_ = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (Event t (Request m a) -> m ())
-> Event t (Request m a)
-> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m ()
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m ()
requesting_

instance Requester t m => Requester t (Lazy.StateT s m) where
  type Request (Lazy.StateT s m) = Request m
  type Response (Lazy.StateT s m) = Response m
  requesting :: Event t (Request (StateT s m) a)
-> StateT s m (Event t (Response (StateT s m) a))
requesting = m (Event t (Response m a)) -> StateT s m (Event t (Response m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t (Response m a)) -> StateT s m (Event t (Response m a)))
-> (Event t (Request m a) -> m (Event t (Response m a)))
-> Event t (Request m a)
-> StateT s m (Event t (Response m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m (Event t (Response m a))
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m (Event t (Response m a))
requesting
  requesting_ :: Event t (Request (StateT s m) a) -> StateT s m ()
requesting_ = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (Event t (Request m a) -> m ())
-> Event t (Request m a)
-> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m ()
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m ()
requesting_

-- | Emit a request whenever the given 'Event' fires, and unwrap the responses
-- before returning them.  @Response m@ must be 'Identity'.
requestingIdentity :: (Requester t m, Response m ~ Identity) => Event t (Request m a) -> m (Event t a)
requestingIdentity :: Event t (Request m a) -> m (Event t a)
requestingIdentity = (Event t (Identity a) -> Event t a)
-> m (Event t (Identity a)) -> m (Event t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event t (Identity a) -> Event t a
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Event t a -> Event t b
coerceEvent (m (Event t (Identity a)) -> m (Event t a))
-> (Event t (Request m a) -> m (Event t (Identity a)))
-> Event t (Request m a)
-> m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m (Event t (Identity a))
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m (Event t (Response m a))
requesting

withRequesting :: (Requester t m, MonadFix m) => (Event t (Response m a) -> m (Event t (Request m a), r)) -> m r
withRequesting :: (Event t (Response m a) -> m (Event t (Request m a), r)) -> m r
withRequesting f :: Event t (Response m a) -> m (Event t (Request m a), r)
f = do
  rec Event t (Response m a)
response <- Event t (Request m a) -> m (Event t (Response m a))
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m (Event t (Response m a))
requesting Event t (Request m a)
request
      (request :: Event t (Request m a)
request, result :: r
result) <- Event t (Response m a) -> m (Event t (Request m a), r)
f Event t (Response m a)
response
  r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
result