Note

Some of the information here is outdated. Follow the installation instructions in the README. Using a virtual machine is no longer recommended and the ghcjs-build repository is no longer maintained.

Updated examples can be found in the ghcjs-examples repository, or click the source link. The safety specifications in the JavaScript foreign function interface have been changed slightly, see GHCJS.Foreign for more information. In particular, you need "interruptible" instead of "safe" for asynchronous imports.

Introduction

Since the last post we have made a number of changes to GHCJS. Dan Frumin, who is using GHCJS for his Google Summer of Code project, has contributed an improved build script. Hamish Mackenzie has ported an initial version of ghcjs-dom to our new code generator. Ghcjs-dom contains generated bindings for the DOM API that allow you to write applications that run in the browser with GHCJS, but also as native code, with a webkit frame.

I have added travis support to the repository, so our test suite will be run for every commit and pull request to the GHCJS and shims repositories. I have also updated the prebuilt vagrant virtual machine image to incorporate the latest bugfixes and updates to ByteArray# and pointers.

This time we are going to be looking at functional reactive programming for the web. Since GHCJS has a full-featured Haskell runtime, with support for threading, async exceptions and STM, any existing FRP library should work. We will be using sodium for the examples. If you have trouble getting your favourite FRP library to work with GHCJS, you can contact us on IRC ( #ghcjs on freenode), the mailing list, or file a bug report.

Quick start

Since GHCJS depends on GHC HEAD and Cabal, with a few patches that have not yet been merged, the easiest way to get started is with a vagrant virtual machine:

$ git clone https://github.com/ghcjs/ghcjs-build.git $ cd ghcjs-build $ git checkout prebuilt $ vagrant up

Log into the virtual machine with:

$ vagrant ssh

You can find the examples in /home/vagrant/ghcjs-examples/weblog . To view the result in the browser, start the preinstalled warp web server on the virtual machine with

$ vagrant ssh -c warp

and go to http://localhost:3030/ghcjs-examples/weblog/ (Warp listens on port 3000, Vagrant is configured to forward port 3030 of the host machine to that).

For more information and other installation options, see the GHCJS introduction post on this weblog.

Events and behaviours

Functional reactive programming is based on two composable abstractions: behaviours (time-varying values) and events (happening at discrete points in time). Sodium is a simple push-based library that implements these abstractions: Everything is driven by something pushing a new value to a behaviour or firing a new event.

Note that sodium depends on weak references to clean up unused events. If you want to customize GHCJS’ memory management, do not disable the heap scanner completely if you often create new behaviours and events.

Let’s get started with a simple example. First we create a button that fires an event every time it’s clicked. We count the number of events using sodium’s built-in count behaviour. Finally, we listen to the values in this behaviour and update the text in counterDiv after a change:

module Main where import Control . Monad import Control . Monad . IO . Class import Data . Default import Data . Text ( Text ) import qualified Data . Text as T import JavaScript . JQuery hiding ( Event ) import FRP . Sodium main :: IO () main = do body <- select "body" buttonEvent <- reactiveButton "Click Me!" body counterDiv <- select "<div />" appendJQuery counterDiv body sync $ do counter <- count buttonEvent listen ( values counter ) ( \ n -> void $ setText ( T . pack . show $ n ) counterDiv ) return () reactiveButton :: Text -> JQuery -> IO ( Event () ) reactiveButton label parent = do ( evt , a ) <- sync newEvent button <- select "<button />" setText label button appendJQuery button parent let handler _ = sync ( a () ) on handler "click" def button return evt

Since we use ghcjs-jquery to add the user interface elements, we need to load the jQuery library in our HTML file, also we need some CSS for the examples:

<!DOCTYPE html > <html> <head> <script language= "javascript" src= "//ajax.googleapis.com/ajax/libs/jquery/1.10.1/jquery.min.js" ></script> <script language= "javascript" src= "lib.js" ></script> <script language= "javascript" src= "rts.js" ></script> <script language= "javascript" src= "lib1.js" ></script> <script language= "javascript" src= "out.js" ></script> <style type= "text/css" > html, body { width: 100% ; height: 100% ; margin: 0 ; padding: 0 ; }</style> </head> <body> </body> <script language= "javascript" > h$main(h$mainZCMainzimain); </script> </html>

We will use the same HTML throughout this weblog post.

Button clicks are a typical Event , since they happen at discrete points in time, but many user interface elements have values that change over time. These are better modeled with a Behaviour . The next example uses text input fields and a select menu as reactive elements:

module Main where import Control . Applicative import Control . Monad import Data . Default import Data . Text ( Text ) import qualified Data . Text as T import Text . Read import JavaScript . JQuery import FRP . Sodium main :: IO () main = do body <- select "body" [ op1 , op2 ] <- replicateM 2 $ fmap ( fmap ( readMaybe . T . unpack ) ) ( reactiveTextInput "0" body ) let items = [ ( "add" , arithBehaviour op1 op2 ( + ) ) , ( "multiply" , arithBehaviour op1 op2 ( * ) ) ] sel <- reactiveSelect items body output <- select "<div />" appendJQuery output body sync $ do result <- switch sel listen ( values result ) $ \ v -> void $ setText ( maybe "invalid input" ( T . pack . show ) v ) output return () arithBehaviour :: Behaviour ( Maybe Integer ) -> Behaviour ( Maybe Integer ) -> ( Integer -> Integer -> Integer ) -> Behaviour ( Maybe Integer ) arithBehaviour op1 op2 f = liftA2 f <$> op1 <*> op2 reactiveTextInput :: Text -> JQuery -> IO ( Behaviour Text ) reactiveTextInput value parent = do ( b , a ) <- sync ( newBehaviour value ) input <- select "<input type='text' />" setVal value input appendJQuery input parent let handler _ = sync . a =<< getVal input on handler "keyup change" def input return b reactiveSelect :: [ ( Text , a ) ] -> JQuery -> IO ( Behaviour a ) reactiveSelect items parent = do ( b , a ) <- sync ( newBehaviour . snd . head $ items ) sel <- select "<select />" forM_ ( zip [ ( 0 :: Int ) .. ] items ) $ \ ( n , ( name , _ ) ) -> do opt <- select "<option />" setAttr "value" ( T . pack . show $ n ) opt when ( n == 0 ) $ void ( setAttr "selected" "true" opt ) setText name opt appendJQuery opt sel appendJQuery sel parent let handler _ = sync . a =<< snd . ( items !! ) . read . T . unpack <$> getVal sel on handler "change" def sel return b

The text input field is of type Behaviour Text , it has a time-dependent text value, which gets updated by handling the keyup and change JavaScript events on the HTML input element with jQuery.

The select menu is polymorphic: Every menu item has a label an a value of type a . The values can themselves be Behaviours: In the example, every value is a Behaviour (Maybe Integer) . We use sodium’s switch function to create a new Behaviour that dynamically switches between multiplying and adding the numbers.

Beside sodium’s built-in primitives, the most important way to work with Behaviour s is their Applicative instance. We use this in the example to combine the values of the two operands into a new Behaviour (Actually we use Applicative twice! One more time to lift the operator from Integer -> Integer -> Integer to Maybe Integer -> Maybe Integer -> Maybe Integer ).

Handling mouse input

Not only form elements can be a behaviour. In the next example, we have the current mouse pointer position as a Behaviour (Double, Double) , indicating the distance in pixels from the top left corner of the document.

Open the example and move your mouse pointer over the page. The changes of the mouse Behaviour automatically trigger updates of the position of the objects. Again we use the Applicative instance for Behaviour to combine two inputs: The time (derived from the mouse position) and the position of the parent object.

module Main where import Control . Applicative import Data . Default import Data . Text ( Text ) import qualified Data . Text as T import GHCJS . Types import GHCJS . Foreign import GHCJS . Marshal import JavaScript . JQuery import FRP . Sodium #ifdef __GHCJS__ foreign import javascript unsafe "document.createElementNS('http://www.w3.org/2000/svg',$1)" createSvg :: JSString -> IO Element foreign import javascript unsafe "document.getElementsByTagName($1)" getElementsByTagName :: JSString -> IO ( JSArray a ) foreign import javascript unsafe "$3.setAttribute($1,$2)" setAttribute :: JSString -> JSRef a -> JSRef b -> IO () foreign import javascript unsafe "$2.appendChild($1)" appendChild :: Element -> Element -> IO () #else createSvg = undefined appendChild = undefined getElementsByTagName = undefined setAttribute = undefined #endif setAttribute' :: ToJSRef a => JSString -> a -> JSRef b -> IO () setAttribute' a v o = toJSRef v >>= \ v' -> setAttribute a v' o main = do body <- indexArray 0 =<< getElementsByTagName "body" svg <- createSvg "svg" appendChild svg body setAttribute' "width" ( 400 :: Int ) svg >> setAttribute' "height" ( 400 :: Int ) svg t <- fmap ( ( * 5 ) . fst ) <$> mousePosition body let sun = pure ( 200 , 200 ) earth = object ( 1 / 365 ) 150 sun t moon = object ( 1 / 30 ) 25 earth t drawObject svg "yellow" 20 sun drawObject svg "blue" 8 earth drawObject svg "grey" 3 moon object :: Double -> Double -> Behaviour ( Double , Double ) -> Behaviour Double -> ( Behaviour ( Double , Double ) ) object speed r center time = (,) <$> liftA2 xpos center time <*> liftA2 ypos center time where xpos ( x , _ ) t = x + r * cos ( speed * t ) ypos ( _ , y ) t = y + r * sin ( speed * t ) drawObject :: Element -> Text -> Double -> Behaviour ( Double , Double ) -> IO () drawObject parent color r x = do putStrLn ( T . unpack color ) circle <- createSvg "circle" let p .= v = setAttribute' p v circle "fill" .= color >> "r" .= r appendChild circle parent sync $ listen ( values x ) $ \ ( x , y ) -> "cx" .= x >> "cy" .= y return () mousePosition :: Element -> IO ( Behaviour ( Double , Double ) ) mousePosition elem = do ( b , push ) <- sync $ newBehaviour ( 0 , 0 ) let handler ev = do x <- pageX ev y <- pageY ev sync $ push ( x , y ) on handler "mousemove" def =<< selectElement elem return b

Timers and animation

So far, all events we have seen were caused directly by user input from the keyboard or mouse. In the next example we will see an external (timer) event source and behaviours with an internal state to do a simple (mostly incorrect) physics simulation of balls being attracted to your mouse pointer.

If you compile the example yourself, you need to have ball.png in your executable directory, in addition to the index.html listed above.

Main creates 10 balls, displayed as absolutely positioned image elements. After that, it enters a main loop, which repeatedly fires a stepper event that contains the time elapsed since the last event. The event is combined with the current mouse position and browser window size, using the snapshotWith primitive, which samples the current value of a behaviour at the time an event fires.

After each stepper update, the loop calls threadDelay 1 , which lets the Haskell scheduler yield briefly (since we don’t have any other runnable Haskell threads), to let the browser redraw the window and process new mouse events.

The balls themselves use sodium’s collectE primitive to listen for timestep events, updating the postion and velocity of the ball’s internal state by doing a simple numerical integration step. Externally, only the position is visible.

The number of steps per second depends on the browser and the machine it runs on, therefore the update function uses the time value in the event, the number of milliseconds since the last event, to determine the step size, making the acceleration and velocity of the balls mostly independent of the machine and browser (faster updates, and thus smaller steps, still result in a slightly more accurate simulation).

module Main where import Control . Applicative import Control . Concurrent import Control . Monad import Data . Default import Data . VectorSpace import System . Random import FRP . Sodium import JavaScript . JQuery hiding ( Event ) import GHCJS . Types import GHCJS . Foreign #ifdef __GHCJS__ foreign import javascript unsafe "Date.now()" now :: IO Double foreign import javascript unsafe "$3.css($1,$2+'px')" setCssPx :: JSString -> Double -> JQuery -> IO () #else now = return 0 setCssPx _ _ _ = undefined #endif data R2 = R2 { _x :: Double , _y :: Double } deriving ( Show , Eq , Ord ) instance AdditiveGroup R2 where zeroV = R2 0 0 R2 x1 y1 ^+^ R2 x2 y2 = R2 ( x1 + x2 ) ( y1 + y2 ) negateV ( R2 x y ) = R2 ( negate x ) ( negate y ) instance VectorSpace R2 where type Scalar R2 = Double s *^ ( R2 x y ) = R2 ( s * x ) ( s * y ) instance InnerSpace R2 where ( R2 x1 y1 ) <.> ( R2 x2 y2 ) = ( x1 * x2 ) + ( y1 * y2 ) main :: IO () main = do body <- select "body" bodySize <- size body mouse <- mousePosition body startSize <- sync ( sample bodySize ) ( stepper , pushStepper ) <- sync newEvent let stepper' = snapshotWith (,) stepper ( (,) <$> mouse <*> bodySize ) replicateM_ 10 ( startPos bodySize >>= \ start -> ball body start stepper' ) let step t0 = do t1 <- now sync ( pushStepper $ t1 t0 ) threadDelay 1 step t1 step =<< now startPos :: Behaviour R2 -> IO R2 startPos size = do R2 mx my <- sync ( sample size ) R2 <$> randomRIO ( 0 , mx ) <*> randomRIO ( 0 , my ) ball :: JQuery -> R2 -> Event ( Double , ( R2 , R2 ) ) -> IO ( Behaviour R2 ) ball parent startPos step = do b <- select "<img src='ball.png' width='25' height='25' />" setCss "position" "absolute" b appendJQuery b parent let updCss prop f x = void ( setCssPx prop ( f x ) b ) pos <- sync ( hold startPos =<< collectE upd initial step ) sync ( listen ( values pos ) $ \ x -> updCss "left" _x x >> updCss "top" _y x ) return pos where initial = ( startPos , R2 0 0 ) upd ( dt , ( m , s ) ) ( x , v ) = let r = m ^-^ x a = ( 5 * recip ( 300 + magnitudeSq r ) ) *^ normalized r t @ ( x' , v' ) = clamp s 25 ( x ^+^ ( dt *^ v ) ) ( ( 0.9995 ** dt ) *^ ( v ^+^ ( dt *^ a ) ) ) in ( x' , t ) clamp :: R2 -> Double -> R2 -> R2 -> ( R2 , R2 ) clamp size objSize x v = ( R2 xx xy , R2 vx vy ) where ( xx , vx ) = clamp' _x ( xy , vy ) = clamp' _y clamp' f | x' < 0 = ( x' , abs v' ) | x' > m = ( 2 * m x' , negate ( abs v' ) ) | otherwise = ( x' , v' ) where x' = f x v' = f v m = f size objSize size :: JQuery -> IO ( Behaviour R2 ) size elem = do ( b , push ) <- sync . newBehaviour =<< dims let handler _ = sync . push =<< dims on handler "resize" def elem return b where dims = R2 <$> getWidth elem <*> getHeight elem mousePosition :: JQuery -> IO ( Behaviour R2 ) mousePosition elem = do ( b , push ) <- sync $ newBehaviour ( R2 0 0 ) let handler ev = do x <- pageX ev y <- pageY ev sync $ push ( R2 x y ) on handler "mousemove" def elem return b

Note that we use some foreign imports, getting the current time as a Double , and updating the CSS position of an element through jQuery. In both cases, we could have used existing functions like Data.Time.Clock.getCurrentTime and JavaScript.JQuery.setCss with the Show instance for Double to get the same result.

These functions are both supported but go through a lot of code: getCurrentTime uses emulation for the POSIX gettimeofday call, instance Show Double decodes the floating point to a significand and exponent, using Integer under the hood.

Since we run this from the animation loop, this affects the performance of our program. Fortunately, importing the lighter weight JavaScript alternatives can be done in just a few lines of code.

Smoother animation with requestAnimationFrame

The above example uses a loop in Haskell to trigger each animation step, calling threadDelay every iteration. While this works, it does not always result in a smooth animation: The updates are not synchronized with browser redraws, and the GHCJS scheduler uses JavaScript’s setTimeout function to reschedule itself, which can be a bit unpredictable in the time it takes for this.

Modern browsers support a better alternative: The window.requestAnimationFrame method (unfortunately the name is not standardized across browsers, so we have to test for a few different names) lets the browser run a JavaScript function just before the window is repainted. We can use this function to call back into Haskell and let sodium run one animation step.

GHCJS has two different ways to let JavaScript call back into Haskell code. Asynchronous callbacks (run directly with h$run or create from Haskell with GHCJS.Foreign.asyncCallback ) start a regular Haskell thread in the background. The callback itself returns immediately.

For the animation here, we don’t want an asynchronous callback: The function used with requestAnimationFrame should perform an animation step immediately, updating all objects before returning. The other option, a synchronous callback, does exactly that. Synchronous code is more limited than asynchronous code: The callback will return immediately when the Haskell code tries to do an operation that would block (for example taking an empty MVar , or doing an asynchronous blocking FFI operation).

In the example below, it is possible that the thread blocks when trying run sync , since sodium uses an MVar lock internally. We can choose what happens when a synchronous thread blocks: Either the thread is aborted immediately, or it continues running asynchronously. Here we choose to abort the thread: The animation frame is simply dropped when something is holding the FRP lock.

module Main where import Control . Applicative import Control . Monad import Data . Default import Data . IORef import Data . VectorSpace import System . Random import FRP . Sodium import JavaScript . JQuery hiding ( Event ) import GHCJS . Types import GHCJS . Foreign #ifdef __GHCJS__ foreign import javascript unsafe "Date.now()" now :: IO Double foreign import javascript unsafe "$3.css($1,$2+'px')" setCssPx :: JSString -> Double -> JQuery -> IO () foreign import javascript unsafe " var req = window . requestAnimationFrame ||\ window . mozRequestAnimationFrame ||\ window . webkitRequestAnimationFrame ||\ window . msRequestAnimationFrame ; \ var f = function () { $ 1 () ; req ( f ) ; } ; \ req ( f ) ; " -- fixstr " animate :: JSFun ( IO () ) -> IO () #else now = return 0 setCssPx _ _ _ = undefined animate _ = undefined #endif data R2 = R2 { _x :: Double , _y :: Double } deriving ( Show , Eq , Ord ) instance AdditiveGroup R2 where zeroV = R2 0 0 R2 x1 y1 ^+^ R2 x2 y2 = R2 ( x1 + x2 ) ( y1 + y2 ) negateV ( R2 x y ) = R2 ( negate x ) ( negate y ) instance VectorSpace R2 where type Scalar R2 = Double s *^ ( R2 x y ) = R2 ( s * x ) ( s * y ) instance InnerSpace R2 where ( R2 x1 y1 ) <.> ( R2 x2 y2 ) = ( x1 * x2 ) + ( y1 * y2 ) main :: IO () main = do body <- select "body" bodySize <- size body mouse <- mousePosition body startSize <- sync ( sample bodySize ) ( stepper , pushStepper ) <- sync newEvent let stepper' = snapshotWith (,) stepper ( (,) <$> mouse <*> bodySize ) replicateM_ 10 ( startPos bodySize >>= \ start -> ball body start stepper' ) t <- newIORef =<< now let step = do t0 <- readIORef t t1 <- now sync ( pushStepper $ t1 t0 ) writeIORef t t1 animate =<< syncCallback False step startPos :: Behaviour R2 -> IO R2 startPos size = do R2 mx my <- sync ( sample size ) R2 <$> randomRIO ( 0 , mx ) <*> randomRIO ( 0 , my ) ball :: JQuery -> R2 -> Event ( Double , ( R2 , R2 ) ) -> IO ( Behaviour R2 ) ball parent startPos step = do b <- select "<img src='ball.png' width='25' height='25' />" setCss "position" "absolute" b appendJQuery b parent let updCss prop f x = void ( setCssPx prop ( f x ) b ) pos <- sync ( hold startPos =<< collectE upd initial step ) sync ( listen ( values pos ) $ \ x -> updCss "left" _x x >> updCss "top" _y x ) return pos where initial = ( startPos , R2 0 0 ) upd ( dt , ( m , s ) ) ( x , v ) = let r = m ^-^ x a = ( 5 * recip ( 300 + magnitudeSq r ) ) *^ normalized r t @ ( x' , v' ) = clamp s 25 ( x ^+^ ( dt *^ v ) ) ( ( 0.9995 ** dt ) *^ ( v ^+^ ( dt *^ a ) ) ) in ( x' , t ) clamp :: R2 -> Double -> R2 -> R2 -> ( R2 , R2 ) clamp size objSize x v = ( R2 xx xy , R2 vx vy ) where ( xx , vx ) = clamp' _x ( xy , vy ) = clamp' _y clamp' f | x' < 0 = ( x' , abs v' ) | x' > m = ( 2 * m x' , negate ( abs v' ) ) | otherwise = ( x' , v' ) where x' = f x v' = f v m = f size objSize size :: JQuery -> IO ( Behaviour R2 ) size elem = do ( b , push ) <- sync . newBehaviour =<< dims let handler _ = sync . push =<< dims on handler "resize" def elem return b where dims = R2 <$> getWidth elem <*> getHeight elem mousePosition :: JQuery -> IO ( Behaviour R2 ) mousePosition elem = do ( b , push ) <- sync $ newBehaviour ( R2 0 0 ) let handler ev = do x <- pageX ev y <- pageY ev sync $ push ( R2 x y ) on handler "mousemove" def elem return b

Conclusion

We have seen several examples of functional reactive programming with GHCJS, handling user input and doing animations. Unfortunately for all of the examples we had to do some low-level work ourselves: Setting up mouse event handlers, adding HTML elements to the document. Even though Haskell and GHCJS make these steps relatively easy, we would really like to build a functional reactive user interface library that does this for us, with a collection of ready-made reactive widgets and a declarative way to set up the user interface.