From f73676044bf8086bf6098efea0675d3f4ea558b6 Mon Sep 17 00:00:00 2001
From: Joost ter Braak <j.terbraak@podo-it.nl>
Date: Mon, 26 Sep 2022 17:20:30 +0200
Subject: [PATCH 1/2] refactored mkInitialState out of evalHook

Halogen does not seem to guarantee the order of HalogenQ. It's possible
that Receive or Query arrive before Initialize fires. This means that the
HookState has to be ready before evalHook ever fires. mkInitialState
contains most of the old Initialize step code.
---
 src/Halogen/Hooks/Component.purs        |  24 +---
 src/Halogen/Hooks/Internal/Eval.purs    | 152 +++++++++++++++---------
 test/Test/Hooks/UseLifecycleEffect.purs |  11 +-
 test/Test/Hooks/UseMemo.purs            |  11 +-
 test/Test/Hooks/UseRef.purs             |  13 +-
 test/Test/Hooks/UseState.purs           |  10 +-
 test/Test/Hooks/UseTickEffect.purs      |  11 +-
 test/Test/Integration/Issue5.purs       |   7 +-
 test/Test/Integration/Issue73.purs      |  61 +++++-----
 test/Test/Setup/Eval.purs               |  38 +++---
 10 files changed, 174 insertions(+), 164 deletions(-)

diff --git a/src/Halogen/Hooks/Component.purs b/src/Halogen/Hooks/Component.purs
index ba54768..9ad7056 100644
--- a/src/Halogen/Hooks/Component.purs
+++ b/src/Halogen/Hooks/Component.purs
@@ -3,17 +3,15 @@ module Halogen.Hooks.Component where
 import Prelude
 
 import Control.Monad.Free (substFree)
-import Data.Maybe (Maybe(..))
 import Data.Newtype (over)
 import Effect.Ref as Ref
 import Effect.Unsafe (unsafePerformEffect)
 import Halogen as H
-import Halogen.HTML as HH
 import Halogen.Hooks.Hook (Hook, unsafeFromHook)
 import Halogen.Hooks.HookM (HookM)
 import Halogen.Hooks.Internal.Eval as Eval
 import Halogen.Hooks.Internal.Eval.Types (HookState(..), toHalogenM)
-import Halogen.Hooks.Types (ComponentRef, ComponentTokens, OutputToken, QueryToken, SlotToken)
+import Halogen.Hooks.Types (ComponentTokens, OutputToken, QueryToken, SlotToken)
 import Unsafe.Coerce (unsafeCoerce)
 
 -- | Produces a Halogen component from a `Hook` which returns `ComponentHTML`.
@@ -120,23 +118,7 @@ memoComponent eqInput inputHookFn = do
       pure a
 
   H.mkComponent
-    { initialState
+    { initialState : Eval.mkInitialState hookFn
     , render: \(HookState { result }) -> result
     , eval: toHalogenM slotToken outputToken <<< Eval.mkEval eqInput Eval.evalHookM evalHook
-    }
-  where
-  initialState input =
-    HookState
-      { result: HH.text ""
-      , stateRef: unsafePerformEffect $ Ref.new
-          { input
-          , componentRef: unsafeCoerce {} :: ComponentRef
-          , queryFn: Nothing
-          , stateCells: { queue: [], index: 0 }
-          , effectCells: { queue: [], index: 0 }
-          , memoCells: { queue: [], index: 0 }
-          , refCells: { queue: [], index: 0 }
-          , evalQueue: []
-          , stateDirty: false
-          }
-      }
+    }
\ No newline at end of file
diff --git a/src/Halogen/Hooks/Internal/Eval.purs b/src/Halogen/Hooks/Internal/Eval.purs
index 917b4bd..c4194e7 100644
--- a/src/Halogen/Hooks/Internal/Eval.purs
+++ b/src/Halogen/Hooks/Internal/Eval.purs
@@ -3,7 +3,7 @@ module Halogen.Hooks.Internal.Eval where
 import Prelude
 
 import Control.Applicative.Free (hoistFreeAp, liftFreeAp, retractFreeAp)
-import Control.Monad.Free (Free, liftF, substFree)
+import Control.Monad.Free (Free, liftF, runFreeM, substFree)
 import Data.Array as Array
 import Data.Bifunctor (bimap)
 import Data.Coyoneda (unCoyoneda)
