Fix render on state get with unsafeRefEq (#401)

bower.json

@@ -41,6 +41,7 @@
     "purescript-parallel": "^2.1.0",
     "purescript-profunctor-lenses": "^2.6.0",
     "purescript-profunctor": "^2.0.0",
-    "purescript-unsafe-coerce": "^2.0.0"
+    "purescript-unsafe-coerce": "^2.0.0",
+    "purescript-unsafe-reference": "^1.0.0"
   }
 }

src/Halogen/Aff/Driver/Eval.purs

@@ -34,6 +34,8 @@ import Halogen.Query.ForkF as FF
 import Halogen.Query.HalogenM (HalogenM(..), HalogenF(..), HalogenAp(..))
 import Halogen.Query.InputF (InputF(..), RefLabel(..))
 
+import Unsafe.Reference (unsafeRefEq)
+
 parSequenceAff_
   :: forall eff a
    . L.List (Aff (avar :: AV.AVAR, ref :: REF | eff) a)
@@ -99,16 +101,15 @@ eval render r =
     -> HalogenF s' z' g' p' o' (Aff (HalogenEffects eff))
     ~> Aff (HalogenEffects eff)
   go ref = case _ of
-    GetState k -> do
-      DriverState { state } <- liftEff (readRef ref)
-      pure (k state)
-    ModifyState f -> do
+    State f -> do
       DriverState (st@{ state, lifecycleHandlers }) <- liftEff (readRef ref)
       case f state of
-        Tuple a state' -> do
-          liftEff $ writeRef ref (DriverState (st { state = state' }))
-          handleLifecycle lifecycleHandlers (render lifecycleHandlers ref)
-          pure a
+        Tuple a state'
+          | unsafeRefEq state state' -> pure a
+          | otherwise -> do
+              liftEff $ writeRef ref (DriverState (st { state = state' }))
+              handleLifecycle lifecycleHandlers (render lifecycleHandlers ref)
+              pure a
     Subscribe es next -> do
       DriverState ({ subscriptions, fresh }) <- liftEff (readRef ref)
       forkAff do

src/Halogen/Query/HalogenM.purs

@@ -29,8 +29,7 @@ import Halogen.Query.InputF (RefLabel)
 
 -- | The Halogen component algebra
 data HalogenF s (f :: * -> *) g p o m a
-  = GetState (s -> a)
-  | ModifyState (s -> Tuple a s)
+  = State (s -> Tuple a s)
   | Subscribe (ES.EventSource f m) a
   | Lift (m a)
   | Halt String
@@ -44,8 +43,7 @@ data HalogenF s (f :: * -> *) g p o m a
 
 instance functorHalogenF :: Functor m => Functor (HalogenF s f g p o m) where
   map f = case _ of
-    GetState k -> GetState (f <<< k)
-    ModifyState k -> ModifyState (lmap f <<< k)
+    State k -> State (lmap f <<< k)
     Subscribe es a -> Subscribe es (f a)
     Lift q -> Lift (map f q)
     Halt msg -> Halt msg
@@ -103,7 +101,7 @@ instance monadRecHalogenM :: MonadRec (HalogenM s f g p o m) where
     go (Done y) = pure y
 
 instance monadStateHalogenM :: MonadState s (HalogenM s f g p o m) where
-  state = HalogenM <<< liftF <<< ModifyState
+  state = HalogenM <<< liftF <<< State
 
 instance monadAskHalogenM :: MonadAsk r m => MonadAsk r (HalogenM s f g p o m) where
   ask = HalogenM $ liftF $ Lift $ ask
@@ -150,8 +148,7 @@ hoist nat (HalogenM fa) = HalogenM (hoistFree go fa)
   where
   go :: HalogenF s f g p o m ~> HalogenF s f g p o m'
   go = case _ of
-    GetState k -> GetState k
-    ModifyState f -> ModifyState f
+    State f -> State f
     Subscribe es next -> Subscribe (ES.hoist nat es) next
     Lift q -> Lift (nat q)
     Halt msg -> Halt msg