requestAnimationFrame looping subscription in Halogen 5

RAF.purs

module RAF where

import Prelude

import Data.Foldable (traverse_)
import Data.Maybe (Maybe(..))
import Effect.Aff.Class (class MonadAff)
import Effect.Ref as Ref
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.Query.EventSource as ES
import Web.HTML as HTML
import Web.HTML.Window as Window

data Action
  = Start
  | Stop
  | Tick

type State =
  { count :: Int
  , subscription :: Maybe H.SubscriptionId
  }

component :: forall q i o m. MonadAff m => H.Component HH.HTML q i o m
component =
  H.mkComponent
    { initialState: \_ -> { count: 0, subscription: Nothing }
    , render
    , eval: H.mkEval $ H.defaultEval
        { handleAction = handleAction
        , initialize = Just Start
        }
    }

render :: forall m. State -> H.ComponentHTML Action () m
render state =
  HH.div_
    [ HH.p_ [ HH.text (show state.count) ]
    , HH.button
        [ HP.type_ HP.ButtonButton
        , HE.onClick \_ → Just (if state.subscription == Nothing then Start else Stop)
        ]
        [ HH.text (if state.subscription == Nothing then "Start" else "Stop") ]
    ]

handleAction :: forall o m. MonadAff m => Action -> H.HalogenM State Action () o m Unit
handleAction = case _ of
  Start -> do
    handleAction Stop
    subscription <- H.subscribe $ ES.effectEventSource \emitter -> do
      ref <- Ref.new Nothing
      let
        loop = do
          ES.emit emitter Tick
          id <- Window.requestAnimationFrame loop =<< HTML.window
          Ref.write (Just id) ref
      loop
      pure $ ES.Finalizer do
        Ref.read ref >>= traverse_ \id ->
          Window.cancelAnimationFrame id =<< HTML.window
    H.modify_ (_ { subscription = Just subscription })
  Stop ->
    H.gets _.subscription >>= traverse_ \subscription -> do
      H.unsubscribe subscription
      H.modify (_ { subscription = Nothing })
  Tick ->
    H.modify_ (\st -> st { count = st.count + 1 })