git.iko.soy/reflex
on ae@dev-script help sign in
reflex/test/Reflex/Plan/Pure.hs
72 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
45instance MonadSample (Pure Int) PurePlan where
46 sample = liftPlan . sample
49instance TestPlan (Pure Int) PurePlan where
50 plan occs = do
51 PurePlan . modify $ IntSet.union (IntMap.keysSet m)
52 return $ mapToPureEvent m
53 where m = IntMap.fromList (first fromIntegral <$> occs)
55runPure :: PurePlan a -> (a, IntSet)
56runPure (PurePlan p) = runStateT p mempty $ 0
58relevantTimes :: IntSet -> IntSet
59relevantTimes occs = IntSet.fromList [0..l + 1]
60 where l = fromMaybe 0 (fst <$> IntSet.maxView occs)
62testBehavior :: (Behavior (Pure Int) a, IntSet) -> IntMap a
63testBehavior (b, occs) = IntMap.fromSet (sample b) (relevantTimes occs)
65testEvent :: (Event (Pure Int) a, IntSet) -> IntMap (Maybe a)
66testEvent (Event readEvent, occs) = IntMap.fromSet readEvent (relevantTimes occs)