diff --git a/CHANGELOG.md b/CHANGELOG.md index a0ed8fc..d42c040 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/src/Elmish/Component.js b/src/Elmish/Component.js index 7c70aee..4db28c7 100644 --- a/src/Elmish/Component.js +++ b/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) { diff --git a/src/Elmish/Component.purs b/src/Elmish/Component.purs index 9faa12b..8d4016a 100644 --- a/src/Elmish/Component.purs +++ b/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) diff --git a/test/LocalState.purs b/test/LocalState.purs index 31cc7b7..c2af417 100644 --- a/test/LocalState.purs +++ b/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 + ] + }