@@ -12,19 +12,22 @@ import Data.Maybe (Maybe(..), fromJust, fromMaybe, maybe)
 import Data.Newtype (unwrap)
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
+import Effect (Effect)
 import Effect.Exception.Unsafe (unsafeThrow)
 import Effect.Ref (Ref)
 import Effect.Ref as Ref
 import Effect.Unsafe (unsafePerformEffect)
 import Foreign.Object as Object
 import Halogen as H
+import Halogen.Hooks.Hook (Hook, unsafeFromHook)
 import Halogen.Hooks.HookM (HookAp(..), HookF(..), HookM(..))
-import Halogen.Hooks.Internal.Eval.Types (HookState(..), InternalHookState, InterpretHookReason(..), HalogenM', fromQueryFn, toQueryFn)
+import Halogen.Hooks.Internal.Eval.Types (HalogenM', HookState(..), InterpretHookReason(..), InternalHookState, fromQueryFn, toQueryFn)
 import Halogen.Hooks.Internal.Types (MemoValuesImpl, OutputValue, SlotType, fromMemoValue, fromMemoValues, toQueryValue)
 import Halogen.Hooks.Internal.UseHookF (UseHookF(..))
-import Halogen.Hooks.Types (StateId(..))
+import Halogen.Hooks.Types (ComponentRef, StateId(..))
 import Halogen.Query.HalogenM (HalogenAp(..))
 import Partial.Unsafe (unsafePartial)
+import Unsafe.Coerce (unsafeCoerce)
 import Unsafe.Reference (unsafeRefEq)
 
 mkEval
@@ -93,6 +96,70 @@ mkEval inputEq _evalHookM _evalHook = case _ of
         void $ executeHooksAndEffects stateRef Step
     H.gets (_.result <<< unwrap)
 
+mkInitialState 
+  :: forall query input monad a hook
+  . ( input -> Hook monad hook a )
+  -> input
+  -> HookState query input monad a
+mkInitialState hookFn input = unsafePerformEffect do
+  stateRef <- Ref.new initialState
+  result <- runFreeM ( go stateRef ) ( unsafeFromHook $ hookFn input :: Free ( UseHookF monad ) a )
+  pure $ HookState { result, stateRef }
+
+  where
+
+  go :: _ -> UseHookF monad ( Free ( UseHookF monad ) a ) -> Effect ( Free ( UseHookF monad ) a )
+  go stateRef = case _ of
+    UseState initial next -> do
+      { componentRef, stateCells } <- Ref.modify
+        (\st -> st { stateCells { queue = Array.snoc st.stateCells.queue initial } } )
+        stateRef
+
+      let identifier = StateId ( Tuple componentRef ( Array.length stateCells.queue - 1 ) )
+      pure ( next ( Tuple initial identifier ) )
+
+    UseQuery _ handler next -> do
+      let
+        handler' :: forall b. query b -> HookM monad ( Maybe b )
+        handler' = handler <<< toQueryValue
+
+      Ref.modify_ ( _ { queryFn = Just $ toQueryFn handler' } ) stateRef
+      pure next
+
+    UseEffect mbMemos _ next -> do
+      let cell = mbMemos /\ pure unit
+      Ref.modify_
+        (\st -> st { effectCells = st.effectCells { queue = Array.snoc st.effectCells.queue cell } } )
+        stateRef
+
+      pure next
+
+    UseMemo memos memoFn next -> do
+      
+      { memoCells: { queue } } <- Ref.read stateRef
+      let newValue = memoFn unit
+      Ref.modify_ ( _ { memoCells { queue = Array.snoc queue (memos /\ newValue) } } ) stateRef
+      pure (next newValue)
+
+    UseRef initial next -> do
+      { refCells: { queue } } <- Ref.read stateRef
+      ref <- Ref.new initial
+      Ref.modify_ ( _ { refCells { queue = Array.snoc queue ref } } ) stateRef
+      pure ( next ( Tuple initial ref ) )
+      
+  initialState :: InternalHookState _ input _ _
+  initialState =
+    { input
+    , componentRef: unsafeCoerce {} :: ComponentRef
+    , queryFn: Nothing
+    , stateCells: { queue: [], index: 0 }
+    , effectCells: { queue: [], index: 0 }
+    , memoCells: { queue: [], index: 0 }
+    , refCells: { queue: [], index: 0 }
+    , evalQueue: []
+    , stateDirty: false
+    }
+
 evalHook
   :: forall q i m a
    . (HalogenM' q i m a a -> HookM m ~> HalogenM' q i m a)
@@ -101,50 +168,32 @@ evalHook
   -> Ref (InternalHookState q i m a)
   -> UseHookF m ~> Free (H.HalogenF (HookState q i m a) (HookM m Unit) SlotType OutputValue m)
 evalHook _evalHookM _evalHook reason stateRef = case _ of
-  UseState initial reply ->
-    case reason of
-      Initialize -> do
-        let
-          identifier = unsafePerformEffect do
-            { componentRef, stateCells } <- Ref.modify (\s -> s { stateCells { queue = Array.snoc s.stateCells.queue initial } }) stateRef
-            pure (StateId (Tuple componentRef (Array.length stateCells.queue - 1)))
-        pure (reply (Tuple initial identifier))
-
-      _ -> do
-        let
-          { value, identifier } = unsafePerformEffect do
-            { componentRef, stateCells: { index, queue } } <- Ref.read stateRef
-            Ref.modify_ (_ { stateCells { index = stepIndex index queue } }) stateRef
-            pure { value: unsafeGetCell index queue, identifier: StateId (Tuple componentRef index) }
-        pure (reply (Tuple value identifier))
-
-  UseQuery _ handler a -> do
+  UseState _ reply -> do
     let
-      handler' :: forall b. q b -> HookM m (Maybe b)
-      handler' = handler <<< toQueryValue
+      { value, identifier } = unsafePerformEffect do
+        { componentRef, stateCells: { index, queue } } <- Ref.read stateRef
+        Ref.modify_ (_ { stateCells { index = stepIndex index queue } }) stateRef
+        pure { value: unsafeGetCell index queue, identifier: StateId (Tuple componentRef index) }
+    pure (reply (Tuple value identifier))
 
-    pure $ unsafePerformEffect do
-      _ <- Ref.modify_ (_ { queryFn = Just $ toQueryFn handler' }) stateRef
-      pure a
+  UseQuery _ _ a -> do
+    pure a
 
   UseEffect mbMemos act a ->
     case reason of
       Initialize -> pure $ unsafePerformEffect do
+        { effectCells : { index, queue } } <- Ref.read stateRef
         let
-          eval :: Int -> HalogenM' _ _ _ _ _
-          eval index = do
+          nextIndex = stepIndex index queue
+        
+          eval :: HalogenM' _ _ _ _ _
+          eval = do
             mbFinalizer <- _evalHookM (_evalHook Queued) act
             let finalizer = fromMaybe (pure unit) mbFinalizer
-            let updateQueue st = unsafeSetCell index (mbMemos /\ finalizer) st
-            pure $ unsafePerformEffect $ Ref.modify_ (\s -> s { effectCells { queue = updateQueue s.effectCells.queue } }) stateRef
+            let newQueue st = unsafeSetCell index (mbMemos /\ finalizer) st
+            pure $ unsafePerformEffect $ Ref.modify_ (\s -> s { effectCells { queue = newQueue s.effectCells.queue } }) stateRef
 
-          initializeState :: InternalHookState _ _ _ _ -> InternalHookState _ _ _ _
-          initializeState st = st
-            { evalQueue = Array.snoc st.evalQueue $ eval $ Array.length st.effectCells.queue
-            , effectCells = st.effectCells { queue = Array.snoc st.effectCells.queue (mbMemos /\ pure unit) }
-            }
-
-        Ref.modify_ initializeState stateRef
+        Ref.modify_ (\st -> st { evalQueue = Array.snoc st.evalQueue eval, effectCells { index = nextIndex } } ) stateRef
         pure a
 
       Queued ->
@@ -192,10 +241,11 @@ evalHook _evalHookM _evalHook reason stateRef = case _ of
   UseMemo memos memoFn reply ->
     case reason of
       Initialize -> pure $ unsafePerformEffect do
-        { memoCells: { queue } } <- Ref.read stateRef
-        let newValue = memoFn unit
-        Ref.modify_ (_ { memoCells { queue = Array.snoc queue (memos /\ newValue) } }) stateRef
-        pure (reply newValue)
+        { memoCells: { queue, index } } <- Ref.read stateRef
+        let _ /\ value = unsafeGetCell index queue
+        let nextIndex = stepIndex index queue
+        Ref.modify_ ( _ { memoCells { index = nextIndex } } ) stateRef
+        pure ( reply value )
 
       _ -> pure $ unsafePerformEffect do
         { memoCells: { index, queue } } <- Ref.read stateRef
@@ -214,20 +264,12 @@ evalHook _evalHookM _evalHook reason stateRef = case _ of
           Ref.modify_ (_ { memoCells { index = nextIndex } }) stateRef
           pure (reply m.value)
 
-  UseRef initial reply ->
-    case reason of
-      Initialize -> pure $ unsafePerformEffect do
-        { refCells: { queue } } <- Ref.read stateRef
-        ref <- Ref.new initial
-        Ref.modify_ (_ { refCells { queue = Array.snoc queue ref } }) stateRef
-        pure (reply (Tuple initial ref))
-
-      _ -> pure $ unsafePerformEffect do
-        { refCells: { index, queue } } <- Ref.read stateRef
-        let ref = unsafeGetCell index queue
-        value <- Ref.read ref
-        Ref.modify_ (_ { refCells { index = stepIndex index queue } }) stateRef
-        pure (reply (Tuple value ref))
+  UseRef _ reply -> pure $ unsafePerformEffect do
+    { refCells: { index, queue } } <- Ref.read stateRef
+    let ref = unsafeGetCell index queue
+    value <- Ref.read ref
+    Ref.modify_ (_ { refCells { index = stepIndex index queue } }) stateRef
+    pure (reply (Tuple value ref))
 
 evalHookM :: forall q i m a. HalogenM' q i m a a -> HookM m ~> HalogenM' q i m a
 evalHookM (H.HalogenM runHooks) (HookM evalUseHookF) =
diff --git a/test/Test/Hooks/UseLifecycleEffect.purs b/test/Test/Hooks/UseLifecycleEffect.purs
index cc675e4..ae80e9b 100644
--- a/test/Test/Hooks/UseLifecycleEffect.purs
+++ b/test/Test/Hooks/UseLifecycleEffect.purs
@@ -11,7 +11,7 @@ import Halogen as H
 import Halogen.Hooks (type (<>), Hook, HookM, UseEffect, UseState)
 import Halogen.Hooks as Hooks
 import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..))
-import Test.Setup.Eval (evalM, initDriver, mkEval)
+import Test.Setup.Eval (evalM, initDriver)
 import Test.Setup.Log (logShouldBe, readResult, writeLog)
 import Test.Setup.Types (EffectType(..), LogRef, TestEvent(..))
 import Test.Spec (Spec, before, describe, it)
@@ -34,18 +34,17 @@ useLifecycleEffectLog log = Hooks.do
   Hooks.pure { tick: Hooks.modify_ stateId (_ + 1) }
 
 lifecycleEffectHook :: Spec Unit
-lifecycleEffectHook = before initDriver $ describe "useLifecycleEffect" do
-  let eval = mkEval useLifecycleEffectLog
+lifecycleEffectHook = before ( initDriver useLifecycleEffectLog ) $ describe "useLifecycleEffect" do
 
-  it "runs the effect on initialize" \ref -> do
+  it "runs the effect on initialize" \{ eval, ref } -> do
     evalM ref $ eval H.Initialize
     logShouldBe ref initializeSteps
 
-  it "runs the effect on initialize and finalize" \ref -> do
+  it "runs the effect on initialize and finalize" \{ eval, ref } -> do
     evalM ref $ eval H.Initialize *> eval H.Finalize
     logShouldBe ref $ fold [ initializeSteps, finalizeSteps ]
 
-  it "doesn't run the effect other than initialize / finalize" \ref -> do
+  it "doesn't run the effect other than initialize / finalize" \{ eval, ref } -> do
     evalM ref do
       eval H.Initialize
 
diff --git a/test/Test/Hooks/UseMemo.purs b/test/Test/Hooks/UseMemo.purs
index 9ead70d..5653b8a 100644
--- a/test/Test/Hooks/UseMemo.purs
+++ b/test/Test/Hooks/UseMemo.purs
@@ -69,10 +69,9 @@ useMemoCount log = Hooks.wrap Hooks.do
     state1 + state2 + 5
 
 memoHook :: Spec Unit
-memoHook = before initDriver $ describe "useMemo" do
-  let eval = mkEval useMemoCount
+memoHook = before ( initDriver useMemoCount ) $ describe "useMemo" do
 
-  it "initializes to the proper initial values" \ref -> do
+  it "initializes to the proper initial values" \{ eval, ref } -> do
     { expensive1, expensive2, expensive3 } <- evalM ref do
       eval H.Initialize
       readResult ref
@@ -81,7 +80,7 @@ memoHook = before initDriver $ describe "useMemo" do
     expensive2 `shouldEqual` 5
     expensive3 `shouldEqual` 5
 
-  it "recalculates memoized values in response to actions" \ref -> do
+  it "recalculates memoized values in response to actions" \{ eval, ref } -> do
     { expensive1, expensive2, expensive3 } <- evalM ref do
       eval H.Initialize
 
@@ -105,7 +104,7 @@ memoHook = before initDriver $ describe "useMemo" do
       , finalizeSteps
       ]
 
-  it "does not recalculate memoized values when memos are unchanged" \ref -> do
+  it "does not recalculate memoized values when memos are unchanged" \{ eval, ref } -> do
     { expensive1, expensive2, expensive3 } <- evalM ref do
       eval H.Initialize
 
@@ -127,7 +126,7 @@ memoHook = before initDriver $ describe "useMemo" do
 
   where
   initializeSteps =
-    [ RunHooks Initialize, RunMemo (CalculateMemo 1), RunMemo (CalculateMemo 2), RunMemo (CalculateMemo 3), Render ]
+    [ RunMemo (CalculateMemo 1), RunMemo (CalculateMemo 2), RunMemo (CalculateMemo 3), RunHooks Initialize, Render ]
 
   finalizeSteps =
     [ RunHooks Finalize, Render ]
diff --git a/test/Test/Hooks/UseRef.purs b/test/Test/Hooks/UseRef.purs
index bdddc95..eb2fed2 100644
--- a/test/Test/Hooks/UseRef.purs
+++ b/test/Test/Hooks/UseRef.purs
@@ -11,7 +11,7 @@ import Halogen as H
 import Halogen.Hooks (type (<>), Hook, HookM, UseRef)
 import Halogen.Hooks as Hooks
 import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..))
-import Test.Setup.Eval (evalM, initDriver, mkEval)
+import Test.Setup.Eval (evalM, initDriver)
 import Test.Setup.Log (logShouldBe, readResult)
 import Test.Setup.Types (TestEvent(..))
 import Test.Spec (Spec, before, describe, it)
@@ -25,17 +25,16 @@ useRefCount = Hooks.do
   Hooks.pure { count, increment: liftEffect $ Ref.modify_ (_ + 1) countRef }
 
 refHook :: Spec Unit
-refHook = before initDriver $ describe "useRef" do
-  let eval = mkEval (const useRefCount)
-
-  it "initializes to the proper initial value" \ref -> do
+refHook = before ( initDriver $ const useRefCount ) $ describe "useRef" do
+  
+  it "initializes to the proper initial value" \{ eval, ref } -> do
     { count } <- evalM ref do
       eval H.Initialize
       readResult ref
 
     count `shouldEqual` 0
 
-  it "updates state in response to actions" \ref -> do
+  it "updates state in response to actions" \{ eval, ref } -> do
     { count } <- evalM ref do
       eval H.Initialize
 
@@ -49,7 +48,7 @@ refHook = before initDriver $ describe "useRef" do
 
     count `shouldEqual` 3
 
-  it "does not cause re-evaluation when value updates" \ref -> do
+  it "does not cause re-evaluation when value updates" \{ eval, ref } -> do
     { count } <- evalM ref do
       eval H.Initialize
 
diff --git a/test/Test/Hooks/UseState.purs b/test/Test/Hooks/UseState.purs
index 4aa9a32..333bd7b 100644
--- a/test/Test/Hooks/UseState.purs
+++ b/test/Test/Hooks/UseState.purs
@@ -10,7 +10,7 @@ import Halogen as H
 import Halogen.Hooks (type (<>), Hook, HookM, UseState)
 import Halogen.Hooks as Hooks
 import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..))
