MousePos.purs

module MousePos  where

import Prelude (Unit(), pure, ($), bind, show, void, (++))
import Data.Functor ((<$))
import Control.Monad.Aff (Aff(), runAff)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (throwException)
import Control.Monad.Eff.Class (liftEff)
import Halogen (HalogenEffects(), ComponentDSL(), Natural(), ComponentHTML(), Component(), action, runUI, component, set)
import Halogen.Util (appendToBody, onLoad)
import Halogen.HTML.Indexed (text)
import Signal ((<~), runSignal)
import Signal.DOM (CoordinatePair(), mousePos)

type State = CoordinatePair

data Query a = SetState State a

type Effects = HalogenEffects ()

ui :: Component State Query (Aff Effects)
ui = component render eval

  where

    render :: State -> ComponentHTML Query
    render s = text ("(" ++ show s.x ++ "," ++ show s.y ++ ")")

    eval :: Natural Query (ComponentDSL State Query (Aff Effects))
    eval (SetState s next) = next <$ do
        set s

main :: Eff Effects Unit
main = runAff throwException pure $ void do
    app <- runUI ui { x: 0, y: 0 }
    let updatePos p = runAff throwException pure $ app.driver (action (SetState p))
    onLoad $ appendToBody app.node
    liftEff do
        pos <- mousePos
        runSignal $ updatePos <~ pos