git.iko.soy/reflex
on develop help sign in
reflex/test/Reflex/Plan/Pure.hs
73 lines 2.0 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE GADTs #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE RankNTypes #-}
7{-# LANGUAGE ScopedTypeVariables #-}
9module Reflex.Plan.Pure where
11import Reflex
12import Reflex.Pure
13import Reflex.TestPlan
15import Control.Applicative
16import Control.Monad.Fix
17import Control.Monad.State
18import Data.IntMap (IntMap)
19import qualified Data.IntMap as IntMap
20import Data.IntSet (IntSet)
21import qualified Data.IntSet as IntSet
23import Data.Bifunctor
24import Data.Maybe
25import Data.Monoid
26import Prelude
29mapToPureEvent :: IntMap a -> Event (Pure Int) a
30mapToPureEvent m = Event $ flip IntMap.lookup m
32type TimeM = (->) Int
33newtype PurePlan a = PurePlan { unPlan :: StateT IntSet TimeM a } deriving (Functor, Applicative, Monad, MonadFix)
35liftPlan :: TimeM a -> PurePlan a
36liftPlan = PurePlan . lift
38instance MonadHold (Pure Int) PurePlan where
39 hold initial = liftPlan . hold initial
40 holdDyn initial = liftPlan . holdDyn initial
41 holdIncremental initial = liftPlan . holdIncremental initial
42 buildDynamic getInitial = liftPlan . buildDynamic getInitial
43 headE = liftPlan . headE
44 now = liftPlan now
46instance MonadSample (Pure Int) PurePlan where
47 sample = liftPlan . sample
50instance TestPlan (Pure Int) PurePlan where
51 plan occs = do
52 PurePlan . modify $ IntSet.union (IntMap.keysSet m)
53 return $ mapToPureEvent m
54 where m = IntMap.fromList (first fromIntegral <$> occs)
56runPure :: PurePlan a -> (a, IntSet)
57runPure (PurePlan p) = runStateT p mempty $ 0
59relevantTimes :: IntSet -> IntSet
60relevantTimes occs = IntSet.fromList [0..l + 1]
61 where l = fromMaybe 0 (fst <$> IntSet.maxView occs)
63testBehavior :: (Behavior (Pure Int) a, IntSet) -> IntMap a
64testBehavior (b, occs) = IntMap.fromSet (sample b) (relevantTimes occs)
66testEvent :: (Event (Pure Int) a, IntSet) -> IntMap (Maybe a)
67testEvent (Event readEvent, occs) = IntMap.fromSet readEvent (relevantTimes occs)