halogen-signal.purs

module Main where

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

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

data Query a = Put State a

ui :: forall g. (Functor g) => Component State Query g
ui = component render eval
  where
    render :: State -> ComponentHTML Query
    render n = text (mconcat ["(", show n.x, ",", show n.y, ")"])

    eval :: Natural Query (ComponentDSL State Query g)
    eval (Put value next) = do
        set value
        pure next

main :: Eff (HalogenEffects (console :: CONSOLE)) Unit
main = runAff throwException pure $ void do
  app <- runUI ui { x: 0, y: 0 }
  onLoad $ appendToBody app.node
  liftEff do
      pos <- mousePos
      runSignal $ (\p -> runAff print pure $ app.driver $ action (Put p)) <$> pos