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