Deprecate buildDynamic, introduce liftPushM

Author: parenthetical

src/Reflex/Class.hs

@@ -156,6 +156,7 @@ module Reflex.Class
     -- * Deprecated functions
   , switchPromptly
   , switchPromptOnly
+  , buildDynamic
   -- * "Cheap" functions
   , fmapMaybeCheap
   , mapMaybeCheap
@@ -388,6 +389,11 @@ instance (Reflex t, Default a) => Default (Dynamic t a) where
 class (Applicative m, Monad m) => MonadSample t m | m -> t where
   -- | Get the current value in the 'Behavior'
   sample :: Behavior t a -> m a
+  {-# INLINABLE sample #-}
+  default sample :: (m ~ f m', MonadTrans f, MonadSample t m') => Behavior t a -> m a
+  sample = lift . sample
+
+{-# DEPRECATED buildDynamic "Sample directly and use 'liftPusmM'" #-}
 
 -- | 'MonadHold' designates monads that can create new 'Behavior's based on
 -- 'Event's; usually this will be 'PushM' or a monad based on it.  'MonadHold'
@@ -400,33 +406,50 @@ class MonadSample t m => MonadHold t m where
   -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new
   -- one.
   hold :: a -> Event t a -> m (Behavior t a)
+  {-# INLINABLE hold #-}
   default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)
   hold v0 = lift . hold v0
   -- | Create a 'Dynamic' value using the given initial value that changes every
   -- time the 'Event' occurs.
   holdDyn :: a -> Event t a -> m (Dynamic t a)
+  {-# INLINABLE holdDyn #-}
   default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)
   holdDyn v0 = lift . holdDyn v0
   -- | Create an 'Incremental' value using the given initial value that changes
   -- every time the 'Event' occurs.
   holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)
+  {-# INLINABLE holdIncremental #-}
   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
+  -- | DEPRECATED. This function allowed for extra laziness when sampling
+  -- behaviors, but is no longer needed. When implementing MonadHold use the new
+  -- 'liftPushM' instead.
   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)
-  buildDynamic getV0 = lift . buildDynamic getV0
-  -}
+  buildDynamic initialValue e = do
+    iv <- liftPushM initialValue
+    holdDyn iv e
   -- | 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)
