git.iko.soy/patch
on 8442b5b help sign in
patch/src/Reflex/Spider/SpiderTimeline.include.hs
155 lines 8.6 kB history raw
1-- | Designates the default, global Spider timeline
2data SpiderTimeline x
3type role SpiderTimeline nominal
5-- | The default, global Spider environment
6type Spider = SpiderTimeline Global
8instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (EventM x) where
9 {-# INLINABLE sample #-}
10 sample (SpiderBehavior b) = readBehaviorUntracked b
12instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (EventM x) where
13 {-# INLINABLE hold #-}
14 hold = holdSpiderEventM
15 {-# INLINABLE holdDyn #-}
16 holdDyn = holdDynSpiderEventM
17 {-# INLINABLE holdIncremental #-}
18 holdIncremental = holdIncrementalSpiderEventM
19 {-# INLINABLE buildDynamic #-}
20 buildDynamic = buildDynamicSpiderEventM
21 {-# INLINABLE headE #-}
22 headE = R.slowHeadE
23-- headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e
25instance (
26#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
27 x ~ Global
28#endif
29 ) => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where
30 {-# INLINABLE sample #-}
31 sample = coerce . readBehaviorTracked . unSpiderBehavior
33instance (
34#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
35 x ~ Global
36#else
37 HasSpiderTimeline x
38#endif
39 ) => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPushM x) where
40 {-# INLINABLE sample #-}
41 sample (SpiderBehavior b) = SpiderPushM $ readBehaviorUntracked b
43instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderPushM x) where
44 {-# INLINABLE hold #-}
45 hold v0 e = Reflex.Class.current <$> Reflex.Class.holdDyn v0 e
46 {-# INLINABLE holdDyn #-}
47 holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce e
48 {-# INLINABLE holdIncremental #-}
49 holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> Reflex.Spider.Internal.hold v0 e
50 {-# INLINABLE buildDynamic #-}
51 buildDynamic getV0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce e
52 {-# INLINABLE headE #-}
53 headE = R.slowHeadE
54-- headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e
56instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where
57 {-# INLINE return #-}
58 return = pure
59 {-# INLINE (>>=) #-}
60 x >>= f = SpiderDynamic $ dynamicDynIdentity $ newJoinDyn $ newMapDyn (unSpiderDynamic . f) $ unSpiderDynamic x
61 {-# INLINE (>>) #-}
62 (>>) = (*>)
63 {-# INLINE fail #-}
64 fail _ = error "Dynamic does not support 'fail'"
66{-# INLINABLE newJoinDyn #-}
67newJoinDyn :: HasSpiderTimeline x => Reflex.Spider.Internal.Dynamic x (Identity (Reflex.Spider.Internal.Dynamic x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
68newJoinDyn d =
69 let readV0 = readBehaviorTracked . dynamicCurrent =<< readBehaviorTracked (dynamicCurrent d)
70 eOuter = Reflex.Spider.Internal.push (fmap (Just . Identity) . readBehaviorUntracked . dynamicCurrent . runIdentity) $ dynamicUpdated d
71 eInner = Reflex.Spider.Internal.switch $ dynamicUpdated <$> dynamicCurrent d
72 eBoth = Reflex.Spider.Internal.coincidence $ dynamicUpdated . runIdentity <$> dynamicUpdated d
73 v' = unSpiderEvent $ Reflex.Class.leftmost $ map SpiderEvent [eBoth, eOuter, eInner]
74 in Reflex.Spider.Internal.unsafeBuildDynamic readV0 v'
76instance HasSpiderTimeline x => Functor (Reflex.Class.Dynamic (SpiderTimeline x)) where
77 fmap f = SpiderDynamic . newMapDyn f . unSpiderDynamic
78 x <$ d = R.unsafeBuildDynamic (return x) $ x <$ R.updated d
80instance HasSpiderTimeline x => Applicative (Reflex.Class.Dynamic (SpiderTimeline x)) where
81 pure = SpiderDynamic . dynamicConst
82#if MIN_VERSION_base(4,10,0)
83 liftA2 f a b = SpiderDynamic $ Reflex.Spider.Internal.zipDynWith f (unSpiderDynamic a) (unSpiderDynamic b)
84#endif
85 SpiderDynamic a <*> SpiderDynamic b = SpiderDynamic $ Reflex.Spider.Internal.zipDynWith ($) a b
86 a *> b = R.unsafeBuildDynamic (R.sample $ R.current b) $ R.leftmost [R.updated b, R.tag (R.current b) $ R.updated a]
87 (<*) = flip (*>) -- There are no effects, so order doesn't matter
89holdSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Behavior (SpiderTimeline x) a)
90holdSpiderEventM v0 e = fmap (SpiderBehavior . behaviorHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
92holdDynSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)
93holdDynSpiderEventM v0 e = fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
95holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)
96holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e
98buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPullM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)
99buildDynamicSpiderEventM getV0 e = fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e
101instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where
102 {-# INLINABLE hold #-}
103 hold v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.hold v0 e
104 {-# INLINABLE holdDyn #-}
105 holdDyn v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdDyn v0 e
106 {-# INLINABLE holdIncremental #-}
107 holdIncremental v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdIncremental v0 e
108 {-# INLINABLE buildDynamic #-}
109 buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e
110 {-# INLINABLE headE #-}
111 headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e
113instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where
114 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can
116instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHostFrame x) where
117 {-# INLINABLE hold #-}
118 hold v0 e = SpiderHostFrame $ fmap (SpiderBehavior . behaviorHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
119 {-# INLINABLE holdDyn #-}
120 holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
121 {-# INLINABLE holdIncremental #-}
122 holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e
123 {-# INLINABLE buildDynamic #-}
124 buildDynamic getV0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e
125 {-# INLINABLE headE #-}
126 headE = R.slowHeadE
127-- headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e
129instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where
130 {-# INLINABLE sample #-}
131 sample = runFrame . readBehaviorUntracked . unSpiderBehavior
133instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where
134 {-# INLINABLE sample #-}
135 sample = Reflex.Spider.Internal.ReadPhase . Reflex.Class.sample
137instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where
138 {-# INLINABLE hold #-}
139 hold v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.hold v0 e
140 {-# INLINABLE holdDyn #-}
141 holdDyn v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdDyn v0 e
142 {-# INLINABLE holdIncremental #-}
143 holdIncremental v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdIncremental v0 e
144 {-# INLINABLE buildDynamic #-}
145 buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e
146 {-# INLINABLE headE #-}
147 headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e
149--------------------------------------------------------------------------------
150-- Deprecated items
151--------------------------------------------------------------------------------
153-- | 'SpiderEnv' is the old name for 'SpiderTimeline'
154{-# DEPRECATED SpiderEnv "Use 'SpiderTimelineEnv' instead" #-}
155type SpiderEnv = SpiderTimeline