Add buildIncremental

reflex-frp · Aug 19, 2018 · b6e7830 · b6e7830
1 parent ae6b599
commit b6e7830
Show file tree

Hide file tree

Showing 5 changed files with 37 additions and 3 deletions.
diff --git a/src/Reflex/Class.hs b/src/Reflex/Class.hs
@@ -339,11 +339,18 @@ class MonadSample t m => MonadHold t m where
   holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
   default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)
   holdIncremental v0 = lift . holdIncremental v0
+
+  buildIncremental :: Patch p => PushM t (PatchTarget p) -> Event t p -> m (Incremental t p)
+  default buildIncremental :: (m ~ f m', MonadTrans f, MonadHold t m', Patch p) => PushM t (PatchTarget p) -> Event t p -> m (Incremental t p)
+  buildIncremental getV0 = lift . buildIncremental getV0
+
+  -- | Create a 'Dynamic' from a 'PushM' (which allows sampling from Behaviors
+  -- and holding 'Events') and an 'Event'
   buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)
-  {-
-  default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)
+
+  default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PushM t a -> Event t a -> m (Dynamic t a)
   buildDynamic getV0 = lift . buildDynamic getV0
-  -}
+
   -- | Create a new 'Event' that only occurs only once, on the first occurrence of
   -- the supplied 'Event'.
   headE :: Event t a -> m (Event t a)

diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
@@ -162,6 +162,8 @@ instance (ReflexHost t, MonadHold t m) => MonadHold t (PerformEventT t m) where
   holdIncremental v0 v' = lift $ holdIncremental v0 v'
   {-# INLINABLE buildDynamic #-}
   buildDynamic getV0 v' = lift $ buildDynamic getV0 v'
+  {-# INLINABLE buildIncremental #-}
+  buildIncremental getV0 v' = lift $ buildIncremental getV0 v'
   {-# INLINABLE headE #-}
   headE = lift . headE
 

diff --git a/src/Reflex/Profiled.hs b/src/Reflex/Profiled.hs
@@ -157,6 +157,7 @@ instance MonadHold t m => MonadHold (ProfiledTimeline t) (ProfiledM m) where
   holdDyn v0 (Event_Profiled v') = ProfiledM $ Dynamic_Profiled <$> holdDyn v0 v'
   holdIncremental v0 (Event_Profiled v') = ProfiledM $ Incremental_Profiled <$> holdIncremental v0 v'
   buildDynamic (ProfiledM v0) (Event_Profiled v') = ProfiledM $ Dynamic_Profiled <$> buildDynamic v0 v'
+  buildIncremental (ProfiledM v0) (Event_Profiled v') = ProfiledM $ Incremental_Profiled <$> buildIncremental v0 v'
   headE (Event_Profiled e) = ProfiledM $ Event_Profiled <$> headE e
 
 instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where

diff --git a/src/Reflex/Pure.hs b/src/Reflex/Pure.hs
@@ -204,3 +204,6 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where
                    Just x -> fromMaybe lastValue $ apply x lastValue
 
   headE = slowHeadE
+
+  buildIncremental :: Patch p => (t -> PatchTarget p) -> Event (Pure t) p -> t -> Incremental (Pure t) p
+  buildIncremental initialValue e initialTime = holdIncremental (initialValue initialTime) e initialTime
diff --git a/src/Reflex/Spider/Internal.hs b/src/Reflex/Spider/Internal.hs
@@ -1167,6 +1167,8 @@ buildDynamic readV0 v' = do
   defer $ SomeDynInit d
   return d
 
+
+
 unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
 unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x
   where x = (readV0, v')
@@ -2261,6 +2263,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Event
   holdIncremental = holdIncrementalSpiderEventM
   {-# INLINABLE buildDynamic #-}
   buildDynamic = buildDynamicSpiderEventM
+  {-# INLINABLE buildIncremental #-}
+  buildIncremental = buildIncrementalSpiderEventM
   {-# INLINABLE headE #-}
   headE = R.slowHeadE
 --  headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e
@@ -2282,6 +2286,10 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
   holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> Reflex.Spider.Internal.hold v0 e
   {-# INLINABLE buildDynamic #-}
   buildDynamic getV0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce e
+
+  {-# INLINABLE buildIncremental #-}
+  buildIncremental getV0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderIncremental . dynamicDyn) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) (coerce e)
+
   {-# INLINABLE headE #-}
   headE = R.slowHeadE
 --  headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e
@@ -2331,6 +2339,10 @@ holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Refl
 buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPushM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)
 buildDynamicSpiderEventM getV0 e = fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e
 
+buildIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => SpiderPushM x (PatchTarget p) -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)
+buildIncrementalSpiderEventM getV0 e = fmap (SpiderIncremental . dynamicDyn) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e
+
+
 instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where
   {-# INLINABLE hold #-}
   hold v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.hold v0 e
@@ -2340,6 +2352,10 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
   holdIncremental v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdIncremental v0 e
   {-# INLINABLE buildDynamic #-}
   buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e
+
+  {-# INLINABLE buildIncremental #-}
+  buildIncremental getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildIncremental getV0 e
+
   {-# INLINABLE headE #-}
   headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e
 
@@ -2355,6 +2371,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
   holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e
   {-# INLINABLE buildDynamic #-}
   buildDynamic getV0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e
+  {-# INLINABLE buildIncremental #-}
+  buildIncremental getV0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicDyn) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e
   {-# INLINABLE headE #-}
   headE = R.slowHeadE
 --  headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e
@@ -2376,6 +2394,9 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Refle
   holdIncremental v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdIncremental v0 e
   {-# INLINABLE buildDynamic #-}
   buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e
+  {-# INLINABLE buildIncremental #-}
+  buildIncremental getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildIncremental getV0 e
+
   {-# INLINABLE headE #-}
   headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e