git.iko.soy/reflex
on ae@dev-script help sign in
reflex/test/Adjustable.hs
62 lines 2.0 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE RankNTypes #-}
4{-# LANGUAGE RecursiveDo #-}
6module Main where
8import Control.Monad.Fix
9import Data.Maybe
10import qualified Data.Map as Map
12import Reflex
13import Reflex.EventWriter.Base
14import Reflex.Network
15import Reflex.Patch.MapWithMove
16import Test.Run
18main :: IO ()
19main = do
20 let actions = [ Increment, Update0th, Increment, Swap, Increment, Increment ]
21 os <- runAppB testPatchMapWithMove $ map Just actions
22 -- If the final counter value in the adjusted widgets corresponds to the number of times it has
23 -- been incremented, we know that the networks haven't broken.
24 let expectedCount = length $ ffilter (== Increment) actions
25 -- let !True = last (last os) == [expectedCount,expectedCount] -- TODO re-enable this test after issue #369 has been resolved
26 return ()
28data PatchMapTestAction
29 = Increment
30 | Swap
31 | Update0th
32 deriving Eq
34-- See https://github.com/reflex-frp/reflex/issues/369 for the bug that this is testing.
35testPatchMapWithMove
36 :: forall t m
37 . ( Reflex t
38 , Adjustable t m
39 , MonadHold t m
40 , MonadFix m
41 )
42 => Event t PatchMapTestAction
43 -> m (Behavior t [Int])
44testPatchMapWithMove pulse = do
45 let pulseAction = ffor pulse $ \case
46 Increment -> Nothing
47 Swap -> patchMapWithMove $ Map.fromList
48 [ (0, NodeInfo (From_Move 1) (Just 1))
49 , (1, NodeInfo (From_Move 0) (Just 0))
50 ]
51 Update0th -> patchMapWithMove $ Map.fromList
52 [ (0, NodeInfo (From_Insert 'z') Nothing) ]
53 (_, result) <- runBehaviorWriterT $ mdo
54 counter <- foldDyn (+) 1 $ fmapMaybe (\e -> if isNothing e then Just 1 else Nothing) pulseAction
55 _ <- mapMapWithAdjustWithMove
56 (\_ _ -> networkHold
57 (tellBehavior $ constant [])
58 ((\t -> tellBehavior $ constant [t]) <$> updated counter))
59 (Map.fromList $ zip [0..] "ab")
60 (fmapMaybe id pulseAction)
61 return ()
62 return result