SSCCE for bug in Halogen

Main.purs

module Main where

import Prelude
import Data.Const (Const)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Halogen (Component, ComponentSlot, HalogenM, HalogenQ, Slot, defaultEval, mkComponent, mkEval, put, raise)
import Halogen.Aff (awaitBody, runHalogenAff)
import Halogen.HTML (HTML, div_, p_, slot, text)
import Halogen.Store.Connect (Connected, connect)
import Halogen.Store.Monad (class MonadStore, runStoreT)
import Halogen.Store.Select (selectAll)
import Halogen.VDom.Driver (runUI)
import Type.Proxy (Proxy(..))

main :: Effect Unit
main =
  runHalogenAff do
    root <- runStoreT unit reduce parent
    body <- awaitBody
    runUI root unit body


-- STORE

type Store
  = Unit

reduce :: Store -> Void -> Store
reduce _ _ = unit


-- PARENT

type ParentState
  = Boolean

type ParentAction
  = ChildOutput

type ParentSlots
  = ( child :: Slot (Const Void) ChildOutput Unit )

parent :: forall query input output storeAction m. MonadStore storeAction Store m => Component query input output m
parent = mkComponent { initialState, render, eval }
  where
  initialState _ = false

  render _ = div_ [ slot (Proxy :: _ "child") unit component unit identity ]

  eval :: HalogenQ query ParentAction input ~> HalogenM ParentState ParentAction ParentSlots output m
  eval = mkEval $ defaultEval { handleAction = handleAction }
    where
    handleAction Message = put true


-- CHILD

type ChildState
  = Boolean

type ChildStoreInput
  = Connected Unit Unit

data ChildAction
  = Initialize

data ChildOutput
  = Message

component :: forall query storeAction m. MonadStore storeAction Store m => Component query Unit ChildOutput m
component = connect selectAll $ mkComponent { initialState, render, eval }
  where
  initialState :: ChildStoreInput -> ChildState
  initialState _ = false

  render :: forall slots. ChildState -> HTML (ComponentSlot slots m ChildAction) ChildAction
  render state =
    if state then
      p_ [ text "Initialized" ]
    else
      text "Loading..."

  eval :: forall slots. HalogenQ query ChildAction ChildStoreInput ~> HalogenM ChildState ChildAction slots ChildOutput m
  eval = mkEval $ defaultEval { handleAction = handleAction, initialize = Just Initialize }
    where
    handleAction Initialize = do
      put true
      raise Message