Where is the bug!?

Item.purs

{- 
Este módulo define un componente Item en Halogen, el componente
está encargado de mostrar el nombre de una tarea y un checkbox
que representa el estado Donde/Undone de la tarea.

-}

module Components.Item (component, Slot, Query, Message(..)) where

import Prelude

import Data.Maybe (Maybe(..))
import Data.Todo as TODO
import Effect.Class (class MonadEffect)
import Effect.Console (log)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP

{-
Primero vamos a definir el estado que gobierna el componente,
vamos utilizar un Record con dos campos: name y st
 -}

type State = {name :: String, st :: TODO.Status, idx :: Int}

 {-
 Luego, definimos las acciones posibles (eventos internos que pueden cambiar 
 el estado de nuestro componente)
 -}

data Action = Check
            | Uncheck
            | Delete Int

{-
También podemos definir un tipo Input que representa la información provista 
al componente directamente por su elemento padre, o el punto de montado.
-}

type Input = {item :: TODO.Item, idx :: Int }

type Slot = H.Slot Query Message

data Message = Deleted Int

data Query a = Void

{- 
Ahora, definimos el componente a través de la función mkComponent de Halogen,
que recibe un Record con el estado inicial del componente, y las funciones
necesarias para mostrar el componente y modificar su estado
-}

component :: forall q m. MonadEffect m => H.Component HH.HTML q Input Message m
component = 
    H.mkComponent
        { initialState
        , render
        , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
        }

initialState :: Input -> State
initialState {item: (TODO.Item n s), idx} = {name: n, st: s, idx: idx}  

render :: forall m. State -> H.ComponentHTML Action () m
render s = 
    HH.div
        [ HP.class_ $ HH.ClassName ("todo-item m-1 " <> ( "item-" <> show s.idx )) ]
        [ HH.input 
            ([HP.type_ HP.InputCheckbox] <> rCheckbox)
        , HH.span
            [ HP.class_ $ HH.ClassName (if s.st == TODO.Done then "line-through" else "") ]
            [ HH.text $ s.name ]
        , HH.a
            [ HE.onClick (\e -> Just (Delete s.idx))
            , HP.class_ $ HH.ClassName "m-2"
            ]
            [ HH.text $ "⨉"]
        ]
    where
        rCheckbox = case s.st of
           TODO.Done -> 
            [ HP.checked true
            , HE.onChange \_ -> Just Uncheck
            , HP.class_ $ HH.ClassName "item-done m-1" ]
           TODO.Undone -> 
            [ HP.checked false
            , HE.onChange \_ -> Just Check 
            , HP.class_ $ HH.ClassName "item-undone m-1"]

handleAction :: forall m. MonadEffect m => Action -> H.HalogenM State Action () Message m Unit
handleAction = case _ of
    Check -> do
        H.modify_ \s -> s { st = TODO.Done }
        H.liftEffect $ log "Check!"
    Uncheck -> do
        H.modify_ \s -> s { st = TODO.Undone }
        H.liftEffect $ log "Uncheck"
    Delete idx -> do
        H.raise (Deleted idx)
        H.liftEffect $ log $ "Delete Item: " <> show idx

ListItems.purs

module Components.ListItem (component) where

import Prelude

import Components.Item as Item
import Data.Array (deleteAt, mapWithIndex)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Symbol (SProxy(..))
import Data.Todo as TODO
import Effect.Class (class MonadEffect)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP

type State = Array TODO.Item

type Input = TODO.TodoList

data Action = HandleItem Item.Message

type ChildSlots = 
    ( item :: Item.Slot Int )

_item :: SProxy "item"
_item = SProxy

component :: forall q o m. MonadEffect m => H.Component HH.HTML q Input o m
component =
    H.mkComponent
        { initialState
        , render
        , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
        }

initialState :: Input -> State 
initialState (TODO.TodoList {name, items}) = items

render :: forall m. MonadEffect m => State -> H.ComponentHTML Action ChildSlots m
render [] = HH.div [ HP.class_ $ HH.ClassName "todo-list" ] []
render items =
    HH.div 
        [ HP.class_ $ HH.ClassName "todo-list m-4" ]
        ((mapWithIndex rChild items) <> [HH.text $ show $ mapWithIndex (\a b -> {a,b}) items])
    where 
        rChild index item = HH.slot _item index Item.component {item: item, idx: index} (Just <<< HandleItem)

handleAction :: forall o m. MonadEffect m => Action -> H.HalogenM State Action ChildSlots o m Unit
handleAction = case _ of
    HandleItem (Item.Deleted idx) -> do
        s <- H.get
        H.put $ fromMaybe s (deleteAt idx s) 

Main.purs

module Main where

import Prelude

import Components.ListItem as LI
import Data.Todo as TODO

import Effect (Effect)
import Halogen.Aff as HA
import Halogen.VDom.Driver (runUI)

main :: Effect Unit
main = HA.runHalogenAff do
  body <- HA.awaitBody
  runUI LI.component TODO.exampleTodo body

Todo.purs

module Data.Todo where

import Prelude

type Name = String
type User = String

data Status = Undone
            | Done

derive instance eqStatus :: Eq Status
derive instance ordStatus :: Ord Status

data Item = Item Name Status

data TodoList = TodoList { items :: Array Item
                         , name :: Name
                         }
                
instance showStatus :: Show Status where
    show Undone = "☐"
    show Done   = "☒"

instance showItem :: Show Item where
    show (Item name status) = show status <> " " <> name

instance showTodoList :: Show TodoList where
    show (TodoList {name, items}) = name <> ": " <> show items

exampleTodo :: TodoList
exampleTodo = TodoList { name: "List 1"
                       , items: [
                           Item "Task 1" Undone,
                           Item "Task 2" Undone,
                           Item "Task 3" Done
                       ]
                       }