aab2ec1 · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Add @ElvishJerricco's solution to the reflection-based spider timeline management stuff. Relevant to #76.

aab2ec1Ryan Trinkle10 years ago

src/Reflex/Spider.hs+2

compare with develop

unifiedsplit

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

7 , Global

8 , SpiderHost

9 , runSpiderHost

10+#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

10 , runSpiderHostForTimeline

11 , runSpiderHostForTimeline

11 , newSpiderTimeline

12 , newSpiderTimeline

12 , withSpiderTimeline

13 , withSpiderTimeline

14+#endif

13 -- * Deprecated

15 -- * Deprecated

14 , SpiderEnv

16 , SpiderEnv

15 ) where

17 ) where

src/Reflex/Spider/Internal.hs+23−4

@@ -53,8 +53,6 @@ import Data.List hiding (foldl')

53import Data.Maybe

54import Data.Monoid ((<>))

55import Data.Proxy

56−import Data.Some (Some)

57−import qualified Data.Some as Some

58import Data.These

56import Data.These

59import Data.Traversable

57import Data.Traversable

60import Data.Word

58import Data.Word

@@ -77,6 +75,9 @@ import Data.Tree (Forest, Tree (..), drawForest)

77import Data.WeakBag (WeakBag, WeakBagTicket)

75import Data.WeakBag (WeakBag, WeakBagTicket)

78import qualified Data.WeakBag as WeakBag

76import qualified Data.WeakBag as WeakBag

79#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

77#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

78+import Data.Reflection

79+import Data.Some (Some)

80+import qualified Data.Some as Some

80import Data.Type.Coercion

81import Data.Type.Coercion

81import qualified Reflex.Class

82import qualified Reflex.Class

82import qualified Reflex.Class as R

83import qualified Reflex.Class as R

@@ -1870,13 +1871,29 @@ unsafeNewSpiderTimelineEnv = do

1870#endif

1871#endif

1871 }

1872 }

1872

1873

1874+#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

1873-- | Create a new SpiderTimelineEnv

1875-- | Create a new SpiderTimelineEnv

1874newSpiderTimeline :: IO (Some SpiderTimelineEnv)

1876newSpiderTimeline :: IO (Some SpiderTimelineEnv)

1875newSpiderTimeline = withSpiderTimeline (pure . Some.This)

1877newSpiderTimeline = withSpiderTimeline (pure . Some.This)

1876

1878

1879+data LocalSpiderTimeline x s

1880+

1881+instance Reifies s (SpiderTimelineEnv x) =>

1882+ HasSpiderTimeline (LocalSpiderTimeline x s) where

1883+ spiderTimeline = localSpiderTimeline (Proxy :: Proxy s) $ reflect (Proxy :: Proxy s)

1884+

1885+localSpiderTimeline

1886+ :: Proxy s

1887+ -> SpiderTimelineEnv x

1888+ -> SpiderTimelineEnv (LocalSpiderTimeline x s)

1889+localSpiderTimeline _ = unsafeCoerce

1890+

1877-- | Pass a new timeline to the given function.

1891-- | Pass a new timeline to the given function.

1878−withSpiderTimeline :: (forall x. SpiderTimelineEnv x -> IO r) -> IO r

1892+withSpiderTimeline :: (forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r) -> IO r

1893+withSpiderTimeline k = do

1879−withSpiderTimeline k = unsafeNewSpiderTimelineEnv >>= k

1894+ env <- unsafeNewSpiderTimelineEnv

1895+ reify env $ \s -> k $ localSpiderTimeline s env

1896+#endif

1880

1897

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

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

1882

1899

@@ -1968,10 +1985,12 @@ instance Monad (SpiderHost x) where

1968runSpiderHost :: SpiderHost Global a -> IO a

1985runSpiderHost :: SpiderHost Global a -> IO a

1969runSpiderHost (SpiderHost a) = runReaderT a globalSpiderTimelineEnv

1986runSpiderHost (SpiderHost a) = runReaderT a globalSpiderTimelineEnv

1970

1987

1988+#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

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

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

1972-- mutex for that timeline

1990-- mutex for that timeline

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

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

1974runSpiderHostForTimeline (SpiderHost a) = runReaderT a

1992runSpiderHostForTimeline (SpiderHost a) = runReaderT a

1993+#endif

1975

1994

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

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

1977

1996