-import Test.Setup.Eval (evalM, mkEval, initDriver)
+import Test.Setup.Eval (evalM, initDriver)
 import Test.Setup.Log (logShouldBe, readResult)
 import Test.Setup.Types (TestEvent(..))
 import Test.Spec (Spec, before, describe, it)
@@ -31,17 +31,15 @@ useStateCount = Hooks.do
     }
 
 stateHook :: Spec Unit
-stateHook = before initDriver $ describe "useState" do
-  let eval = mkEval (const useStateCount)
-
-  it "initializes to the proper initial state value" \ref -> do
+stateHook = before ( initDriver $ const useStateCount ) $ describe "useState" do
+  it "initializes to the proper initial state value" \{ eval, ref } -> do
     { count } <- evalM ref do
       eval H.Initialize
       readResult ref
 
     count `shouldEqual` 0
 
-  it "updates state in response to actions" \ref -> do
+  it "updates state in response to actions" \{ eval, ref } -> do
     { count } <- evalM ref do
       eval H.Initialize
 
diff --git a/test/Test/Hooks/UseTickEffect.purs b/test/Test/Hooks/UseTickEffect.purs
index 6cd1572..9f4bbe2 100644
--- a/test/Test/Hooks/UseTickEffect.purs
+++ b/test/Test/Hooks/UseTickEffect.purs
@@ -11,7 +11,7 @@ import Halogen as H
 import Halogen.Hooks (type (<>), Hook, HookM, UseEffect, UseState)
 import Halogen.Hooks as Hooks
 import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..))