+  {-# INLINABLE headE #-}
+  default headE :: (m ~ f m', MonadTrans f, MonadHold t m') => Event t a -> m (Event t a)
+  headE = lift . headE
   -- | An event which only occurs at the current moment in time, such that:
   --
   -- > coincidence (pushAlways (\a -> (a <$) <$> now) e) = e
   --
   now :: m (Event t ())
+  {-# INLINABLE now #-}
   default now :: (m ~ f m', MonadTrans f, MonadHold t m') => m (Event t ())
   now = lift now
+  {-# INLINABLE liftPushM #-}
+  liftPushM :: PushM t a -> m a
+  {- -- When buildDynamic has been removed this can be the new default:
+  default liftPushM :: (m ~ f m', MonadTrans f, MonadHold t m') => PushM t a -> m a
+  liftPushM = lift . liftPushM
+  -}
+  default liftPushM :: (Reflex t) => PushM t a -> m a
+  liftPushM m = sample . current =<< buildDynamic m never
 
 -- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',
 -- using the combining function to produce a patch.
@@ -570,9 +593,9 @@ instance MonadHold t m => MonadHold t (ReaderT r m) where
   hold a0 = lift . hold a0
   holdDyn a0 = lift . holdDyn a0
   holdIncremental a0 = lift . holdIncremental a0
-  buildDynamic a0 = lift . buildDynamic a0
   headE = lift . headE
   now = lift now
+  liftPushM = lift . liftPushM
 
 instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
   sample = lift . sample
@@ -581,9 +604,9 @@ instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
   hold a0 = lift . hold a0
   holdDyn a0 = lift . holdDyn a0
   holdIncremental a0 = lift . holdIncremental a0
-  buildDynamic a0 = lift . buildDynamic a0
   headE = lift . headE
   now = lift now
+  liftPushM = lift . liftPushM
 
 instance MonadSample t m => MonadSample t (StateT s m) where
   sample = lift . sample
@@ -592,9 +615,9 @@ instance MonadHold t m => MonadHold t (StateT s m) where
   hold a0 = lift . hold a0
   holdDyn a0 = lift . holdDyn a0
   holdIncremental a0 = lift . holdIncremental a0
-  buildDynamic a0 = lift . buildDynamic a0
   headE = lift . headE
   now = lift now
+  liftPushM = lift . liftPushM
 
 instance MonadSample t m => MonadSample t (ExceptT e m) where
   sample = lift . sample
@@ -603,9 +626,9 @@ instance MonadHold t m => MonadHold t (ExceptT e m) where
   hold a0 = lift . hold a0
   holdDyn a0 = lift . holdDyn a0
   holdIncremental a0 = lift . holdIncremental a0
-  buildDynamic a0 = lift . buildDynamic a0
   headE = lift . headE
   now = lift now
+  liftPushM = lift . liftPushM
 
 instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
   sample = lift . sample
@@ -614,9 +637,9 @@ instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
   hold a0 = lift . hold a0
   holdDyn a0 = lift . holdDyn a0
   holdIncremental a0 = lift . holdIncremental a0
-  buildDynamic a0 = lift . buildDynamic a0
   headE = lift . headE
   now = lift now
+  liftPushM = lift . liftPushM
 
 instance MonadSample t m => MonadSample t (ContT r m) where
   sample = lift . sample
@@ -625,9 +648,9 @@ instance MonadHold t m => MonadHold t (ContT r m) where
   hold a0 = lift . hold a0
   holdDyn a0 = lift . holdDyn a0
   holdIncremental a0 = lift . holdIncremental a0
-  buildDynamic a0 = lift . buildDynamic a0
   headE = lift . headE
   now = lift now
+  liftPushM = lift . liftPushM
 
 --------------------------------------------------------------------------------
 -- Convenience functions

src/Reflex/EventWriter/Base.hs

@@ -141,12 +141,12 @@ instance MonadHold t m => MonadHold t (EventWriterT t w m) where
   holdDyn v0 = lift . holdDyn v0
   {-# INLINABLE holdIncremental #-}
   holdIncremental v0 = lift . holdIncremental v0
-  {-# INLINABLE buildDynamic #-}
-  buildDynamic a0 = lift . buildDynamic a0
   {-# INLINABLE headE #-}
   headE = lift . headE
   {-# INLINABLE now #-}
   now = lift now
+  {-# INLINABLE liftPushM #-}
+  liftPushM = lift . liftPushM
 
 instance (Reflex t, Adjustable t m, MonadHold t m, Semigroup w) => Adjustable t (EventWriterT t w m) where
   runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'

src/Reflex/PerformEvent/Base.hs

@@ -164,12 +164,12 @@ instance (ReflexHost t, MonadHold t m) => MonadHold t (PerformEventT t m) where
   holdDyn v0 v' = PerformEventT $ lift $ holdDyn v0 v'
   {-# INLINABLE holdIncremental #-}
   holdIncremental v0 v' = PerformEventT $ lift $ holdIncremental v0 v'
-  {-# INLINABLE buildDynamic #-}
-  buildDynamic getV0 v' = PerformEventT $ lift $ buildDynamic getV0 v'
   {-# INLINABLE headE #-}
   headE = PerformEventT . lift . headE
   {-# INLINABLE now #-}
   now = PerformEventT . lift $ now
+  {-# INLINABLE liftPushM #-}
+  liftPushM = PerformEventT . lift . liftPushM
 
 instance (MonadRef (HostFrame t), ReflexHost t) => MonadRef (PerformEventT t m) where
   type Ref (PerformEventT t m) = Ref (HostFrame t)

src/Reflex/PostBuild/Base.hs

@@ -94,12 +94,12 @@ instance MonadHold t m => MonadHold t (PostBuildT t m) where
   holdDyn v0 = lift . holdDyn v0
   {-# INLINABLE holdIncremental #-}
   holdIncremental v0 = lift . holdIncremental v0
-  {-# INLINABLE buildDynamic #-}
-  buildDynamic a0 = lift . buildDynamic a0
   {-# INLINABLE headE #-}
   headE = lift . headE
   {-# INLINABLE now #-}
   now = lift now
+  {-# INLINABLE liftPushM #-}
+  liftPushM = lift . liftPushM
 
 instance PerformEvent t m => PerformEvent t (PostBuildT t m) where
   type Performable (PostBuildT t m) = Performable m

src/Reflex/Profiled.hs

@@ -188,9 +188,9 @@ instance MonadHold t m => MonadHold (ProfiledTimeline t) (ProfiledM m) where
   hold v0 (Event_Profiled v') = ProfiledM $ Behavior_Profiled <$> hold v0 v'
   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'
   headE (Event_Profiled e) = ProfiledM $ Event_Profiled <$> headE e
   now = ProfiledM $ Event_Profiled <$> now
+  liftPushM (ProfiledM m) = ProfiledM . liftPushM $ m
 
 instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where
   sample (Behavior_Profiled b) = ProfiledM $ sample b

src/Reflex/Pure.hs

@@ -190,11 +190,6 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where
     b <- hold v0 e
     pure $ unsafeDynamic b e
 
-  buildDynamic :: (t -> a) -> Event (Pure t) a -> t -> Dynamic (Pure t) a
-  buildDynamic initialValue e = do
-    iv <- initialValue
-    holdDyn iv e
-
   holdIncremental :: Patch p => PatchTarget p -> Event (Pure t) p -> t -> Incremental (Pure t) p
   holdIncremental initialValue e initialTime = Incremental $ \t -> (f t, unEvent e t)
     where f = memo $ \sampleTime ->
@@ -211,3 +206,4 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where
 
   headE = slowHeadE
   now t = Event $ guard . (t ==)
+  liftPushM = id

src/Reflex/Spider/Internal.hs

@@ -2514,15 +2514,13 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Event
   holdDyn = holdDynSpiderEventM
   {-# INLINABLE holdIncremental #-}
   holdIncremental = holdIncrementalSpiderEventM
-  {-# INLINABLE buildDynamic #-}
-  buildDynamic (SpiderPushM getV0) e = do
-    v0 <- getV0
-    R.holdDyn v0 e
   {-# INLINABLE headE #-}
   headE = R.slowHeadE
 --  headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e
   {-# INLINABLE now #-}
   now = nowSpiderEventM
+  {-# INLINABLE liftPushM #-}
+  liftPushM (SpiderPushM m) = m
 
 instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where
   {-# INLINABLE sample #-}
@@ -2539,13 +2537,13 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
   holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce e
   {-# INLINABLE holdIncremental #-}
   holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> Reflex.Spider.Internal.hold v0 e
-  {-# INLINABLE buildDynamic #-}
-  buildDynamic getV0 e = SpiderPushM $ Reflex.Class.buildDynamic getV0 e
   {-# INLINABLE headE #-}
   headE = R.slowHeadE
 --  headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e
   {-# INLINABLE now #-}
   now = SpiderPushM nowSpiderEventM
+  {-# INLINABLE liftPushM #-}
+  liftPushM = id
 
 
 instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where
@@ -2597,12 +2595,12 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
   holdDyn v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdDyn v0 e
   {-# INLINABLE holdIncremental #-}
   holdIncremental v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdIncremental v0 e
-  {-# INLINABLE buildDynamic #-}
-  buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e
   {-# INLINABLE headE #-}
   headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e
   {-# INLINABLE now #-}
   now = runFrame . runSpiderHostFrame $ Reflex.Class.now
+  {-# INLINABLE liftPushM #-}
+  liftPushM = runFrame . runSpiderHostFrame . Reflex.Class.liftPushM
 
 
 instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where
@@ -2615,13 +2613,13 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
   holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e
   {-# INLINABLE holdIncremental #-}
   holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e
-  {-# INLINABLE buildDynamic #-}
-  buildDynamic getV0 e = SpiderHostFrame $ Reflex.Class.buildDynamic getV0 e
   {-# INLINABLE headE #-}
   headE = R.slowHeadE
 --  headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e
   {-# INLINABLE now #-}
   now = SpiderHostFrame Reflex.Class.now
+  {-# INLINABLE liftPushM #-}
+  liftPushM = SpiderHostFrame . Reflex.Class.liftPushM
 
 instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where
   {-# INLINABLE sample #-}
@@ -2638,12 +2636,12 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Refle
   holdDyn v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdDyn v0 e
   {-# INLINABLE holdIncremental #-}
   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 headE #-}
   headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e
   {-# INLINABLE now #-}
   now = Reflex.Spider.Internal.ReadPhase Reflex.Class.now
+  {-# INLINABLE liftPushM #-}
+  liftPushM = Reflex.Spider.Internal.ReadPhase . Reflex.Class.liftPushM
 
 --------------------------------------------------------------------------------
 -- Deprecated items

src/Reflex/TriggerEvent/Base.hs

@@ -127,12 +127,12 @@ instance MonadHold t m => MonadHold t (TriggerEventT t m) where
   holdDyn v0 v' = lift $ holdDyn v0 v'
   {-# INLINABLE holdIncremental #-}
   holdIncremental v0 v' = lift $ holdIncremental v0 v'
-  {-# INLINABLE buildDynamic #-}
-  buildDynamic a0 = lift . buildDynamic a0
   {-# INLINABLE headE #-}
   headE = lift . headE
   {-# INLINABLE now #-}
   now = lift now
+  {-# INLINABLE liftPushM #-}
+  liftPushM = lift . liftPushM
 
 instance Adjustable t m => Adjustable t (TriggerEventT t m) where
   {-# INLINABLE runWithReplace #-}

test/Reflex/Plan/Pure.hs

@@ -39,9 +39,9 @@ instance MonadHold (Pure Int) PurePlan where
   hold initial  = liftPlan . hold initial
   holdDyn initial = liftPlan . holdDyn initial
   holdIncremental initial = liftPlan . holdIncremental initial
-  buildDynamic getInitial = liftPlan . buildDynamic getInitial
   headE = liftPlan . headE
   now = liftPlan now
+  liftPushM = liftPlan . liftPushM
 
 instance MonadSample (Pure Int) PurePlan where
   sample = liftPlan . sample