foldDynM

src/Specular/FRP/Base.purs

@@ -26,7 +26,10 @@ module Specular.FRP.Base (
   , newDynamic
 
   , holdDyn
+  , class MonadFold
   , foldDyn
+  , InnerFRP
+  , foldDynM
   , foldDynMaybe
   , holdUniqDynBy
   , uniqDynBy
@@ -42,7 +45,7 @@ module Specular.FRP.Base (
 
   , class MonadFRP
 
-  , foldDynImpl
+  -- , foldDynImpl
   , foldDynMaybeImpl
 
   , traceEventIO
@@ -52,24 +55,27 @@ module Specular.FRP.Base (
 import Prelude
 
 import Control.Apply (lift2)
-import Control.Monad.Cleanup (class MonadCleanup, onCleanup)
-import Control.Monad.Reader (ask)
+import Control.Monad.Cleanup (class MonadCleanup, CleanupT, onCleanup, runCleanupT)
+import Control.Monad.Reader (ask, lift)
 import Control.Monad.Rec.Class (Step(..), tailRecM)
 import Data.Array (cons, unsnoc)
 import Data.Array as Array
 import Data.Foldable (for_)
 import Data.HeytingAlgebra (ff, implies, tt)
 import Data.Maybe (Maybe(..), isJust)
 import Data.Traversable (sequence, traverse)
+import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Class.Console as Console
 import Effect.Uncurried (EffectFn2, mkEffectFn2, runEffectFn2)
 import Effect.Unsafe (unsafePerformEffect)
 import Partial.Unsafe (unsafeCrashWith)
 import Specular.Internal.Effect (DelayedEffects, Ref, emptyDelayed, modifyRef, newRef, pushDelayed, readRef, sequenceEffects, unsafeFreezeDelayed, writeRef)
 import Specular.Internal.RIO (RIO, rio, runRIO)
 import Specular.Internal.RIO as RIO
 import Specular.Internal.UniqueMap.Mutable as UMM
+import Unsafe.Coerce (unsafeCoerce)
 
 -------------------------------------------------
 
@@ -473,37 +479,87 @@ instance applyDynamic :: Apply Dynamic where
 instance applicativeDynamic :: Applicative Dynamic where
   pure x = Dynamic { value: pure x, change: never }
 
--- | `foldDyn f x e` - Make a Dynamic that will have the initial value `x`,
--- | and every time `e` fires, its value will update by applying `f` to the
--- | event occurence value and the old value.
--- |
--- | On cleanup, the Dynamic will stop updating in response to the event.
-foldDyn :: forall m a b. MonadFRP m => (a -> b -> b) -> b -> Event a -> m (Dynamic b)
-foldDyn = foldDynImpl
+class Monad m <= MonadFold m where
+  -- | `foldDyn f x e` - Make a Dynamic that will have the initial value `x`,
+  -- | and every time `e` fires, its value will update by applying `f` to the
+  -- | event occurence value and the old value.
+  -- |
+  -- | On cleanup, the Dynamic will stop updating in response to the event.
+  foldDyn :: forall a b. (a -> b -> b) -> b -> Event a -> m (Dynamic b)
+
+instance innerFRPMonadFold :: MonadFold InnerFRP where
+  foldDyn f initial ev = MkInnerFRP $ foldDyn f initial ev
+else instance monadFoldEffectCleanup :: (MonadCleanup m, MonadEffect m) => MonadFold m where
+  foldDyn f initial (Event event) = do
+    ref <- liftEffect $ newRef initial
+    updateOrReadValue <- liftEffect $
+      oncePerFramePullWithIO (readBehavior event.occurence) $ \m_newValue -> do
+        oldValue <- readRef ref
+        case m_newValue of
+          Just occurence -> do
+            let newValue = f occurence oldValue
+            writeRef ref newValue
+            pure newValue
+          Nothing ->
+            pure oldValue
+
+    -- Since foldDyn can be called during a frame, 
+    -- make sure to pull at least once to make sure we get the first event, if any.
+    _ <- pull updateOrReadValue
+
+    unsub <- liftEffect $ event.subscribe $ void $ framePull $ updateOrReadValue
+    onCleanup unsub
+
+    pure $ Dynamic
+      { value: Behavior updateOrReadValue
+      , change: map (\_ -> unit) (Event event)
+      }
+
+newtype InnerFRP a = MkInnerFRP (CleanupT Effect a)
+
+derive newtype instance functorSimpleFold :: Functor InnerFRP
+derive newtype instance applySimpleFold :: Apply InnerFRP
+derive newtype instance applicativeSimpleFold :: Applicative InnerFRP
+derive newtype instance bindSimpleFold :: Bind InnerFRP
+derive newtype instance monadSimpleFold :: Monad InnerFRP
+
+
+-- | Like `foldDyn`, but the function returns an Effect action that can perform side-effects that will be run when events arrive
+foldDynM :: forall m a b. MonadFRP m => (a -> b -> InnerFRP b) -> b -> Event a -> m (Dynamic b)
+foldDynM f initial (Event event) = do
+  -- Reference to hold the current value of the output dynamic.
 
-foldDynImpl
-  :: forall m a b. MonadCleanup m => MonadEffect m
-  => (a -> b -> b) -> b -> Event a -> m (Dynamic b)
-foldDynImpl f initial (Event event) = do
   ref <- liftEffect $ newRef initial
-  updateOrReadValue <- liftEffect $
+
+  toCleanup <- liftEffect $ newRef []
+  onCleanup $ do
+    cl <- readRef toCleanup
+    for_ cl identity 
+
+  updateOrReadValue <- liftEffect $ do
     oncePerFramePullWithIO (readBehavior event.occurence) $ \m_newValue -> do
+      Console.log $ unsafeCoerce m_newValue
       oldValue <- readRef ref
       case m_newValue of
         Just occurence -> do
-          let newValue = f occurence oldValue
+          let (MkInnerFRP innerMonad) = f occurence oldValue
+          (Tuple newValue cleanup) <- runCleanupT innerMonad
+          modifyRef toCleanup (Array.cons cleanup)
           writeRef ref newValue
           pure newValue
         Nothing ->
           pure oldValue
 
+  -- Make sure we pull during the current frame
+  _ <- pull updateOrReadValue
+
   unsub <- liftEffect $ event.subscribe $ void $ framePull $ updateOrReadValue
   onCleanup unsub
 
   pure $ Dynamic
     { value: Behavior updateOrReadValue
     , change: map (\_ -> unit) (Event event)
-    }
+    } 
 
 -- | Construct a new root Dynamic that can be changed from `Effect`-land.
 newDynamic :: forall m a. MonadEffect m => a -> m { dynamic :: Dynamic a, read :: Effect a, set :: a -> Effect Unit }