-import Test.Setup.Eval (evalM, initDriver, mkEval)
+import Test.Setup.Eval (evalM, initDriver)
 import Test.Setup.Log (logShouldBe, readResult, writeLog)
 import Test.Setup.Types (EffectType(..), LogRef, TestEvent(..))
 import Test.Spec (Spec, before, describe, it)
@@ -42,14 +42,13 @@ useTickEffectLog log = Hooks.do
       writeLog (RunEffect (EffectCleanup id)) log
 
 tickEffectHook :: Spec Unit
-tickEffectHook = before initDriver $ describe "useTickEffect" do
-  let eval = mkEval useTickEffectLog
+tickEffectHook = before ( initDriver useTickEffectLog ) $ describe "useTickEffect" do
 
-  it "effect runs on initialize and cleans up on finalize" \ref -> do
+  it "effect runs on initialize and cleans up on finalize" \{ eval, ref } -> do
     evalM ref $ eval H.Initialize *> eval H.Finalize
     logShouldBe ref $ fold [ initializeSteps, finalizeSteps ]
 
-  it "effect runs on memo change and cleans up before next run" \ref -> do
+  it "effect runs on memo change and cleans up before next run" \{ eval, ref } -> do
     { count } <- evalM ref do
       eval H.Initialize
 
@@ -72,7 +71,7 @@ tickEffectHook = before initDriver $ describe "useTickEffect" do
       , finalizeSteps
       ]
 
