git.iko.soy/patch
on 7cc49e6 help sign in
patch/test/RequesterT.hs
70 lines 2.7 kB history raw
1{-# LANGUAGE FlexibleContexts, GADTs #-}
2module Main where
4import Control.Monad
5import Control.Monad.IO.Class
6import Control.Monad.Ref
7import qualified Data.Dependent.Map as DMap
8import Data.Dependent.Sum
9import Data.IORef
10import Data.List
11import Data.Functor.Identity
13import Reflex
14import Reflex.Host.Class
15import Reflex.PerformEvent.Base
16import Reflex.Requester.Base
17import Reflex.Requester.Class
19import System.Exit (exitFailure, exitSuccess)
21data RequestInt a where
22 RequestInt :: Int -> RequestInt Int
24main :: IO ()
25main = do
26 (Just out1, Nothing) <- runApp app1
27 print out1
28 (Just out2, Just (out3, out4)) <- runApp app2
29 print out2
30 print out3
31 print out4
32 when (sort out1 /= out1 || map (+1) out2 /= out3 || out3 /= out4) exitFailure
34runApp :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)
35 => (Event t () -> RequesterT t RequestInt Identity (PerformEventT t m) (Maybe (Ref m (Maybe (EventTrigger t ())))))
36 -> IO (Maybe [Int], Maybe ([Int], [Int]))
37runApp x = runSpiderHost $ do
38 (pulseE, pulseTriggerRef) <- newEventWithTriggerRef
39 ((mactuateRef, e), FireCommand fire) <- hostPerformEventT $ runRequesterT (x pulseE) never
40 hnd <- subscribeEvent (map unwrapRequest . DMap.toList <$> e)
41 out1 <- fireEventRefAndRead pulseTriggerRef () hnd
42 out2 <- fmap join $ forM mactuateRef $ \actuateRef -> do
43 let readPhase = do
44 mGetValue <- readEvent hnd
45 case mGetValue of
46 Nothing -> return Nothing
47 Just getValue -> fmap Just getValue
48 mactuate <- readRef actuateRef
49 mpulse <- readRef pulseTriggerRef
50 forM ((,) <$> mactuate <*> mpulse) $ \(actuate, pulse) -> do
51 _ <- fire [actuate :=> Identity ()] $ return ()
52 [Just a] <- fire [pulse :=> Identity ()] $ readPhase
53 [Just b, Nothing] <- fire [actuate :=> Identity (), pulse :=> Identity ()] $ readPhase
54 return (a,b)
55 return (out1, out2)
57unwrapRequest :: DSum tag RequestInt -> Int
58unwrapRequest (_ :=> RequestInt i) = i
60app1 :: (Reflex t, Ref m ~ IORef, Requester t m, Response m ~ Identity, Request m ~ RequestInt) => Event t () -> m (Maybe (Ref m (Maybe (EventTrigger t ()))))
61app1 e = do
62 forM_ [1..10] $ \i -> requestingIdentity (RequestInt i <$ e)
63 return Nothing
65app2 :: (Reflex t, Ref m ~ IORef, Requester t m, Response m ~ Identity, Request m ~ RequestInt, MonadAdjust t m, MonadReflexCreateTrigger t m, MonadRef m) => Event t () -> m (Maybe (Ref m (Maybe (EventTrigger t ()))))
66app2 e = do
67 (pulse, pulseTriggerRef) <- newEventWithTriggerRef
68 forM_ [1,3..9] $ \i -> runWithReplace (requestingIdentity (RequestInt i <$ e)) $ ffor pulse $ \_ -> requestingIdentity (RequestInt (i+1) <$ e)
69 return (Just pulseTriggerRef)