1782d8a · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Get rid of specialize-to-spidertimeline-global flag

1782d8aRyan Trinkle8 years ago

reflex.cabal+9−24

compare with develop

unifiedsplit

@@ -13,11 +13,6 @@ Cabal-version: >=1.9.2

13homepage: https://github.com/reflex-frp/reflex

14bug-reports: https://github.com/reflex-frp/reflex/issues

16−flag specialize-to-spidertimeline-global

17− description: Specialize all Reflex functions to the SpiderTimeline Global implementation. This may improve performance, but will disable all other implementations.

18− default: False

19− manual: True

20−

21flag use-reflex-optimizer

16flag use-reflex-optimizer

22 description: Use the GHC plugin Reflex.Optimizer on some of the modules in the package. This is still experimental.

17 description: Use the GHC plugin Reflex.Optimizer on some of the modules in the package. This is still experimental.

23 default: False

18 default: False

@@ -69,22 +64,22 @@ library

70 exposed-modules:

65 exposed-modules:

71 Data.AppendMap,

66 Data.AppendMap,

72− Data.Map.Misc,

67+ Data.FastMutableIntMap,

68+ Data.FastWeakBag,

73 Data.Functor.Misc,

69 Data.Functor.Misc,

70+ Data.Map.Misc,

74 Data.WeakBag,

71 Data.WeakBag,

75− Data.FastWeakBag,

76− Data.FastMutableIntMap,

77 Reflex,

72 Reflex,

78 Reflex.Class,

73 Reflex.Class,

79 Reflex.Collection,

74 Reflex.Collection,

80− Reflex.EventWriter,

81− Reflex.EventWriter.Base,

82− Reflex.EventWriter.Class,

83 Reflex.Dynamic,

75 Reflex.Dynamic,

84 Reflex.Dynamic.Uniq,

76 Reflex.Dynamic.Uniq,

85 Reflex.DynamicWriter,

77 Reflex.DynamicWriter,

86 Reflex.DynamicWriter.Base,

78 Reflex.DynamicWriter.Base,

87 Reflex.DynamicWriter.Class,

79 Reflex.DynamicWriter.Class,

80+ Reflex.EventWriter,

81+ Reflex.EventWriter.Base,

82+ Reflex.EventWriter.Class,

88 Reflex.FastWeak,

83 Reflex.FastWeak,

89 Reflex.FunctorMaybe,

84 Reflex.FunctorMaybe,

90 Reflex.Host.Class,

85 Reflex.Host.Class,

@@ -97,13 +92,12 @@ library

97 Reflex.Patch.IntMap,

92 Reflex.Patch.IntMap,

98 Reflex.Patch.Map,

93 Reflex.Patch.Map,

99 Reflex.Patch.MapWithMove,

94 Reflex.Patch.MapWithMove,

100− Reflex.TriggerEvent.Base,

101− Reflex.TriggerEvent.Class,

102 Reflex.PerformEvent.Base,

95 Reflex.PerformEvent.Base,

103 Reflex.PerformEvent.Class,

96 Reflex.PerformEvent.Class,

104 Reflex.PostBuild.Base,

97 Reflex.PostBuild.Base,

105 Reflex.PostBuild.Class,

98 Reflex.PostBuild.Class,

106 Reflex.Profiled,

99 Reflex.Profiled,

100+ Reflex.Pure,

107 Reflex.Query.Base,

101 Reflex.Query.Base,

108 Reflex.Query.Class,

102 Reflex.Query.Class,

109 Reflex.Requester.Base,

103 Reflex.Requester.Base,

@@ -111,17 +105,14 @@ library

111 Reflex.Spider,

105 Reflex.Spider,

112 Reflex.Spider.Internal,

106 Reflex.Spider.Internal,

113 Reflex.Time,

107 Reflex.Time,

108+ Reflex.TriggerEvent.Base,

109+ Reflex.TriggerEvent.Class,

114 Reflex.Widget.Basic,

110 Reflex.Widget.Basic,

115 Reflex.Workflow

111 Reflex.Workflow

116

112

117 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -fspecialise-aggressively -ddump-simpl -ddump-to-file -dsuppress-coercions -dsuppress-idinfo

113 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -fspecialise-aggressively -ddump-simpl -ddump-to-file -dsuppress-coercions -dsuppress-idinfo

118 ghc-prof-options: -fprof-auto

114 ghc-prof-options: -fprof-auto

119

115

120− if flag(specialize-to-spidertimeline-global)

121− cpp-options: -DSPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

122− else

123− exposed-modules: Reflex.Pure

124−

125 if flag(debug-trace-events)

116 if flag(debug-trace-events)

126 cpp-options: -DDEBUG_TRACE_EVENTS

117 cpp-options: -DDEBUG_TRACE_EVENTS

127 build-depends: bytestring

118 build-depends: bytestring