-  it "effect is skipped when memos are unchanged" \ref -> do
+  it "effect is skipped when memos are unchanged" \{ eval, ref } -> do
     _ <- evalM ref do
       eval H.Initialize
 
diff --git a/test/Test/Integration/Issue5.purs b/test/Test/Integration/Issue5.purs
index 38ab715..1557df5 100644
--- a/test/Test/Integration/Issue5.purs
+++ b/test/Test/Integration/Issue5.purs
@@ -9,7 +9,7 @@ import Halogen as H
 import Halogen.Hooks (class HookNewtype, type (<>), Hook, UseEffect, UseState)
 import Halogen.Hooks as Hooks
 import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..))
-import Test.Setup.Eval (evalM, initDriver, mkEval)
+import Test.Setup.Eval (evalM, initDriver)
 import Test.Setup.Log (logShouldBe, readResult, writeLog)
 import Test.Setup.Types (EffectType(..), LogRef, TestEvent(..))
 import Test.Spec (Spec, before, describe, it)
@@ -52,10 +52,9 @@ rerunTickAfterInitialEffects log = Hooks.wrap Hooks.do
       writeLog (RunEffect (EffectCleanup 1)) log
 
 rerunTickAfterInitialEffectsHook :: Spec Unit
-rerunTickAfterInitialEffectsHook = before initDriver $ describe "rerunTickAfterInitialEffects" do
-  let eval = mkEval rerunTickAfterInitialEffects
+rerunTickAfterInitialEffectsHook = before ( initDriver rerunTickAfterInitialEffects ) $ describe "rerunTickAfterInitialEffects" do
 
