git.iko.soy/patch
on 364f7df help sign in
patch/test/Reflex/Plan/Pure.hs
71 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
44instance MonadSample (Pure Int) PurePlan where
45 sample = liftPlan . sample
48instance TestPlan (Pure Int) PurePlan where
49 plan occs = do
50 PurePlan . modify $ IntSet.union (IntMap.keysSet m)
51 return $ mapToPureEvent m
52 where m = IntMap.fromList (first fromIntegral <$> occs)
54runPure :: PurePlan a -> (a, IntSet)
55runPure (PurePlan p) = runStateT p mempty $ 0
57relavantTimes :: IntSet -> IntSet
58relavantTimes occs = IntSet.fromList [0..l + 1]
59 where l = fromMaybe 0 (fst <$> IntSet.maxView occs)
61testBehavior :: (Behavior (Pure Int) a, IntSet) -> IntMap a
62testBehavior (b, occs) = IntMap.fromSet (sample b) (relavantTimes occs)
64testEvent :: (Event (Pure Int) a, IntSet) -> IntMap (Maybe a)
65testEvent (Event readEvent, occs) = IntMap.fromSet readEvent (relavantTimes occs)