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