-  it "tick effect reruns when memos are updated via initial effect's state modification" \ref -> do
+  it "tick effect reruns when memos are updated via initial effect's state modification" \{ eval, ref } -> do
     { count, state1, state2 } <- evalM ref do
       eval H.Initialize
       readResult ref
diff --git a/test/Test/Integration/Issue73.purs b/test/Test/Integration/Issue73.purs
index 64fd161..51b037c 100644
--- a/test/Test/Integration/Issue73.purs
+++ b/test/Test/Integration/Issue73.purs
@@ -4,54 +4,53 @@ import Prelude
 
 import Data.Maybe (Maybe(..))
 import Effect.Aff (Aff)
-import Halogen (liftAff)
 import Halogen as H
-import Halogen.Hooks (class HookNewtype, type (<>), Hook, UseEffect)
+import Halogen.Hooks (class HookNewtype, type (<>), Hook, UseEffect, UseMemo, UseRef, UseState)
 import Halogen.Hooks as Hooks
 import Halogen.Hooks.Internal.Eval.Types (InterpretHookReason(..))
-import Test.Setup.Eval (evalM, initDriver, mkEval)
+import Test.Setup.Eval (evalM, initDriver)
 import Test.Setup.Log (getLogRef, logShouldBe, writeLog)
 import Test.Setup.Types (EffectType(..), LogRef, TestEvent(..))
 import Test.Spec (Spec, before, describe, it)
 
 foreign import data UseImmediateRaiseAndReceive :: Hooks.HookType
 