@@ -168,8 +159,6 @@ test-suite semantics

168 reflex,

159 reflex,

169 split,

160 split,

170 transformers >= 0.3

161 transformers >= 0.3

171− if flag(specialize-to-spidertimeline-global)

172− buildable: False

173

162

174test-suite CrossImpl

163test-suite CrossImpl

175 type: exitcode-stdio-1.0

164 type: exitcode-stdio-1.0

@@ -183,8 +172,6 @@ test-suite CrossImpl

183 mtl,

172 mtl,

184 ref-tf,

173 ref-tf,

185 reflex

174 reflex

186− if flag(specialize-to-spidertimeline-global)

187− buildable: False

188

175

189test-suite hlint

176test-suite hlint

190 type: exitcode-stdio-1.0

177 type: exitcode-stdio-1.0

@@ -244,8 +231,6 @@ test-suite GC-Semantics

244 type: exitcode-stdio-1.0

231 type: exitcode-stdio-1.0

245 main-is: GC.hs

232 main-is: GC.hs

246 hs-source-dirs: test

233 hs-source-dirs: test

247− if flag(specialize-to-spidertimeline-global)

248− buildable: False

249 build-depends: base

234 build-depends: base

250 , dependent-sum

235 , dependent-sum

251 , dependent-map

236 , dependent-map

src/Reflex/Class.hs−127

@@ -19,10 +19,6 @@

19#ifdef USE_REFLEX_OPTIMIZER

20{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

21#endif

22−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

23−{-# LANGUAGE EmptyDataDecls #-}

24−{-# OPTIONS_GHC -Wno-redundant-constraints #-}

25−#endif

27-- | This module contains the Reflex interface, as well as a variety of

23-- | This module contains the Reflex interface, as well as a variety of

28-- convenience functions for working with 'Event's, 'Behavior's, and other

24-- convenience functions for working with 'Event's, 'Behavior's, and other

@@ -148,37 +144,6 @@ module Reflex.Class

148 , switchPromptOnly

144 , switchPromptOnly

149 -- * Slow, but general, implementations

145 -- * Slow, but general, implementations

150 , slowHeadE

146 , slowHeadE

151−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

152− , Spider

153− , SpiderEnv

154− , SpiderTimeline

155− , Global

156− , Behavior (..)

157− , Event (..)

158− , Dynamic (..)

159− , Incremental (..)

160− , never

161− , constant

162− , push

163− , pushCheap

164− , pull

165− , merge

166− , fan

167− , switch

168− , coincidence

169− , current

170− , updated

171− , unsafeBuildDynamic

172− , unsafeBuildIncremental

173− , mergeIncremental

174− , mergeIncrementalWithMove

175− , currentIncremental

176− , updatedIncremental

177− , incrementalToDynamic

178− , behaviorCoercion

179− , eventCoercion

180− , dynamicCoercion

181−#endif

182 ) where

147 ) where

183

148

184import Control.Applicative

149import Control.Applicative

@@ -217,26 +182,11 @@ import Reflex.FunctorMaybe

217import Reflex.Patch

182import Reflex.Patch

218import Data.FastMutableIntMap (PatchIntMap)

183import Data.FastMutableIntMap (PatchIntMap)

219

184

220−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

221−import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..), SpiderHostFrame (..),

222− SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,

223− dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,

224− dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,

225− runFrame, runSpiderHostFrame)

226−import qualified Reflex.Spider.Internal

227−import qualified Reflex.Spider.Internal as S

228−import Unsafe.Coerce

229−#endif

230−

231-- Note: must come last to silence warnings due to AMP on GHC < 7.10

185-- Note: must come last to silence warnings due to AMP on GHC < 7.10

232import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)

186import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)

233

187

234import Debug.Trace (trace)

188import Debug.Trace (trace)

235

189

236−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

237−#include "Spider/SpiderTimeline.include.hs"

238−#endif

239−

240-- | The 'Reflex' class contains all the primitive functionality needed for

190-- | The 'Reflex' class contains all the primitive functionality needed for

241-- Functional Reactive Programming (FRP). The @t@ type parameter indicates

191-- Functional Reactive Programming (FRP). The @t@ type parameter indicates

242-- which "timeline" is in use. Timelines are fully-independent FRP contexts,

192-- which "timeline" is in use. Timelines are fully-independent FRP contexts,

@@ -248,9 +198,6 @@ class ( MonadHold t (PushM t)

248 , Functor (Dynamic t)

198 , Functor (Dynamic t)

249 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8

199 , Applicative (Dynamic t) -- Necessary for GHC <= 7.8

250 , Monad (Dynamic t)

200 , Monad (Dynamic t)

251−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

252− , t ~ SpiderTimeline Global

253−#endif

254 ) => Reflex t where

201 ) => Reflex t where

255 -- | A container for a value that can change over time. 'Behavior's can be

