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