Lazy / Slot Halogen Issue

Main.purs

module Main where

import Prelude

import Control.Monad.Rec.Class (forever)
import Data.Maybe (Maybe(..))
import Data.Identity (Identity(..))
import Data.Symbol (SProxy(..))
import Effect (Effect)
import Effect.Aff (Aff, Milliseconds(..))
import Effect.Aff as Aff
import Effect.Aff.Class (class MonadAff)
import Effect.Exception (error)
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import Halogen.Query.EventSource (EventSource)
import Halogen.Query.EventSource as EventSource
import Halogen.VDom.Driver (runUI)

main :: Effect Unit
main = HA.runHalogenAff do
  body <- HA.awaitBody
  runUI examplesComponent unit body

{- Each example renders a 'Count: <n>' message. The `renderCountHtml` and `renderCountSlot` functions
   below are two simple ways to render this message. The first is a plain HTML function; the second 
   uses the same function within a minimal component.
   
   This code demonstrates that when the `lazy` or `memoized` functions from Halogen are used on a slot,
   and the equality test returns `true` (ie. the renderer should not be called again, and the previous
   vdom result should be reused) that new slots are unexpectedly created. You can tell even without
   inserting debug statements into halogen-vdom because if you `spy` within the `renderCountHtml`
   function you'll see the `spy` statement print before you see the bug appear.
   
   This bug does not appear when using the plain HTML `renderCountHtml` function.
-}

renderCountHtml :: forall w i. Int -> HH.HTML w i
renderCountHtml n = HH.p_ [ HH.text $ "Count: " <> show n ]

renderCountSlot :: Int -> H.ComponentHTML Action Slots Aff
renderCountSlot n = HH.slot (SProxy :: SProxy "inner") unit counterComponent n absurd

counterComponent :: forall q o. H.Component HH.HTML q Int o Aff
counterComponent = H.mkComponent
  { initialState: identity
  , render: renderCountHtml
  , eval: H.mkEval $ H.defaultEval { handleAction = \(Identity a) -> H.put a, receive = Just <<< Identity  }
  }

-- This render function is used by all the examples, via `containerComponent`. It uses `lazy` to
-- only invoke the provided renderer if the 'count' field in state has changed. The component's
-- 'hidden' field in state is updated several times a second, but the 'count' field is only updated
-- every few seconds.
--
-- If no renderer is provided, this uses the `renderCountSlot` from module scope.
render :: State -> H.ComponentHTML Action Slots Aff
render state = 
  HH.div
    [ HP.attr (HH.AttrName "style") ("height: 300px; padding: 25px; margin: 25px; background-color: " <> state.color <> "; overflow: hidden;") ]
    [ case state.renderer of
        Just renderer -> do
          HH.lazy renderer state.count
        _ ->
          HH.lazy renderCountSlot state.count
    ]

{- Each example provides the `containerComponent` with a different renderer to use. -}

examplesComponent :: forall q i o. H.Component HH.HTML q i o Aff
examplesComponent = H.mkComponent
  { initialState: identity
  , eval: H.mkEval H.defaultEval
  , render: \_ -> HH.div
      [ HP.attr (HH.AttrName "style") "display: grid; grid-template-columns: 1fr 1fr; gap: 25px" ]
      [ -- This container is passed a simple `Int -> HH.HTML w i` function to render the count.
        -- This renderer behaves as expected: when the 'hidden' count updates, the `lazy` refEq
        -- test for the 'count' field returns `true`, and the count is not re-rendered.
        container 0 { color: "cadetblue", renderer: Just renderCountHtml }
        
        -- This container is passed a slot containing the `counter` component. This renderer does
        -- not behave as expected. When the `lazy` refEq test returns `true`, a new slot is created.
      , container 1 { color: "antiquewhite", renderer: Just renderCountSlot }
      
        -- This container is passed a slot containing the `counter` component, wrapped in a div.
        -- This renderer does not behave as expected. When the `lazy` refEq test returns `true`,
        -- a new slot is created and immediately destroyed.
      , container 2 { color: "darkseagreen", renderer: Just \n -> HH.div_ [ renderCountSlot n ] }
      
        -- This container uses the `renderCountSlot` function from module scope instead of accepting
        -- it as an argument. This renderer also doesn't behave as expected.
      , container 3 { color: "lightgray", renderer: Nothing }
      ]
  }
  where
  container id input = HH.slot (SProxy :: SProxy "container") id containerComponent input absurd

{- The 'container' component updates the 'hidden' counter multiple times a second and the 'count'
   counter once every few seconds.
  
   The 'container' component guards the 'Count: <n>' renderer behind a call to `HH.lazy`. The count
   should therefore only re-render every few seconds (when the 'count' field is updated), but it
   should not re-render when the 'hidden' count updates.
-}

type Slots = (inner :: forall q. H.Slot q Void Unit)

type Input =
  { color :: String
  , renderer :: Maybe (Int -> H.ComponentHTML Action Slots Aff)
  }

type State = 
  { color :: String
  , renderer :: Maybe (Int -> H.ComponentHTML Action Slots Aff)
  , count :: Int
  , hidden :: Int
  }

data Action = Initialize | TickHidden | TickCount

containerComponent :: forall q o. H.Component HH.HTML q Input o Aff
containerComponent =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval { handleAction = handleAction, initialize = Just Initialize }
    }
  where
  initialState :: Input -> State
  initialState { color, renderer } =  { color, renderer, count: 0, hidden: 0 }
    
  handleAction :: Action -> H.HalogenM State Action Slots o Aff Unit
  handleAction = case _ of
    Initialize -> do
      _ <- H.subscribe $ timer (Milliseconds 400.0) TickHidden
      _ <- H.subscribe $ timer (Milliseconds 2000.0) TickCount
      pure unit

    TickCount ->
      H.modify_ \state -> state { count = state.count + 1 }
  
    TickHidden ->
      H.modify_ \state -> state { hidden = state.hidden + 1 }

timer :: forall act m. MonadAff m => Milliseconds -> act -> EventSource m act
timer ms act = EventSource.affEventSource \emitter -> do
  fiber <- Aff.forkAff $ forever $ Aff.delay ms *> EventSource.emit emitter act
  pure $ EventSource.Finalizer $ Aff.killFiber (error "Event source finalized") fiber