-type UseImmediateRaiseAndReceive' = UseEffect <> Hooks.Pure
+type UseImmediateRaiseAndReceive' = UseState Int <> UseMemo Int <> UseEffect <> UseRef Int <> Hooks.Pure
 
 instance HookNewtype UseImmediateRaiseAndReceive UseImmediateRaiseAndReceive'
 
-interruptInitialize :: Aff Unit -> LogRef -> Hook Aff UseImmediateRaiseAndReceive Unit
-interruptInitialize interrupt log = Hooks.wrap Hooks.do
+interruptInitialize :: LogRef -> Hook Aff UseImmediateRaiseAndReceive Unit
+interruptInitialize log = Hooks.wrap Hooks.do
+
+  _ <- Hooks.useState 0
+  _ <- Hooks.captures { once : true } Hooks.useMemo \_ -> 0
+
   Hooks.captures { once : true } Hooks.useTickEffect do
       writeLog (RunEffect (EffectBody 0)) log
-      liftAff interrupt
       pure $ Just do
         writeLog (RunEffect (EffectCleanup 0)) log
 
+
+  _ <- Hooks.useRef 0
+
   Hooks.pure unit
 
 safeInitialize :: Spec Unit
-safeInitialize = before initDriver $ describe "safeInitialize" do
-
-  let
-    -- receive should simulate a parent component firing a Receive to the running hook in response to an action in 
-    -- UseEffect
-    receive ref = do
-      logRef <- getLogRef ref
-      evalM ref $ mkEval ( interruptInitialize $ pure unit ) ( H.Receive logRef )
-
-  it "effect initialization should be safe from interuption by parent" \ref -> do
-    
-    evalM ref $ mkEval ( interruptInitialize $ receive ref ) H.Initialize
-
-    logShouldBe ref initializeSteps
-
-  where
-  initializeSteps =
-    [ RunHooks Initialize -- initialize hooks
-    , Render -- first render occurs
-
-    , RunEffect (EffectBody 0) -- run enqueued lifecycle effect's initializer
-    , RunHooks Step -- get interrupted by parent
-    , Render -- render because of parent
-    ]
+safeInitialize = before ( initDriver interruptInitialize ) $ describe "safeInitialize" do
+
+  it "initialization should be finished before Initialize arrives" \{ eval, ref } -> do
+    evalM ref $ eval $ H.Initialize
+    logShouldBe ref [ RunHooks Initialize, Render, RunEffect ( EffectBody 0 ) ]
+
+  it "initialization should be finished before Receive arrives" \{ eval, ref } -> do
+    logRef <- getLogRef ref
+    evalM ref $ eval $ H.Receive logRef
+    logShouldBe ref [ RunHooks Step, Render ]
+
+  it "initialization should be finished before Finalize arrives" \{ eval, ref } -> do
+    evalM ref $ eval $ H.Finalize
+    logShouldBe ref [ RunHooks Finalize, Render ]
+
+  it "initialization should be finished before Action arrives" \{ eval, ref } -> do
+    evalM ref $ eval $ H.Action $ pure unit
+    logShouldBe ref []
diff --git a/test/Test/Setup/Eval.purs b/test/Test/Setup/Eval.purs
index fa1db49..ff25450 100644
--- a/test/Test/Setup/Eval.purs
+++ b/test/Test/Setup/Eval.purs
@@ -5,11 +5,10 @@ module Test.Setup.Eval where
 import Prelude
 
 import Control.Monad.Free (foldFree, liftF, substFree)
