Avoid capturing ComponentDef in a closure for a long time (#83)

CHANGELOG.md

@@ -5,6 +5,16 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## 0.12.0
+
+### Changed
+
+- Fixed a bug that allowed `ComponentDef` to be captured in closures for a long
+  time, which could lead to using stale values in complex scenarios where
+  `ComponentDef` is not constant, but depends on arguments. See [#83](https://github.com/collegevine/purescript-elmish/pull/83).
+
+- **Breaking**: Changed the order of arguments of `bindComponent`
+
 ## 0.11.4
 
 ### Added

src/Elmish/Component.js

@@ -15,6 +15,8 @@ export function withFreshComponent(f) {
 
 export var instantiateBaseComponent = React.createElement;
 
+export const instancePropDef = component => () => component.props.def
+
 function mkFreshComponent(name) {
   class ElmishComponent extends React.Component {
     constructor(props) {

src/Elmish/Component.purs

@@ -255,31 +255,38 @@ withTrace def = def { update = tracingUpdate, view = tracingView }
 -- | "renders" it as a React DOM element, suitable for passing to
 -- | `ReactDOM.render` or embedding in a JSX DOM tree.
 bindComponent :: ∀ msg state
-     . BaseComponent                 -- ^ A JS class inheriting from React.Component to serve as base
-    -> ComponentDef msg state        -- ^ The component definition
+     . BaseComponent state msg       -- ^ A JS class inheriting from React.Component to serve as base
     -> StateStrategy state           -- ^ Strategy of storing state
+    -> ComponentDef msg state        -- ^ The component definition
     -> ReactElement
-bindComponent cmpt def stateStrategy =
+bindComponent cmpt stateStrategy = \def -> -- Explicit lambda to make sure `def` isn't captured by closures under `where`
     runFn2 instantiateBaseComponent cmpt
-      { init: initialize
+      { def
+      , init: let (Transition s _) = def.init in (stateStrategy { initialState: s }).initialize
       , render
-      , componentDidMount: runCmds initialCmds
+      , componentDidMount: let (Transition _ cmds) = def.init in runCmds cmds
       , componentWillUnmount: setUnmounted true <> stopSubscriptions
       }
     where
-        Transition initialState initialCmds = def.init
+        getState component = do
+          Transition s _ <- instancePropDef component <#> _.init
+          (stateStrategy { initialState: s }).getState component
 
-        { initialize, getState, setState } = stateStrategy { initialState }
+        setState component newState callback = do
+          Transition s _ <- instancePropDef component <#> _.init
+          (stateStrategy { initialState: s }).setState component newState callback
 
         render :: ReactComponentInstance -> Effect ReactElement
         render component = do
           state <- getState component
-          pure $ def.view state $ dispatchMsg component
+          view <- instancePropDef component <#> _.view
+          pure $ view state $ dispatchMsg component
 
         dispatchMsg :: ReactComponentInstance -> Dispatch msg
         dispatchMsg component msg = unlessM (getUnmounted component) do
           oldState <- getState component
-          let Transition newState cmds = def.update oldState msg
+          update <- instancePropDef component <#> _.update
+          let Transition newState cmds = update oldState msg
           setState component newState $ runCmds cmds component
 
         runCmds :: Array (Command Aff msg) -> ReactComponentInstance -> Effect Unit
@@ -320,7 +327,7 @@ construct :: ∀ msg state
 construct def = do
     stateStorage <- liftEffect dedicatedStorage
     pure $ withFreshComponent \cmpt ->
-        bindComponent cmpt def stateStorage
+        bindComponent cmpt stateStorage def
 
 -- | Monad transformation applied to `ComponentDef'`
 nat :: ∀ m n msg state. (m ~> n) -> ComponentDef' m msg state -> ComponentDef' n msg state
@@ -362,8 +369,8 @@ wrapWithLocalState :: ∀ msg state args
     -> args
     -> ReactElement
 wrapWithLocalState name mkDef =
-    runFn2 withCachedComponent name \cmpt args ->
-        bindComponent cmpt (mkDef args) localState
+    runFn2 withCachedComponent name \cmpt ->
+        bindComponent cmpt localState <<< mkDef
 
 -- | A unique name for a component created via `wrapWithLocalState`. These names
 -- | don't technically need to be _completely_ unique, but they do need to be
@@ -397,14 +404,15 @@ newtype ComponentName = ComponentName String
 
 -- Props for the React component that is used as base for this framework. The
 -- component itself is defined in the foreign module.
-type BaseComponentProps =
-  { init :: ReactComponentInstance -> Effect Unit
+type BaseComponentProps state msg =
+  { def :: ComponentDef msg state
+  , init :: ReactComponentInstance -> Effect Unit
   , render :: ReactComponentInstance -> Effect ReactElement
   , componentDidMount :: ReactComponentInstance -> Effect Unit
   , componentWillUnmount :: ReactComponentInstance -> Effect Unit
   }
 
-type BaseComponent = ReactComponent BaseComponentProps
+type BaseComponent state msg = ReactComponent (BaseComponentProps state msg)
 
 -- This is just a call to `React.createElement`, but we can't use the
 -- general-purpose `createElement` function from `./React.purs`, because it
@@ -413,7 +421,7 @@ type BaseComponent = ReactComponent BaseComponentProps
 -- possible to make this type passable to JS by using `Foreign` and maybe even
 -- `unsafeCoerce` in places, but I have decided it wasn't worth it, because this
 -- is just one place at the core of the framework.
-foreign import instantiateBaseComponent :: Fn2 BaseComponent BaseComponentProps ReactElement
+foreign import instantiateBaseComponent :: ∀ state msg. Fn2 (BaseComponent state msg) (BaseComponentProps state msg) ReactElement
 
 -- | On first call with a given name, this function returns a fresh React class.
 -- | On subsequent calls with the same name, it returns the same class. It has
@@ -423,9 +431,12 @@ foreign import instantiateBaseComponent :: Fn2 BaseComponent BaseComponentProps
 -- This is essentially a hack, but not quite. It operates in the grey area
 -- between PureScript and JavaScript. See comments on `ComponentName` for a more
 -- detailed explanation.
-foreign import withCachedComponent :: ∀ a. Fn2 ComponentName (BaseComponent -> a) a
+foreign import withCachedComponent :: ∀ a state msg. Fn2 ComponentName (BaseComponent state msg -> a) a
 
 -- | Creates a fresh React component on every call. This is similar to
 -- | `withCachedComponent`, but without the cache - creates a new component
 -- | every time.
-foreign import withFreshComponent :: ∀ a. (BaseComponent -> a) -> a
+foreign import withFreshComponent :: ∀ a state msg. (BaseComponent state msg -> a) -> a
+
+-- Retrieves the `this.props.def` from the given component
+foreign import instancePropDef :: ∀ state msg. ReactComponentInstance -> Effect (ComponentDef msg state)

test/LocalState.purs

@@ -3,7 +3,9 @@ module Test.LocalState (spec) where
 import Prelude
 
 import Data.Array (length)
-import Elmish ((<|))
+import Effect.Aff (Milliseconds(..), delay)
+import Effect.Aff.Class (liftAff)
+import Elmish (fork, (<|))
 import Elmish.Component (ComponentName(..), wrapWithLocalState)
 import Elmish.HTML.Styled as H
 import Elmish.Test (clickOn, exists, find, findAll, forEach, nearestEnclosingReactComponentName, testComponent, text, (>>))
@@ -61,6 +63,35 @@ spec = describe "Elmish.Component.wrapWithLocalState" do
       findAll ".t--counter" <#> length >>= shouldEqual 2
       findAll ".t--counter" >>= forEach (nearestEnclosingReactComponentName >>= shouldEqual "Elmish_Counter")
 
+  it "calls the correct closure of `update` when dispatching events" $
+    testComponent closureOuter do
+      find ".t--count" >> text >>= shouldEqual "0"
+      find ".t--increment" >> text >>= shouldEqual "10"
+      clickOn ".t--inc"
+      find ".t--count" >> text >>= shouldEqual "10"
+      find ".t--increment" >> text >>= shouldEqual "10"
+      clickOn ".t--increase-increment"
+      find ".t--count" >> text >>= shouldEqual "10"
+      find ".t--increment" >> text >>= shouldEqual "11"
+      clickOn ".t--long-inc"
+      liftAff $ delay $ Milliseconds 20.0
+      find ".t--count" >> text >>= shouldEqual "21"
+      find ".t--increment" >> text >>= shouldEqual "11"
+
+      -- We're going to initiate a "long inc" and while it's in flight, we're
+      -- going to increase increment. If the closure that captured the previous
+      -- value of `increment` survives until after the long inc is done, the
+      -- resulting count will be incorrectly set at 21 + 11 = 32. If the old
+      -- value of `increment` wasn't captured and the fresh value is used, the
+      -- count will be 21 + 12 = 33.
+      clickOn ".t--long-inc"
+      liftAff $ delay $ Milliseconds 5.0
+      clickOn ".t--increase-increment"
+      find ".t--count" >> text >>= shouldEqual "21"
+      find ".t--increment" >> text >>= shouldEqual "12"
+      liftAff $ delay $ Milliseconds 15.0
+      find ".t--count" >> text >>= shouldEqual "33"
+
   where
     wrappedCounter =
       wrapWithLocalState (ComponentName "Counter") \c ->
@@ -89,3 +120,29 @@ spec = describe "Elmish.Component.wrapWithLocalState" do
           "IncInitialCount" -> pure state { initialCount = state.initialCount + 1 }
           _ -> pure state
 
+    closureOuter =
+      { init: pure { increment: 10 }
+      , update: \state -> case _ of
+          "IncreaseIncrement" -> pure state { increment = state.increment + 1 }
+          _ -> pure state
+      , view: \state dispatch ->
+          H.fragment
+          [ H.button_ "t--increase-increment" { onClick: dispatch <| "IncreaseIncrement" } "."
+          , H.p "t--increment" $ show state.increment
+          , closureInner state.increment
+          ]
+      }
+
+    closureInner = wrapWithLocalState (ComponentName "Inner") \increment ->
+      { init: pure { count: 0 }
+      , update: \state -> case _ of
+          "Inc" -> pure state { count = state.count + increment }
+          "LongInc" -> fork (delay (Milliseconds 10.0) $> "Inc") *> pure state
+          _ -> pure state
+      , view: \state dispatch ->
+          H.fragment
+          [ H.button_ "t--inc" { onClick: dispatch <| "Inc" } "."
+          , H.button_ "t--long-inc" { onClick: dispatch <| "LongInc" } "."
+          , H.p "t--count" $ show $ state.count
+          ]
+      }