Component fails to dispose

Main.purs

module Main where

import Prelude

import Control.Parallel (parTraverse_)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Aff (Aff, Milliseconds(..), delay)
import Halogen as H
import Halogen.Aff (awaitBody, runHalogenAff)
import Halogen.HTML as HH
import Halogen.VDom.Driver (runUI)

main :: Effect Unit
main = runHalogenAff do
  body <- awaitBody
  [ renderGood, renderBad1, renderBad2 ] # parTraverse_ \render -> do
    loadingIO <- runUI (loading render) unit body
    delay (Milliseconds 2000.0)
    loadingIO.dispose

-- This works because the root node (`div_`) never changes.
renderGood :: forall w i. Boolean -> HH.HTML w i
renderGood =
  if _ then 
    HH.div_ [ HH.h1_ [ HH.text "Loading" ] ] 
  else 
    HH.div_ [ ]

-- This fails because the root node changes
renderBad1 :: forall w i. Boolean -> HH.HTML w i
renderBad1 = 
  if _ then 
    HH.h1_ [ HH.text "Loading" ] 
  else 
    HH.text ""

-- This fails because the root node changes
renderBad2 :: forall w i. Boolean -> HH.HTML w i
renderBad2 =
  if _ then
    HH.h1_ [ HH.text "Loading" ]
  else
    HH.h2_ [ HH.text "Loading" ]

-- This component starts rendering the `true` branch, and after 
-- 500 milliseconds renders the `false` branch
loading 
  :: forall q i o
   . (Boolean -> H.ComponentHTML Unit () Aff)
  -> H.Component HH.HTML q i o Aff
loading render =
  H.mkComponent
    { initialState: \_ -> false
    , render
    , eval: H.mkEval $ H.defaultEval 
        { initialize = Just unit
        , handleAction = \_ -> H.liftAff (delay (Milliseconds 500.0)) *> H.put true 
        }
    }