git.iko.soy/patch
on ef4da28 help sign in
patch/src/Reflex/Requester/Class.hs
87 lines 3.7 kB history raw
1-- | This module defines 'Requester', which indicates that an action can make
2-- requests and receive responses to them. Typically, this is used for things
3-- like a WebSocket, where it's desirable to collect many potential sources of
4-- events and send them over a single channel, then distribute the results back
5-- out efficiently to their original request sites.
6{-# LANGUAGE CPP #-}
7{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE FunctionalDependencies #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE UndecidableInstances #-}
12#ifdef USE_REFLEX_OPTIMIZER
13{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
14#endif
15module Reflex.Requester.Class
16 ( Requester (..)
17 , requesting
18 , requesting_
19 , requestingIdentity
20 ) where
22import Control.Monad.Identity
23import Control.Monad.Reader
24import qualified Control.Monad.State.Lazy as Lazy
25import Control.Monad.State.Strict
26import Reflex.Class
28-- | A 'Requester' action can trigger requests of type @Request m a@ based on
29-- 'Event's, and receive responses of type @Response m a@ in return. Note that
30-- the @a@ type can vary within the 'Requester' action, but will be linked for a
31-- given request. For example, if @Request m@ is 'IO' and @Response m@ is
32-- 'Identity', then 'requestingIdentity' has the same type as
33-- 'Reflex.PerformEvent.Class.performEvent'.
34class (Reflex t, Monad m) => Requester t m | m -> t where
35 -- | The type of requests that this 'Requester' can emit
36 type Request m :: * -> *
37 -- | The type of responses that this 'Requester' can receive
38 type Response m :: * -> *
39 -- | Usually, end-user code should use 'requesting', 'requesting_', or
40 -- 'requestingIdentity'. For implementers of 'Requester', this function
41 -- provides a convenient way to define instances of the typeclass that
42 -- efficiently support the underlying operations without needing to use
43 -- 'Control.Monad.Fix.MonadFix'.
44 withRequesting :: (Event t (Response m a) -> m (Event t (Request m a), r)) -> m r
46instance Requester t m => Requester t (ReaderT r m) where
47 type Request (ReaderT r m) = Request m
48 type Response (ReaderT r m) = Response m
49 withRequesting f = do
50 r <- ask
51 lift $ withRequesting $ (`runReaderT` r) . f
53instance Requester t m => Requester t (StateT s m) where
54 type Request (StateT s m) = Request m
55 type Response (StateT s m) = Response m
56 withRequesting f = do
57 old <- get
58 (result, new) <- lift $ withRequesting $ \x -> do
59 ((request, result), new) <- runStateT (f x) old
60 return (request, (result, new))
61 put new
62 return result
64instance Requester t m => Requester t (Lazy.StateT s m) where
65 type Request (Lazy.StateT s m) = Request m
66 type Response (Lazy.StateT s m) = Response m
67 withRequesting f = do
68 old <- Lazy.get
69 (result, new) <- lift $ withRequesting $ \x -> do
70 ((request, result), new) <- Lazy.runStateT (f x) old
71 return (request, (result, new))
72 Lazy.put new
73 return result
75-- | Emit a request whenever the given 'Event' fires, and return responses in
76-- the resulting 'Event'.
77requesting :: Requester t m => Event t (Request m a) -> m (Event t (Response m a))
78requesting req = withRequesting $ return . (,) req
80-- | Emit a request whenever the given 'Event' fires, and ignore all responses.
81requesting_ :: Requester t m => Event t (Request m a) -> m ()
82requesting_ req = withRequesting $ \_ -> return (req, ())
84-- | Emit a request whenever the given 'Event' fires, and unwrap the responses
85-- before returning them. @Response m@ must be 'Identity'.
86requestingIdentity :: (Requester t m, Response m ~ Identity) => Event t (Request m a) -> m (Event t a)
87requestingIdentity = fmap coerceEvent . requesting