202 -- | A container for a value that can change over time. 'Behavior's can be

256 -- sampled at will, but it is not possible to be notified when they change

203 -- sampled at will, but it is not possible to be notified when they change

@@ -273,7 +220,6 @@ class ( MonadHold t (PushM t)

273 type PushM t :: * -> *

220 type PushM t :: * -> *

274 -- | A monad for doing complex pull-based calculations efficiently

221 -- | A monad for doing complex pull-based calculations efficiently

275 type PullM t :: * -> *

222 type PullM t :: * -> *

276−#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

277 -- | An 'Event' with no occurrences

223 -- | An 'Event' with no occurrences

278 never :: Event t a

224 never :: Event t a

279 -- | Create a 'Behavior' that always has the given value

225 -- | Create a 'Behavior' that always has the given value

@@ -333,84 +279,11 @@ class ( MonadHold t (PushM t)

333 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)

279 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)

334 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)

280 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)

335 fanInt :: Event t (IntMap a) -> EventSelectorInt t a

281 fanInt :: Event t (IntMap a) -> EventSelectorInt t a

336−#endif

337

282

338--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on

283--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on

339mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)

284mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)

340mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never

285mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never

341

286

342−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

343−instance t ~ SpiderTimeline Global => Reflex t where

344− newtype Behavior t a = SpiderBehavior { unSpiderBehavior :: Reflex.Spider.Internal.Behavior Global a }

345− newtype Event t a = SpiderEvent { unSpiderEvent :: Reflex.Spider.Internal.Event Global a }

346− newtype Dynamic t a = SpiderDynamic { unSpiderDynamic :: Reflex.Spider.Internal.Dynamic Global (Identity a) } -- deriving (Functor, Applicative, Monad)

347− newtype Incremental t p = SpiderIncremental { unSpiderIncremental :: Reflex.Spider.Internal.Dynamic Global p }

348− type PullM t = SpiderPullM Global

349− type PushM t = SpiderPushM Global

350−never :: Reflex t => Event t a

351−constant :: Reflex t => a -> Behavior t a

352−push :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b

353−pushCheap :: Reflex t => (a -> PushM t (Maybe b)) -> Event t a -> Event t b

354−pull :: Reflex t => PullM t a -> Behavior t a

355−merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)

356−fan :: (Reflex t, GCompare k) => Event t (DMap k Identity) -> EventSelector t k

357−switch :: Reflex t => Behavior t (Event t a) -> Event t a

358−coincidence :: Reflex t => Event t (Event t a) -> Event t a

359−current :: Reflex t => Dynamic t a -> Behavior t a

360−updated :: Reflex t => Dynamic t a -> Event t a

361−unsafeBuildDynamic :: Reflex t => PullM t a -> Event t a -> Dynamic t a

362−unsafeBuildIncremental :: (Reflex t, Patch p) => PullM t (PatchTarget p) -> Event t p -> Incremental t p

363−mergeIncremental :: (Reflex t, GCompare k) => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)

364−mergeIncrementalWithMove :: (Reflex t, GCompare k) => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)

365−currentIncremental :: (Reflex t, Patch p) => Incremental t p -> Behavior t (PatchTarget p)

366−updatedIncremental :: (Reflex t, Patch p) => Incremental t p -> Event t p

367−incrementalToDynamic :: (Reflex t, Patch p) => Incremental t p -> Dynamic t (PatchTarget p)

368−behaviorCoercion :: Reflex t => Coercion a b -> Coercion (Behavior t a) (Behavior t b)

369−eventCoercion :: Reflex t => Coercion a b -> Coercion (Event t a) (Event t b)

370−dynamicCoercion :: Reflex t => Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)

