git.iko.soy/patch
on 8442b5b help sign in
patch/src/Reflex/Spider/SpiderTimelineHost.include.hs
57 lines 2.7 kB history raw
1instance HasSpiderTimeline x => Reflex.Host.Class.MonadSubscribeEvent (SpiderTimeline x) (SpiderHostFrame x) where
2 {-# INLINABLE subscribeEvent #-}
3 subscribeEvent e = SpiderHostFrame $ do
4 --TODO: Unsubscribe eventually (manually and/or with weak ref)
5 val <- liftIO $ newIORef Nothing
6 subscription <- subscribe (unSpiderEvent e) $ Subscriber
7 { subscriberPropagate = \a -> do
8 liftIO $ writeIORef val $ Just a
9 scheduleClear val
10 , subscriberInvalidateHeight = \_ -> return ()
11 , subscriberRecalculateHeight = \_ -> return ()
12 }
13 return $ SpiderEventHandle
14 { spiderEventHandleSubscription = subscription
15 , spiderEventHandleValue = val
16 }
18instance HasSpiderTimeline x => Reflex.Host.Class.ReflexHost (SpiderTimeline x) where
19 type EventTrigger (SpiderTimeline x) = RootTrigger x
20 type EventHandle (SpiderTimeline x) = SpiderEventHandle x
21 type HostFrame (SpiderTimeline x) = SpiderHostFrame x
23instance HasSpiderTimeline x => Reflex.Host.Class.MonadReadEvent (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where
24 {-# NOINLINE readEvent #-}
25 readEvent h = Reflex.Spider.Internal.ReadPhase $ fmap (fmap return) $ liftIO $ do
26 result <- readIORef $ spiderEventHandleValue h
27 touch h
28 return result
30instance (
31#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
32 x ~ Global
33#endif
34 ) => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
35 newEventWithTrigger = SpiderHost . lift . fmap SpiderEvent . newEventWithTriggerIO
36 newFanEventWithTrigger f = SpiderHost $ lift $ do
37 es <- newFanEventWithTriggerIO f
38 return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es
40instance (
41#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
42 x ~ Global
43#endif
44 ) => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where
45 newEventWithTrigger = SpiderHostFrame . EventM . liftIO . fmap SpiderEvent . newEventWithTriggerIO
46 newFanEventWithTrigger f = SpiderHostFrame $ EventM $ liftIO $ do
47 es <- newFanEventWithTriggerIO f
48 return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es
50instance HasSpiderTimeline x => Reflex.Host.Class.MonadSubscribeEvent (SpiderTimeline x) (SpiderHost x) where
51 {-# INLINABLE subscribeEvent #-}
52 subscribeEvent = runFrame . runSpiderHostFrame . Reflex.Host.Class.subscribeEvent
54instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexHost (SpiderTimeline x) (SpiderHost x) where
55 type ReadPhase (SpiderHost x) = Reflex.Spider.Internal.ReadPhase x
56 fireEventsAndRead es (Reflex.Spider.Internal.ReadPhase a) = run es a
57 runHostFrame = runFrame . runSpiderHostFrame