git.iko.soy/patch
on c6e599b help sign in
patch/src/Reflex/Spider/SpiderTimeline.include.hs
135 lines 7.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
22instance (
23#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
24 x ~ Global
25#endif
26 ) => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where
27 {-# INLINABLE sample #-}
28 sample = coerce . readBehaviorTracked . unSpiderBehavior
30instance (
31#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
32 x ~ Global
33#endif
34 ) => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPushM x) where
35 {-# INLINABLE sample #-}
36 sample (SpiderBehavior b) = SpiderPushM $ readBehaviorUntracked b
38instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderPushM x) where
39 {-# INLINABLE hold #-}
40 hold v0 e = Reflex.Class.current <$> Reflex.Class.holdDyn v0 e
41 {-# INLINABLE holdDyn #-}
42 holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce e
43 {-# INLINABLE holdIncremental #-}
44 holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> Reflex.Spider.Internal.hold v0 e
45 {-# INLINABLE buildDynamic #-}
46 buildDynamic getV0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce e
48instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where
49 {-# INLINE return #-}
50 return = pure
51 {-# INLINE (>>=) #-}
52 x >>= f = SpiderDynamic $ dynamicDynIdentity $ newJoinDyn $ newMapDyn (unSpiderDynamic . f) $ unSpiderDynamic x
53 {-# INLINE (>>) #-}
54 _ >> y = y
55 {-# INLINE fail #-}
56 fail _ = error "Dynamic does not support 'fail'"
58newJoinDyn :: HasSpiderTimeline x => Reflex.Spider.Internal.Dynamic x (Identity (Reflex.Spider.Internal.Dynamic x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
59newJoinDyn d =
60 let readV0 = readBehaviorTracked . dynamicCurrent =<< readBehaviorTracked (dynamicCurrent d)
61 eOuter = Reflex.Spider.Internal.push (fmap (Just . Identity) . readBehaviorUntracked . dynamicCurrent . runIdentity) $ dynamicUpdated d
62 eInner = Reflex.Spider.Internal.switch $ dynamicUpdated <$> dynamicCurrent d
63 eBoth = Reflex.Spider.Internal.coincidence $ dynamicUpdated . runIdentity <$> dynamicUpdated d
64 v' = unSpiderEvent $ Reflex.Class.leftmost $ map SpiderEvent [eBoth, eOuter, eInner]
65 in Reflex.Spider.Internal.unsafeBuildDynamic readV0 v'
67instance HasSpiderTimeline x => Functor (Reflex.Class.Dynamic (SpiderTimeline x)) where
68 fmap f = SpiderDynamic . newMapDyn f . unSpiderDynamic
70instance HasSpiderTimeline x => Applicative (Reflex.Class.Dynamic (SpiderTimeline x)) where
71 pure = SpiderDynamic . dynamicConst
72 SpiderDynamic a <*> SpiderDynamic b = SpiderDynamic $ Reflex.Spider.Internal.zipDynWith ($) a b
73 _ *> b = b
74 a <* _ = a
76holdSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Behavior (SpiderTimeline x) a)
77holdSpiderEventM v0 e = fmap (SpiderBehavior . behaviorHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
79holdDynSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)
80holdDynSpiderEventM v0 e = fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
82holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)
83holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e
85buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPullM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)
86buildDynamicSpiderEventM getV0 e = fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e
88instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where
89 {-# INLINABLE hold #-}
90 hold v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.hold v0 e
91 {-# INLINABLE holdDyn #-}
92 holdDyn v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdDyn v0 e
93 {-# INLINABLE holdIncremental #-}
94 holdIncremental v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdIncremental v0 e
95 {-# INLINABLE buildDynamic #-}
96 buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e
98instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where
99 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can
101instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHostFrame x) where
102 {-# INLINABLE hold #-}
103 hold v0 e = SpiderHostFrame $ fmap (SpiderBehavior . behaviorHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
104 {-# INLINABLE holdDyn #-}
105 holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
106 {-# INLINABLE holdIncremental #-}
107 holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e
108 {-# INLINABLE buildDynamic #-}
109 buildDynamic getV0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e
111instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where
112 {-# INLINABLE sample #-}
113 sample = runFrame . readBehaviorUntracked . unSpiderBehavior
115instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where
116 {-# INLINABLE sample #-}
117 sample = Reflex.Spider.Internal.ReadPhase . Reflex.Class.sample
119instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where
120 {-# INLINABLE hold #-}
121 hold v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.hold v0 e
122 {-# INLINABLE holdDyn #-}
123 holdDyn v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdDyn v0 e
124 {-# INLINABLE holdIncremental #-}
125 holdIncremental v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdIncremental v0 e
126 {-# INLINABLE buildDynamic #-}
127 buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e
129--------------------------------------------------------------------------------
130-- Deprecated items
131--------------------------------------------------------------------------------
133-- | 'SpiderEnv' is the old name for 'SpiderTimeline'
134{-# DEPRECATED SpiderEnv "Use 'SpiderTimelineEnv' instead" #-}
135type SpiderEnv = SpiderTimeline