371−{-# INLINE never #-}

372−never = SpiderEvent S.eventNever

373−{-# INLINE constant #-}

374−constant = SpiderBehavior . S.behaviorConst

375−{-# INLINE push #-}

376−push f = SpiderEvent . S.push (coerce f) . unSpiderEvent

377−{-# INLINE pushCheap #-}

378−pushCheap f = SpiderEvent . S.pushCheap (coerce f) . unSpiderEvent

379−{-# INLINE pull #-}

380−pull = SpiderBehavior . S.pull . coerce

381−{-# INLINE merge #-}

382−merge = SpiderEvent . S.merge . S.dynamicConst . (coerce :: DMap k (Event (SpiderTimeline x)) -> DMap k (S.Event x))

383−{-# INLINE fan #-}

384−fan e = EventSelector $ SpiderEvent . S.select (S.fan (unSpiderEvent e))

385−{-# INLINE switch #-}

386−switch = SpiderEvent . S.switch . (coerce :: S.Behavior x (Event (SpiderTimeline x) a) -> S.Behavior x (S.Event x a)) . unSpiderBehavior

387−{-# INLINE coincidence #-}

388−coincidence = SpiderEvent . S.coincidence . (coerce :: S.Event x (Event (SpiderTimeline x) a) -> S.Event x (S.Event x a)) . unSpiderEvent

389−{-# INLINE current #-}

390−current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic

391−{-# INLINE updated #-}

392−updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic

393−{-# INLINE unsafeBuildDynamic #-}

394−unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'

395−{-# INLINE unsafeBuildIncremental #-}

396−unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ S.unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv

397−{-# INLINE mergeIncremental #-}

398−mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental

399−{-# INLINE mergeIncrementalWithMove #-}

400−mergeIncrementalWithMove = SpiderEvent . S.mergeWithMove . (unsafeCoerce :: S.Dynamic x (PatchDMapWithMove k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMapWithMove k (S.Event x))) . unSpiderIncremental

401−{-# INLINE currentIncremental #-}

402−currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental

403−{-# INLINE updatedIncremental #-}

404−updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental

405−{-# INLINE incrementalToDynamic #-}

406−incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do

407− c <- readBehaviorUntracked $ dynamicCurrent i

408− return $ Identity <$> apply p c

409−eventCoercion Coercion = Coercion

410−behaviorCoercion Coercion = Coercion

411−dynamicCoercion = unsafeCoerce

412−#endif

413−

414-- | Coerce a 'Behavior' between representationally-equivalent value types

287-- | Coerce a 'Behavior' between representationally-equivalent value types

415coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b

288coerceBehavior :: (Reflex t, Coercible a b) => Behavior t a -> Behavior t b

416coerceBehavior = coerceWith $ behaviorCoercion Coercion

289coerceBehavior = coerceWith $ behaviorCoercion Coercion

src/Reflex/Host/Class.hs−13

@@ -47,22 +47,9 @@ import Data.Dependent.Sum (DSum (..))

47import Data.GADT.Compare

48import Data.Monoid

50−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

51−import Control.Monad.Primitive (touch)

52−import Data.IORef

53−import Reflex.Spider.Internal (EventM (..), HasSpiderTimeline, RootTrigger, SpiderEventHandle (..),

54− SpiderHost (..), SpiderHostFrame (..), Subscriber (..), newEventWithTriggerIO,

55− newFanEventWithTriggerIO, run, runFrame, scheduleClear, subscribe)

56−import qualified Reflex.Spider.Internal

57−#endif

58−

59-- Note: this import must come last to silence warnings from AMP

50-- Note: this import must come last to silence warnings from AMP

60import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)

51import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)

62−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

63−#include "../Spider/SpiderTimelineHost.include.hs"

64−#endif

65−

66-- | Framework implementation support class for the reflex implementation

53-- | Framework implementation support class for the reflex implementation

67-- represented by @t@.

54-- represented by @t@.

68class ( Reflex t

55class ( Reflex t

src/Reflex/Spider.hs−5

@@ -7,16 +7,11 @@ module Reflex.Spider

7 , Global

8 , SpiderHost

9 , runSpiderHost

10−#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

11 , runSpiderHostForTimeline

10 , runSpiderHostForTimeline

12 , newSpiderTimeline

11 , newSpiderTimeline

13 , withSpiderTimeline

12 , withSpiderTimeline

14−#endif

15 -- * Deprecated

13 -- * Deprecated

16 , SpiderEnv

14 , SpiderEnv

17 ) where

15 ) where

19−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

20−import Reflex.Class

21−#endif

22import Reflex.Spider.Internal

17import Reflex.Spider.Internal

src/Reflex/Spider/Internal.hs+194−21

@@ -21,9 +21,6 @@

21#ifdef USE_REFLEX_OPTIMIZER

22{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

23#endif

24−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

25−{-# OPTIONS_GHC -fno-warn-orphans #-}

26−#endif

27-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses

24-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses

28-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.

25-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.

29module Reflex.Spider.Internal (module Reflex.Spider.Internal) where

26module Reflex.Spider.Internal (module Reflex.Spider.Internal) where

@@ -80,7 +77,6 @@ import Data.FastWeakBag (FastWeakBag)

80import qualified Data.FastWeakBag as FastWeakBag

77import qualified Data.FastWeakBag as FastWeakBag

81import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)

78import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)

82import qualified Data.WeakBag as WeakBag

79import qualified Data.WeakBag as WeakBag

83−#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

84import Data.Reflection

80import Data.Reflection

85import Data.Some (Some)

81import Data.Some (Some)

86import qualified Data.Some as Some

82import qualified Data.Some as Some

@@ -88,7 +84,6 @@ import Data.Type.Coercion

88import qualified Reflex.Class

84import qualified Reflex.Class

89import qualified Reflex.Class as R

85import qualified Reflex.Class as R

90import qualified Reflex.Host.Class

86import qualified Reflex.Host.Class

91−#endif

92import Reflex.NotReady.Class

87import Reflex.NotReady.Class

93import Reflex.Patch

88import Reflex.Patch

94import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove

89import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove

@@ -760,9 +755,7 @@ data Hold x p

760#endif

755#endif

761 }

756 }

762

757

763−-- | A statically allocated 'SpiderTimeline'; this is the only instance of

758+-- | A statically allocated 'SpiderTimeline'

764−-- 'SpiderTimeline' that can used when using

765−-- -fspecialize-to-spidertimeline-global.

766data Global

759data Global

767

760

768{-# NOINLINE globalSpiderTimelineEnv #-}

761{-# NOINLINE globalSpiderTimelineEnv #-}

@@ -856,11 +849,7 @@ instance HasSpiderTimeline x => HasCurrentHeight x (EventM x) where

856 delayedRef <- asksEventEnv eventEnvDelayedMerges

849 delayedRef <- asksEventEnv eventEnvDelayedMerges

857 liftIO $ modifyIORef' delayedRef $ IntMap.insertWith (++) (unHeight height) [subscribed]

850 liftIO $ modifyIORef' delayedRef $ IntMap.insertWith (++) (unHeight height) [subscribed]

858

851

859−#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

860−class x ~ Global => HasSpiderTimeline x where

861−#else

862class HasSpiderTimeline x where

852class HasSpiderTimeline x where

863−#endif

864 -- | Retrieve the current SpiderTimelineEnv

853 -- | Retrieve the current SpiderTimelineEnv

865 spiderTimeline :: SpiderTimelineEnv x

854 spiderTimeline :: SpiderTimelineEnv x

866

855

@@ -2246,13 +2235,203 @@ invalidate toReconnectRef wis = do

2246-- Reflex integration

2235-- Reflex integration

2247--------------------------------------------------------------------------------

2236--------------------------------------------------------------------------------

2248

2237

2249−#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

2250-- When we're specializing, we include this from Reflex.Class instead, because

2238-- When we're specializing, we include this from Reflex.Class instead, because

2251-- it needs access to these types; when we're not, we want them here, so our

2239-- it needs access to these types; when we're not, we want them here, so our

2252-- instance isn't an orphan instance.

2240-- instance isn't an orphan instance.

2253−#include "SpiderTimeline.include.hs"

2241+-- | Designates the default, global Spider timeline

2254−#include "SpiderTimelineHost.include.hs"

2242+data SpiderTimeline x

2243+type role SpiderTimeline nominal

2244+

2245+-- | The default, global Spider environment

2246+type Spider = SpiderTimeline Global

2247+

2248+instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (EventM x) where

2249+ {-# INLINABLE sample #-}

2250+ sample (SpiderBehavior b) = readBehaviorUntracked b

2251+

2252+instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (EventM x) where

2253+ {-# INLINABLE hold #-}

2254+ hold = holdSpiderEventM

2255+ {-# INLINABLE holdDyn #-}

2256+ holdDyn = holdDynSpiderEventM

2257+ {-# INLINABLE holdIncremental #-}

2258+ holdIncremental = holdIncrementalSpiderEventM

2259+ {-# INLINABLE buildDynamic #-}

2260+ buildDynamic = buildDynamicSpiderEventM

2261+ {-# INLINABLE headE #-}

2262+ headE = R.slowHeadE

2263+-- headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e

2264+

2265+instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where

2266+ {-# INLINABLE sample #-}

2267+ sample = coerce . readBehaviorTracked . unSpiderBehavior

2268+

2269+instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPushM x) where

2270+ {-# INLINABLE sample #-}

2271+ sample (SpiderBehavior b) = SpiderPushM $ readBehaviorUntracked b

2272+

2273+instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderPushM x) where

2274+ {-# INLINABLE hold #-}

2275+ hold v0 e = Reflex.Class.current <$> Reflex.Class.holdDyn v0 e

2276+ {-# INLINABLE holdDyn #-}

2277+ holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce e

2278+ {-# INLINABLE holdIncremental #-}

2279+ holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> Reflex.Spider.Internal.hold v0 e

2280+ {-# INLINABLE buildDynamic #-}

2281+ buildDynamic getV0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce e

2282+ {-# INLINABLE headE #-}

2283+ headE = R.slowHeadE

2284+-- headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2285+

2286+instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where

2287+ {-# INLINE return #-}

2288+ return = pure

2289+ {-# INLINE (>>=) #-}

2290+ x >>= f = SpiderDynamic $ dynamicDynIdentity $ newJoinDyn $ newMapDyn (unSpiderDynamic . f) $ unSpiderDynamic x

2291+ {-# INLINE (>>) #-}

2292+ (>>) = (*>)

2293+ {-# INLINE fail #-}

2294+ fail _ = error "Dynamic does not support 'fail'"

2295+

2296+{-# INLINABLE newJoinDyn #-}

2297+newJoinDyn :: HasSpiderTimeline x => Reflex.Spider.Internal.Dynamic x (Identity (Reflex.Spider.Internal.Dynamic x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)

2298+newJoinDyn d =

2299+ let readV0 = readBehaviorTracked . dynamicCurrent =<< readBehaviorTracked (dynamicCurrent d)

2300+ eOuter = Reflex.Spider.Internal.push (fmap (Just . Identity) . readBehaviorUntracked . dynamicCurrent . runIdentity) $ dynamicUpdated d

2301+ eInner = Reflex.Spider.Internal.switch $ dynamicUpdated <$> dynamicCurrent d

2302+ eBoth = Reflex.Spider.Internal.coincidence $ dynamicUpdated . runIdentity <$> dynamicUpdated d

2303+ v' = unSpiderEvent $ Reflex.Class.leftmost $ map SpiderEvent [eBoth, eOuter, eInner]

2304+ in Reflex.Spider.Internal.unsafeBuildDynamic readV0 v'

2305+

2306+instance HasSpiderTimeline x => Functor (Reflex.Class.Dynamic (SpiderTimeline x)) where

2307+ fmap f = SpiderDynamic . newMapDyn f . unSpiderDynamic

2308+ x <$ d = R.unsafeBuildDynamic (return x) $ x <$ R.updated d

2309+

2310+instance HasSpiderTimeline x => Applicative (Reflex.Class.Dynamic (SpiderTimeline x)) where

2311+ pure = SpiderDynamic . dynamicConst

2312+#if MIN_VERSION_base(4,10,0)

2313+ liftA2 f a b = SpiderDynamic $ Reflex.Spider.Internal.zipDynWith f (unSpiderDynamic a) (unSpiderDynamic b)

2255#endif

2314#endif

2315+ SpiderDynamic a <*> SpiderDynamic b = SpiderDynamic $ Reflex.Spider.Internal.zipDynWith ($) a b

2316+ a *> b = R.unsafeBuildDynamic (R.sample $ R.current b) $ R.leftmost [R.updated b, R.tag (R.current b) $ R.updated a]

2317+ (<*) = flip (*>) -- There are no effects, so order doesn't matter

2318+

2319+holdSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Behavior (SpiderTimeline x) a)

2320+holdSpiderEventM v0 e = fmap (SpiderBehavior . behaviorHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e

2321+

2322+holdDynSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)

2323+holdDynSpiderEventM v0 e = fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e

2324+

2325+holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)

2326+holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

2327+

2328+buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPullM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)

2329+buildDynamicSpiderEventM getV0 e = fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e

2330+

2331+instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where

2332+ {-# INLINABLE hold #-}

2333+ hold v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.hold v0 e

2334+ {-# INLINABLE holdDyn #-}

2335+ holdDyn v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdDyn v0 e

2336+ {-# INLINABLE holdIncremental #-}

2337+ holdIncremental v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdIncremental v0 e

2338+ {-# INLINABLE buildDynamic #-}

2339+ buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e

2340+ {-# INLINABLE headE #-}

2341+ headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e

2342+

2343+instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where

2344+ sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

2345+

2346+instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHostFrame x) where

2347+ {-# INLINABLE hold #-}

2348+ hold v0 e = SpiderHostFrame $ fmap (SpiderBehavior . behaviorHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e

2349+ {-# INLINABLE holdDyn #-}

2350+ holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e

2351+ {-# INLINABLE holdIncremental #-}

2352+ holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

2353+ {-# INLINABLE buildDynamic #-}

2354+ buildDynamic getV0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e

2355+ {-# INLINABLE headE #-}

2356+ headE = R.slowHeadE

2357+-- headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2358+

2359+instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where

2360+ {-# INLINABLE sample #-}

2361+ sample = runFrame . readBehaviorUntracked . unSpiderBehavior

2362+

2363+instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where

2364+ {-# INLINABLE sample #-}

2365+ sample = Reflex.Spider.Internal.ReadPhase . Reflex.Class.sample

2366+

2367+instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where

2368+ {-# INLINABLE hold #-}

2369+ hold v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.hold v0 e

2370+ {-# INLINABLE holdDyn #-}

2371+ holdDyn v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdDyn v0 e

2372+ {-# INLINABLE holdIncremental #-}

2373+ holdIncremental v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdIncremental v0 e

2374+ {-# INLINABLE buildDynamic #-}

2375+ buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e

2376+ {-# INLINABLE headE #-}

2377+ headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e

2378+

2379+--------------------------------------------------------------------------------

2380+-- Deprecated items

2381+--------------------------------------------------------------------------------

2382+

2383+-- | 'SpiderEnv' is the old name for 'SpiderTimeline'

2384+{-# DEPRECATED SpiderEnv "Use 'SpiderTimelineEnv' instead" #-}

2385+type SpiderEnv = SpiderTimeline

2386+instance HasSpiderTimeline x => Reflex.Host.Class.MonadSubscribeEvent (SpiderTimeline x) (SpiderHostFrame x) where

2387+ {-# INLINABLE subscribeEvent #-}

2388+ subscribeEvent e = SpiderHostFrame $ do

2389+ --TODO: Unsubscribe eventually (manually and/or with weak ref)

2390+ val <- liftIO $ newIORef Nothing

2391+ subscription <- subscribe (unSpiderEvent e) $ Subscriber

2392+ { subscriberPropagate = \a -> do

2393+ liftIO $ writeIORef val $ Just a

2394+ scheduleClear val

2395+ , subscriberInvalidateHeight = \_ -> return ()

2396+ , subscriberRecalculateHeight = \_ -> return ()

2397+ }

2398+ return $ SpiderEventHandle

2399+ { spiderEventHandleSubscription = subscription

2400+ , spiderEventHandleValue = val

2401+ }

2402+

2403+instance HasSpiderTimeline x => Reflex.Host.Class.ReflexHost (SpiderTimeline x) where

2404+ type EventTrigger (SpiderTimeline x) = RootTrigger x

2405+ type EventHandle (SpiderTimeline x) = SpiderEventHandle x

2406+ type HostFrame (SpiderTimeline x) = SpiderHostFrame x

2407+

2408+instance HasSpiderTimeline x => Reflex.Host.Class.MonadReadEvent (SpiderTimeline x) (Reflex.Spider.Internal.ReadPhase x) where

2409+ {-# NOINLINE readEvent #-}

2410+ readEvent h = Reflex.Spider.Internal.ReadPhase $ fmap (fmap return) $ liftIO $ do

2411+ result <- readIORef $ spiderEventHandleValue h

2412+ touch h

2413+ return result

2414+

2415+instance Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where

2416+ newEventWithTrigger = SpiderHost . lift . fmap SpiderEvent . newEventWithTriggerIO

2417+ newFanEventWithTrigger f = SpiderHost $ lift $ do

2418+ es <- newFanEventWithTriggerIO f

2419+ return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es

2420+

2421+instance Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where

2422+ newEventWithTrigger = SpiderHostFrame . EventM . liftIO . fmap SpiderEvent . newEventWithTriggerIO

2423+ newFanEventWithTrigger f = SpiderHostFrame $ EventM $ liftIO $ do

2424+ es <- newFanEventWithTriggerIO f

2425+ return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es

2426+

2427+instance HasSpiderTimeline x => Reflex.Host.Class.MonadSubscribeEvent (SpiderTimeline x) (SpiderHost x) where

2428+ {-# INLINABLE subscribeEvent #-}

2429+ subscribeEvent = runFrame . runSpiderHostFrame . Reflex.Host.Class.subscribeEvent

2430+

2431+instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexHost (SpiderTimeline x) (SpiderHost x) where

2432+ type ReadPhase (SpiderHost x) = Reflex.Spider.Internal.ReadPhase x

2433+ fireEventsAndRead es (Reflex.Spider.Internal.ReadPhase a) = run es a

2434+ runHostFrame = runFrame . runSpiderHostFrame

2256

2435

2257unsafeNewSpiderTimelineEnv :: forall x. IO (SpiderTimelineEnv x)

2436unsafeNewSpiderTimelineEnv :: forall x. IO (SpiderTimelineEnv x)

2258unsafeNewSpiderTimelineEnv = do

2437unsafeNewSpiderTimelineEnv = do

@@ -2269,7 +2448,6 @@ unsafeNewSpiderTimelineEnv = do

2269#endif

2448#endif

2270 }

2449 }

2271

2450

2272−#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

2273-- | Create a new SpiderTimelineEnv

2451-- | Create a new SpiderTimelineEnv

2274newSpiderTimeline :: IO (Some SpiderTimelineEnv)

2452newSpiderTimeline :: IO (Some SpiderTimelineEnv)

2275newSpiderTimeline = withSpiderTimeline (pure . Some.This)

2453newSpiderTimeline = withSpiderTimeline (pure . Some.This)

@@ -2291,7 +2469,6 @@ withSpiderTimeline :: (forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> I

2291withSpiderTimeline k = do

2469withSpiderTimeline k = do

2292 env <- unsafeNewSpiderTimelineEnv

2470 env <- unsafeNewSpiderTimelineEnv

2293 reify env $ \s -> k $ localSpiderTimeline s env

2471 reify env $ \s -> k $ localSpiderTimeline s env

2294−#endif

2295

2472

2296newtype SpiderPullM x a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2473newtype SpiderPullM x a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2297

2474

@@ -2299,7 +2476,6 @@ type ComputeM = EventM

2299

2476

2300newtype SpiderPushM x a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2477newtype SpiderPushM x a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2301

2478

2302−#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

2303instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2479instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2304 {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}

2480 {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}

2305 newtype Behavior (SpiderTimeline x) a = SpiderBehavior { unSpiderBehavior :: Behavior x a }

2481 newtype Behavior (SpiderTimeline x) a = SpiderBehavior { unSpiderBehavior :: Behavior x a }

@@ -2353,7 +2529,6 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2353 mergeIntIncremental = SpiderEvent . mergeInt . (unsafeCoerce :: Dynamic x (PatchIntMap (R.Event (SpiderTimeline x) a)) -> Dynamic x (PatchIntMap (Event x a))) . unSpiderIncremental

2529 mergeIntIncremental = SpiderEvent . mergeInt . (unsafeCoerce :: Dynamic x (PatchIntMap (R.Event (SpiderTimeline x) a)) -> Dynamic x (PatchIntMap (Event x a))) . unSpiderIncremental

2354 {-# INLINABLE fanInt #-}

2530 {-# INLINABLE fanInt #-}

2355 fanInt e = R.EventSelectorInt $ SpiderEvent . selectInt (fanInt (unSpiderEvent e))

2531 fanInt e = R.EventSelectorInt $ SpiderEvent . selectInt (fanInt (unSpiderEvent e))

2356−#endif

2357

2532

2358data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)

2533data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)

2359

2534

@@ -2393,12 +2568,10 @@ instance Monad (SpiderHost x) where

2393runSpiderHost :: SpiderHost Global a -> IO a

2568runSpiderHost :: SpiderHost Global a -> IO a

2394runSpiderHost (SpiderHost a) = runReaderT a globalSpiderTimelineEnv

2569runSpiderHost (SpiderHost a) = runReaderT a globalSpiderTimelineEnv

2395

2570

2396−#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

2397-- | Run an action affecting a given Spider timeline; this will be guarded by a

2571-- | Run an action affecting a given Spider timeline; this will be guarded by a

2398-- mutex for that timeline

2572-- mutex for that timeline

2399runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a

2573runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a

2400runSpiderHostForTimeline (SpiderHost a) = runReaderT a

2574runSpiderHostForTimeline (SpiderHost a) = runReaderT a

2401−#endif

2402

2575

2403newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2576newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2404

2577

src/Reflex/Spider/SpiderTimeline.include.hsdeleted−155

@@ -1,155 +0,0 @@

1−-- | Designates the default, global Spider timeline

2−data SpiderTimeline x

3−type role SpiderTimeline nominal

4−

5−-- | The default, global Spider environment

6−type Spider = SpiderTimeline Global

7−

8−instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (EventM x) where

9− {-# INLINABLE sample #-}

10− sample (SpiderBehavior b) = readBehaviorUntracked b

11−

12−instance 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

24−

25−instance (

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

32−

33−instance (

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

42−

43−instance 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

55−

56−instance 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'"

65−

66−{-# INLINABLE newJoinDyn #-}

67−newJoinDyn :: HasSpiderTimeline x => Reflex.Spider.Internal.Dynamic x (Identity (Reflex.Spider.Internal.Dynamic x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)

68−newJoinDyn 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'

75−

76−instance 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

79−

80−instance 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

88−

89−holdSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Behavior (SpiderTimeline x) a)

90−holdSpiderEventM v0 e = fmap (SpiderBehavior . behaviorHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e

91−

92−holdDynSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)

93−holdDynSpiderEventM v0 e = fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e

94−

95−holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)

96−holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

97−

98−buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPullM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)

99−buildDynamicSpiderEventM getV0 e = fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e

100−

101−instance 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

112−

113−instance 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

115−

116−instance 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

128−

129−instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where

130− {-# INLINABLE sample #-}

131− sample = runFrame . readBehaviorUntracked . unSpiderBehavior

132−

133−instance 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

136−

137−instance 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

148−

149−--------------------------------------------------------------------------------

150−-- Deprecated items

151−--------------------------------------------------------------------------------

152−

153−-- | 'SpiderEnv' is the old name for 'SpiderTimeline'

154−{-# DEPRECATED SpiderEnv "Use 'SpiderTimelineEnv' instead" #-}

155−type SpiderEnv = SpiderTimeline

src/Reflex/Spider/SpiderTimelineHost.include.hsdeleted−57

@@ -1,57 +0,0 @@

1−instance 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− }

17−

18−instance 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

22−

23−instance 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

29−

30−instance (

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

39−

40−instance (

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

49−

50−instance HasSpiderTimeline x => Reflex.Host.Class.MonadSubscribeEvent (SpiderTimeline x) (SpiderHost x) where

51− {-# INLINABLE subscribeEvent #-}

52− subscribeEvent = runFrame . runSpiderHostFrame . Reflex.Host.Class.subscribeEvent

53−

54−instance 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