-import Data.Maybe (Maybe(..))
 import Data.Newtype (over, unwrap)
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff)
-import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Class (liftEffect)
 import Effect.Exception.Unsafe (unsafeThrow)
 import Effect.Ref (Ref)
 import Effect.Ref as Ref
@@ -23,7 +22,7 @@ import Halogen.Hooks (Hook, HookF(..), HookM(..))
 import Halogen.Hooks.Hook (unsafeFromHook)
 import Halogen.Hooks.Internal.Eval as Hooks.Eval
 import Halogen.Hooks.Internal.Eval.Types (HalogenM', HookState(..))
-import Halogen.Hooks.Types (ComponentRef, StateId(..))
+import Halogen.Hooks.Types (StateId(..))
 import Test.Setup.Log (writeLog)
 import Test.Setup.Types (DriverResultState, LogRef, TestEvent(..), HalogenF')
 import Unsafe.Coerce (unsafeCoerce)
@@ -128,6 +127,11 @@ mkEvalQuery hookFn =
     H.modify_ (over HookState _ { result = a })
     pure a
 
+type Testbed m r q a = 
+  { eval :: ( Unit -> HalogenQ q (HookM m Unit) LogRef Unit ) -> HalogenM' q LogRef m a Unit
+  , ref :: Ref ( DriverResultState r q a )
+  }
+
 -- | Create a new DriverState, which can be used to evaluate multiple calls to
 -- | evaluate test code, and which contains the LogRef.
 -- |
@@ -138,34 +142,24 @@ mkEvalQuery hookFn =
 -- | For more details, look at how Halogen runs components with `runUI` and
 -- | returns an interface that can be used to query them. We essentially want
 -- | to do that, but without the rendering.
-initDriver :: forall m r q a. MonadEffect m => m (Ref (DriverResultState r q a))
-initDriver = liftEffect do
+initDriver :: forall r q a hook . ( LogRef -> Hook Aff hook a ) -> Aff ( Testbed Aff r q a )
+initDriver hookFn = liftEffect do
   logRef <- Ref.new []
-
-  stateRef <- Ref.new
-    { input: logRef
-    , componentRef: unsafeCoerce {} :: ComponentRef
-    , queryFn: Nothing
-    , stateCells: { queue: [], index: 0 }
-    , effectCells: { queue: [], index: 0 }
-    , memoCells: { queue: [], index: 0 }
-    , refCells: { queue: [], index: 0 }
-    , evalQueue: []
-    , stateDirty: false
-    }
-
   lifecycleHandlers <- Ref.new mempty
 
-  map unDriverStateXRef do
-    initDriverState
-      { initialState: \_ -> HookState { result: unit, stateRef }
+  ref <- initDriverState
+      { initialState : Hooks.Eval.mkInitialState hookFn
       , render: \_ -> HH.text ""
       , eval: H.mkEval H.defaultEval
       }
-      unit
+      logRef
       mempty
       lifecycleHandlers
+
+  pure { eval : mkEval hookFn, ref : unDriverStateXRef ref }
+  
   where
+  
   unDriverStateXRef
     :: forall r' s' f' act' ps' i' o'
      . Ref (DriverStateX r' f' o')

From 142213eb9d7da635ac0e0ba641da4818d516577b Mon Sep 17 00:00:00 2001
From: Joost ter Braak <j.terbraak@podo-it.nl>
Date: Tue, 27 Sep 2022 10:11:37 +0200
Subject: [PATCH 2/2] fixed queries using stale handler

---
 src/Halogen/Hooks/Internal/Eval.purs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/Halogen/Hooks/Internal/Eval.purs b/src/Halogen/Hooks/Internal/Eval.purs
index c4194e7..0c19be7 100644
--- a/src/Halogen/Hooks/Internal/Eval.purs
+++ b/src/Halogen/Hooks/Internal/Eval.purs
@@ -176,8 +176,14 @@ evalHook _evalHookM _evalHook reason stateRef = case _ of
         pure { value: unsafeGetCell index queue, identifier: StateId (Tuple componentRef index) }
     pure (reply (Tuple value identifier))
 
-  UseQuery _ _ a -> do
-    pure a
+  UseQuery _ handler a -> do
+    let
+      handler' :: forall b. q b -> HookM m (Maybe b)
+      handler' = handler <<< toQueryValue
+
+    pure $ unsafePerformEffect do
+      _ <- Ref.modify_ (_ { queryFn = Just $ toQueryFn handler' }) stateRef
+      pure a
 
   UseEffect mbMemos act a ->
     case reason of