Weird Duplication bug in Halogen

Main.purs

module Main where

import Prelude

import Data.Array as Array
import Data.Foldable (for_)
import Data.Maybe (Maybe(..))
import Data.Symbol (SProxy(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (class MonadEffect)
import Halogen (ClassName(..), RefLabel(..), liftEffect)
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties (InputType(..))
import Halogen.HTML.Properties as HP
import Halogen.Hooks (getHTMLElementRef)
import Halogen.Hooks as Hooks
import Halogen.Hooks.Extra.Actions.Events (preventKeyEvent)
import Halogen.VDom.Driver (runUI)
import Web.HTML.HTMLInputElement (fromHTMLElement, value)
import Web.UIEvent.KeyboardEvent as KE

initialArray :: Array String
initialArray =
  -- Two elements only (default)
  ["first", "last"]
  -- Three elements (more strange behavior)
  -- ["1", "2", "3"]
  -- Five elements
  -- ["1", "2", "3", "4", "5"]

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

    -- Halogen Hook version of Window component
    halogenIO <- runUI windowComp initialArray body

    -- Normal Halogen version of Window component
    -- halogenIO <- runUI windowHalogenComp initialArray body

    pure unit

_addItem :: SProxy "addItem"
_addItem = SProxy

_itemList :: SProxy "itemList"
_itemList = SProxy

windowComp
  :: forall q o
   . H.Component HH.HTML q (Array String) o Aff
windowComp = Hooks.component \rec array -> Hooks.do
  state /\ stateToken <- Hooks.useState array
  let
    addItemToArray text = Just do
      -- When the Enter key is pressed, a message is raised to this parent.
      -- It receives it by updating its state to add that element to
      -- the front of the array. This state update will cause a rerender.
      --
      -- When I first came across this bug, I thought it might be due to
      -- re-rendering the parent in the same Aff fiber. So, I tried
      -- updating the state in a separate Aff fiber. However, the bug still
      -- occurs.
      void $ Hooks.fork do
        void $ Hooks.modify stateToken $ Array.cons text
  Hooks.pure $
    HH.div_
      [ HH.h3_
        [ HH.text "Type something into the box below and press Enter" ]
      , HH.slot _addItem unit addItemComp unit addItemToArray

      , HH.p_
        [ HH.text $
            "[List 1] \
            \This list will add the item to the front of the list \
            \correctly. It shows what should happen. It does not use a \
            \Halogen Hook and is just plain HTML."
        ]
      , HH.div_
        (state <#> \itemText ->
          renderText itemText
        )

      , HH.p_
        [ HH.text $
            "[List 2] \
            \This is the same version as above except it uses a Hook that \
            \has no state and simply renders the same HTML as above. \
            \Strangely, It does not work as expected. While the item is \
            \added to the front, the list \"grew\" by another element. \
            \The `first` element, which was the first element before the \
            \content you typed was added, was duplicated at the end."
        ]
      , HH.div_
        (state <#> \itemText ->
          HH.slot _itemList 1 itemCompNoStateUsed itemText (const Nothing)
        )

      , HH.p_
        [ HH.text $
            "[List 3] \
            \This list is a Hook but stores the input as state \
            \and then uses that state when rendering. \
            \It also does not work like the first list above, but more \
            \strangely, it does not work like the second list above that uses \
            \a Hook without state. This seems to give us insight on the nature \
            \of this bug.\n\
            \When you look at the items in List 2 and List 3, you'll notice \
            \that it cycles back and forth between `first` and `last`. For \
            \example, `first`, `last`, `first`, `last`, `first`, `last`, \
            \`first`."
        ]
      , HH.div_
        (state <#> \itemText ->
          HH.slot _itemList 2 itemCompStateUsed itemText (const Nothing)
        )

      , HH.p_
        [ HH.text $
            "[List 4] \
            \So, is the bug in Halogen Hooks? Or in Halogen?\n\
            \If we rewrite the above component using plain Halogen, will it \
            \show the same bug? Yes, it will. But since `windowComp` is itself \
            \a Halogen Hook, perhaps it's this Hook that's causing \
            \the issue? No it isn't. Swap `windowComp` with \
            \`windowHalogenComp`, let the code recompile, \
            \and the same issue will arise."
        ]
      , HH.div_
        (state <#> \itemText ->
          HH.slot _itemList 3 itemHalogenComp itemText (const Nothing)
        )

      , HH.p_
        [ HH.text $
            "[List 5] \
            \To ensure this bug isn't caused by some order-related thing. \
            \This is the same code as List 1."
        ]
      , HH.div_
        (state <#> \itemText ->
          renderText itemText
        )

      , HH.p_
        [ HH.text $
            "Now update `initialArray` in the code to the left to use the \
            \three-element version. See how that confirms our initial insight \
            \above."
        ]
      ]

renderText :: forall a s m. String -> H.ComponentHTML a s m
renderText text =
  HH.span_ [ HH.text $ text <> "  " ] -- added space after text here

itemCompNoStateUsed
  :: forall q o m
   . MonadEffect m
  => H.Component HH.HTML q String o m
itemCompNoStateUsed = Hooks.component \rec initialText -> Hooks.do
  Hooks.pure $ renderText initialText

itemCompStateUsed
  :: forall q o m
   . MonadEffect m
  => H.Component HH.HTML q String o m
itemCompStateUsed = Hooks.component \rec initialText -> Hooks.do
  task /\ taskToken <- Hooks.useState initialText
  Hooks.pure $ renderText task

addItemComp
  :: forall q i m
   . MonadEffect m
  => H.Component HH.HTML q i String m
addItemComp = Hooks.component \rec _ -> Hooks.do
  Hooks.pure $
    HH.input
      [ HP.type_ InputText
      , HP.class_ $ ClassName "add-task"
      , HP.ref refText
      , HE.onKeyDown $ emitMessageOnEnter rec.outputToken
      ]
  where
    refText = RefLabel "addTaskHook"

    emitMessageOnEnter outputToken e = Just do
      case KE.key e of
        "Enter" -> do
          preventKeyEvent e
          mbElement <- getHTMLElementRef refText
          for_ (mbElement >>= fromHTMLElement) \inputEl -> do
            newText <- liftEffect $ value inputEl
            Hooks.raise outputToken newText
        _ -> pure unit

itemHalogenComp :: forall q o m. H.Component HH.HTML q String o m
itemHalogenComp =
  H.mkComponent
    { initialState: identity
    , render: renderText
    , eval: H.mkEval H.defaultEval
    }

data AddItemToArray = AddItemToArray String

windowHalogenComp :: forall q o. H.Component HH.HTML q (Array String) o Aff
windowHalogenComp =
  H.mkComponent
    { initialState: identity
    , render
    , eval: H.mkEval $ H.defaultEval
      { handleAction = handleAction }
    }
  where
    handleAction = case _ of
      AddItemToArray text -> do
        void $ H.fork do
          H.modify_ (Array.cons text)

    render state =
      HH.div_
        [ HH.h3_
          [ HH.text "Type something into the box below and press Enter" ]
        , HH.slot _addItem unit addItemComp unit (Just <<< AddItemToArray)

        , HH.p_
          [ HH.text $
              "[List 1] \
              \This list will add the item to the front of the list \
              \correctly. It shows what should happen. It does not use a \
              \Halogen Hook and is just plain HTML."
          ]
        , HH.div_
          (state <#> \itemText ->
            renderText itemText
          )

        , HH.p_
          [ HH.text $
              "[List 2] \
              \This is the same version as above except it uses a Hook that \
              \has no state and simply renders the same HTML as above. \
              \Strangely, It does not work as expected. While the item is \
              \added to the front, the list \"grew\" by another element. \
              \The `first` element, which was the first element before the \
              \content you typed was added, was duplicated at the end."
          ]
        , HH.div_
          (state <#> \itemText ->
            HH.slot _itemList 1 itemCompNoStateUsed itemText (const Nothing)
          )

        , HH.p_
          [ HH.text $
              "[List 3] \
              \This list is a Hook but stores the input as state \
              \and then uses that state when rendering. \
              \It also does not work like the first list above, but more \
              \strangely, it does not work like the second list above that uses \
              \a Hook without state. This seems to give us insight on the nature \
              \of this bug.\n\
              \When you look at the items in List 2 and List 3, you'll notice \
              \that it cycles back and forth between `first` and `last`. For \
              \example, `first`, `last`, `first`, `last`, `first`, `last`, \
              \`first`."
          ]
        , HH.div_
          (state <#> \itemText ->
            HH.slot _itemList 2 itemCompStateUsed itemText (const Nothing)
          )


        , HH.p_
          [ HH.text $
              "[List 4] \
              \So, is the bug in Halogen Hooks? Or in Halogen?\n\
              \If we rewrite the above component using plain Halogen, will it \
              \show the same bug? Yes, it will. But since `windowComp` is itself \
              \a Halogen Hook, perhaps it's this Hook that's causing \
              \the issue? No it isn't. Swap `windowComp` with \
              \`windowHalogenComp`, let the code recompile, \
              \and the same issue will arise."
          ]
        , HH.div_
          (state <#> \itemText ->
            HH.slot _itemList 3 itemHalogenComp itemText (const Nothing)
          )

        , HH.p_
          [ HH.text $
              "[List 5] \
              \To ensure this bug isn't caused by some order-related thing. \
              \This is the same code as List 1."
          ]
        , HH.div_
          (state <#> \itemText ->
            renderText itemText
          )

        , HH.p_
          [ HH.text $
              "Now update `initialArray` in the code to the left to use the \
              \three-element version. See how that confirms our initial insight \
              \above."
          ]
        ]