git.iko.soy/reflex
on workflow-monad help sign in
reflex/test/RequesterT.hs
65 lines 1.9 kB history raw
1{-# LANGUAGE FlexibleContexts, GADTs, RankNTypes, ScopedTypeVariables #-}
2module Main where
4import Control.Lens
5import Control.Monad
6import qualified Data.Dependent.Map as DMap
7import Data.Dependent.Sum
8import Data.These
10import Reflex
11import Reflex.Requester.Base
12import Reflex.Requester.Class
13import Test.Run
15data RequestInt a where
16 RequestInt :: Int -> RequestInt Int
18main :: IO ()
19main = do
20 os1@[[Just [10,9,8,7,6,5,4,3,2,1]]] <- runApp' (unwrapApp testOrdering) $
21 [ Just ()
22 ]
23 print os1
24 os2@[[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]]
25 <- runApp' (unwrapApp testSimultaneous) $ map Just $
26 [ This ()
27 , That ()
28 , This ()
29 , These () ()
30 ]
31 print os2
32 return ()
34unwrapRequest :: DSum tag RequestInt -> Int
35unwrapRequest (_ :=> RequestInt i) = i
37unwrapApp :: ( Reflex t, Monad m )
38 => (a -> RequesterT t RequestInt Identity m ())
39 -> a
40 -> m (Event t [Int])
41unwrapApp x appIn = do
42 ((), e) <- runRequesterT (x appIn) never
43 return $ fmap (map unwrapRequest . DMap.toList) e
45testOrdering :: ( Response m ~ Identity
46 , Request m ~ RequestInt
47 , Requester t m
48 , Adjustable t m)
49 => Event t ()
50 -> m ()
51testOrdering pulse = do
52 forM_ [10,9..1] $ \i -> requestingIdentity (RequestInt i <$ pulse)
53 return ()
55testSimultaneous :: ( Response m ~ Identity
56 , Request m ~ RequestInt
57 , Requester t m
58 , Adjustable t m)
59 => Event t (These () ())
60 -> m ()
61testSimultaneous pulse = do
62 let tellE = fmapMaybe (^? here) pulse
63 switchE = fmapMaybe (^? there) pulse
64 forM_ [1,3..9] $ \i -> runWithReplace (requestingIdentity (RequestInt i <$ tellE)) $ ffor switchE $ \_ ->
65 requestingIdentity (RequestInt (i+1) <$ tellE)