PureScript Halogen — Draw into a Canvas

main.purs

module Main where

import Prelude

import Data.Foldable (for_)
import Effect (Effect)
import Effect.Class (class MonadEffect)
import Graphics.Canvas (getCanvasElementById, getContext2D)
import Graphics.Canvas as Canvas
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.VDom.Driver (runUI)

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

type State = Int

data Action = Render

component ∷ ∀ query input output monad. MonadEffect monad ⇒ H.Component query input output monad
component =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval 
      { handleAction = handleAction }
    }

initialState :: forall input. input -> State
initialState _ = 0

render :: forall m. State -> H.ComponentHTML Action () m
render state = 
  HH.div_
    [ HH.canvas [ HP.id "canvas", HP.width 800, HP.height 600]
    , HH.div_
      [ HH.button [ HE.onClick \_ -> Render ] [ HH.text "Render" ]
      ]
    ]

handleAction :: forall output m. MonadEffect m => Action -> H.HalogenM State Action () output m Unit
handleAction = case _ of
  Render -> do
    maybeCanvas <- H.liftEffect $ getCanvasElementById "canvas"
    for_ maybeCanvas \canvas -> do
      ctx <- H.liftEffect $ getContext2D canvas
      H.liftEffect $ Canvas.setFillStyle ctx "green"
      H.liftEffect $ Canvas.fillRect ctx { x: 10.0, y: 10.0, width: 100.0, height: 100.0 }
      -- H.modify \state -> state
    pure unit