react-basic-hooks custom mouse move hooks

Main.purs

module Main where

import Prelude

import Data.Foldable as Foldable
import Data.Int as Int
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Nullable as Nullable
import Effect (Effect)
import Effect.Exception as Exception
import React.Basic.DOM as DOM
import React.Basic.DOM.Client as Client
import React.Basic.DOM.Events as DOM.Events
import React.Basic.Events (EventHandler)
import React.Basic.Events as Events
import React.Basic.Hooks (type (&), type (/\), Component, Ref, Render, UseEffect, UseRef, UseState, (/\))
import React.Basic.Hooks as Hooks
import Web.DOM.Node (Node)
import Web.DOM.Node as Node
import Web.DOM.NonElementParentNode as NonElementParentNode
import Web.Event.EventTarget as EventTarget
import Web.HTML as HTML
import Web.HTML.HTMLDocument as HTMLDocument
import Web.HTML.Window as Window
import Web.UIEvent.MouseEvent as MouseEvent
import Web.UIEvent.MouseEvent.EventTypes as EventTypes

mkApp :: Component Unit
mkApp = do
  Hooks.component "App" \_ -> Hooks.do
    windowMousePosition <- useWindowMousePosition
    refMousePosition /\ ref <- useRefMousePosition
    handlerMousePosition /\ onMouseMove <- useHandlerMousePosition

    pure
      ( DOM.main
          { style: DOM.css { "font-family": "system-ui" }
          , children:
              [ DOM.section_
                  [ DOM.h2_ [ DOM.text "useWindowMousePosition" ]
                  , DOM.text (show windowMousePosition)
                  ]
              , DOM.section
                  { ref
                  , style:
                      DOM.css { background: "hsl(25, 100%, 94%)" }
                  , children:
                      [ DOM.h2_ [ DOM.text "useRefMousePosition" ]
                      , DOM.text (show refMousePosition)
                      ]
                  }
              , DOM.section
                  { onMouseMove
                  , style:
                      DOM.css { background: "hsl(200, 100%, 94%)" }
                  , children:
                      [ DOM.h2_ [ DOM.text "useHandlerMousePosition" ]
                      , DOM.text (show handlerMousePosition)
                      ]
                  }
              ]
          }
      )

type Position = { x :: Int, y :: Int }

useWindowMousePosition
  :: forall hooks
   . Render hooks
       ( hooks
           & UseState Position
           & UseEffect Unit
       )
       Position
useWindowMousePosition = Hooks.do
  position /\ setPosition <- Hooks.useState' zero
  Hooks.useEffectOnce do
    window <- HTML.window
    let windowEventTarget = Window.toEventTarget window

    listener <- EventTarget.eventListener \event -> do
      Foldable.for_ (MouseEvent.fromEvent event) \mouseEvent -> do
        let
          x = MouseEvent.clientX mouseEvent
          y = MouseEvent.clientY mouseEvent
        setPosition { x, y }
    -- Setup event listener on mount
    EventTarget.addEventListener
      EventTypes.mousemove
      listener
      true
      windowEventTarget
    -- Cleanup on unmount
    pure do
      EventTarget.removeEventListener
        EventTypes.mousemove
        listener
        true
        windowEventTarget
  -- Return the position
  pure position

useRefMousePosition
  :: forall hooks
   . Render hooks
       ( hooks
           & UseState Position
           & UseRef (Nullable Node)
           & UseEffect Unit
       )
       (Position /\ Ref (Nullable Node))
useRefMousePosition = Hooks.do
  position /\ setPosition <- Hooks.useState' zero
  ref <- Hooks.useRef Nullable.null

  Hooks.useEffectOnce do
    listener <- EventTarget.eventListener \event -> do
      Foldable.for_ (MouseEvent.fromEvent event) \mouseEvent -> do
        let
          x = MouseEvent.clientX mouseEvent
          y = MouseEvent.clientY mouseEvent
        setPosition { x, y }
    -- Attach event listener to ref on mount
    maybeTarget <- map Node.toEventTarget <$> Hooks.readRefMaybe ref
    maybeTarget # Foldable.foldMap \target -> do

      EventTarget.addEventListener
        EventTypes.mousemove
        listener
        true
        target
      -- Cleanup on unmount
      pure do
        EventTarget.removeEventListener
          EventTypes.mousemove
          listener
          true
          target
  -- Return the position & ref to pass to element
  pure (position /\ ref)

useHandlerMousePosition
  :: forall hooks
   . Render hooks
       (UseState Position hooks)
       (Position /\ EventHandler)
useHandlerMousePosition = Hooks.do
  position /\ setPosition <- Hooks.useState' zero

  let
    eventHandler = Events.handler
      (Events.merge { maybeX: DOM.Events.clientX, maybeY: DOM.Events.clientY })
      case _ of
        { maybeX: Just x, maybeY: Just y } -> setPosition { x: Int.floor x, y: Int.floor y }
        _ -> mempty

  -- Return the position & handler to pass to element
  pure (position /\ eventHandler)

main :: Effect Unit
main = do
  maybeRoot <- HTML.window
    >>= Window.document
    >>= HTMLDocument.toNonElementParentNode
      >>> NonElementParentNode.getElementById "root"
  case maybeRoot of
    Nothing -> Exception.throw "Root element not found."
    Just root -> do
      app <- mkApp
      reactRoot <- Client.createRoot root
      Client.renderRoot reactRoot (app unit)