@@ -1,20 +1,42 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE BangPatterns #-}
3+{-# LANGUAGE ConstraintKinds #-}
4+{-# LANGUAGE DeriveAnyClass #-}
5+{-# LANGUAGE DeriveGeneric #-}
36{-# LANGUAGE FlexibleContexts #-}
7+{-# LANGUAGE FlexibleInstances #-}
48{-# LANGUAGE GADTs #-}
9+{-# LANGUAGE LambdaCase #-}
10+{-# LANGUAGE MultiParamTypeClasses #-}
11+{-# LANGUAGE OverloadedStrings #-}
12+{-# LANGUAGE PolyKinds #-}
513{-# LANGUAGE RankNTypes #-}
614{-# LANGUAGE RecursiveDo #-}
715{-# LANGUAGE ScopedTypeVariables #-}
16+{-# LANGUAGE StandaloneDeriving #-}
17+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18+{-# LANGUAGE TemplateHaskell #-}
19+{-# LANGUAGE TypeApplications #-}
20+{-# LANGUAGE TypeFamilies #-}
821module Main where
922
10−import Control.Lens
23+import Control.Lens hiding (has)
1124import Control.Monad
1225import Control.Monad.Fix
26+import Control.Monad.IO.Class (MonadIO)
27+import Data.Aeson (Value, FromJSON (..), ToJSON, Result(..), toJSON, fromJSON)
28+import Data.Constraint.Extras
29+import Data.Constraint.Extras.TH
30+import Data.Constraint.Forall
1331import qualified Data.Dependent.Map as DMap
1432import Data.Dependent.Sum
1533import Data.Functor.Misc
34+import Data.Map (Map)
1635import qualified Data.Map as M
36+import Data.Some (Some (Some))
37+import Data.Text (Text)
1738import Data.These
39+import Text.Read (readMaybe)
1840
1941#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
2042import Data.These.Lens
@@ -25,6 +47,8 @@ import Reflex.Requester.Base
2547import Reflex.Requester.Class
2648import Test.Run
2749
50+import GHC.Generics
51+
2852data RequestInt a where
2953 RequestInt :: Int -> RequestInt Int
3054
@@ -49,12 +73,15 @@ main = do
4973 print os5
5074 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
5175 print os6
76+ os7 <- runApp' testMatchRequestsWithResponses $ map (Just . Identity) [ "hey" ]
77+ print os7
5278 let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'
5379 let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2
5480 let ![[Nothing, Just [2]]] = os3
5581 let ![[Nothing, Just [2]]] = os4
5682 let ![[Nothing, Just [1, 2]]] = os5
5783 -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
84+
5885 return ()
5986
6087unwrapRequest :: DSum tag RequestInt -> Int
@@ -172,3 +199,49 @@ delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
172199 -- This has the effect of delaying pulse' from pulse
173200 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
174201 requestingIdentity pulse'
202+
203+{--
204+
205+
206+matchResponsesWithRequestsSource#
207+ :: (MonadFix m, MonadHold t m, Reflex t)
208+ => (forall a. request a -> (rawRequest, rawResponse -> response a))
209+ Given a request (from Requester), produces the wire format of the request and a function used to process the associated response
210+ -> Event t (RequesterData request)
211+ The outgoing requests
212+ -> Event t (Int, rawResponse)
213+ The incoming responses, tagged by an identifying key
214+ -> m (Event t (Map Int rawRequest), Event t (RequesterData response))
215+ A map of outgoing wire-format requests and an event of responses keyed by the RequesterData key of the associated outgoing request
216+
217+Matches incoming responses with previously-sent requests and uses the provided request "decoder" function to process incoming responses.
218+
219+--}
220+
221+testMatchRequestsWithResponses
222+ :: forall m t request a
223+ . ( MonadFix m
224+ , MonadHold t m
225+ , Reflex t
226+ , PerformEvent t m
227+ , TriggerEvent t m
228+ , MonadIO (Performable m)
229+ , ForallF Show Identity
230+ , Has Read Identity
231+ )
232+ => Event t (Identity Text) -> m (Event t ())
233+testMatchRequestsWithResponses pulse = mdo
234+ (_, requests) <- runRequesterT (requesting pulse) responses
235+ let rawResponses = rawRequestMap
236+ (rawRequestMap, responses) <- matchResponsesWithRequests reqEncoder requests (head . M.toList <$> rawResponses)
237+ pure never
238+ where
239+ reqEncoder :: forall a. Identity a -> (String, String -> Maybe a)
240+ reqEncoder r =
241+ ( whichever @Show @Identity @a $ show r
242+ , \x -> has @Read r $ readMaybe x
243+ )
244+
245+
246+deriving instance TriggerEvent (SpiderTimeline Global) (PerformEventT (SpiderTimeline Global) (SpiderHost Global))
247+