Friday, April 12, 2013

Sunroof: Clockwork Progress

In this article, we are going to generate a JavaScript application. Last year, we wrote a blog post about using monad reification to implement a JavaScript compiler. The compiler, called Sunroof, is now in state that we can make the first public release. By way of a non-trivial example, this blog entry illustrates how to construct an analog clock as a self-contained JavaScript application that renders the clock using the HTML5 canvas element.

[caption id="attachment_163" align="alignnone" width="320" caption="The Sunroof clock example"]The Sunroof clock example[/caption]

The JavaScript API for HTML5 canvas element is already provided by Sunroof in the module Language.Sunroof.JS.Canvas. Lets look how we can render one line of the clock face using Sunroof:
c # save
-- Draw one of the indicator lines
c # beginPath
c # moveTo (0, -u * 1.0)
ifB (n `mod` 5 ==* 0)
(c # lineTo (0, -u * 0.8)) -- Minute line
(c # lineTo (0, -u * 0.9)) -- Hour line
ifB (n `mod` 15 ==* 0)
(c # setLineWidth 8 ) -- Quarter line
(c # setLineWidth 3 ) -- Non-Quarter line
c # stroke
c # closePath
-- Draw of the hour numbers
ifB (n `mod` 5 ==* 0)
(do
c # translate (-u * 0.75, 0)
c # rotate (-2 * pi / 4)
c # fillText (cast $ n `div` 5) (0, 0)
) (return ())
c # restore

The monadic do-notation is used for sequencing JavaScript statements in a neat fashion.

The first few lines probably look familiar to people who have written JavaScript before.
c # save
-- Draw one of the indicator lines
c # beginPath
c # moveTo (0, -u * 1.0)

The #-operator is used instead of the .-operator in JavaScript. u represents the radius of the clock. Knowing this you can see that we are calling methods on the JavaScript object c (Our canvas context). The methods without parameters do not require empty parenthesis, as a Haskell programmer would expect. The tuple used in the call of moveTo is only there to indicate that this parameter is a coordinate, not two single numbers. You can also see that JavaScript numbers are neatly embedded using the Num-class and can be used naturally.

The next few lines show a branch.
ifB (n `mod` 5 ==* 0)
(c # lineTo (0, -u * 0.8)) -- Minute line
(c # lineTo (0, -u * 0.9)) -- Hour line

Haskell lacks the possibilities to deep embed branches and boolean expressions. For that reason we use the Data.Boolean package. Instead of if-then-else you are required to use ifB when writing JavaScript.
ifB (n `mod` 5 ==* 0)
(do
c # translate (-u * 0.75, 0)
c # rotate (-2 * pi / 4)
c # fillText (cast $ n `div` 5) (0, 0)
) (return ())

Note the cast operation in line five. As Haskell's type system is more restrictive then the one used in JavaScript, we sometimes have to cast one value to another. This may seem more complicated then writing JavaScript by hand, but when using the API correctly (by not working around it) compile time errors can show mistakes in the code early.

Getting back to the initial code block: How do we render the other 59 lines of the clock face? We just wrap this code into a function. Of course, we do this at JavaScript level.
renderClockFaceLine <- function $ \
( c :: JSCanvas
, u :: JSNumber
, n :: JSNumber) -> do
...

We have just created the JavaScript function renderClockFaceLine with three parameters. So lets render the complete clock face using the forEach-method provided by arrays.
c # save
c # rotate (2 * pi / 4) -- 0 degrees is at the top
-- Draw all hour lines.
lines <- array [1..60::Int]
lines # forEach $ \n -> do
c # save
c # rotate ((2 * pi / 60) * n)
renderClockFaceLine $$ (c, u, n)
c # restore
c # restore -- Undo all the rotation.

The array combinator converts the list into a JavaScript array. The supplied function for the loop body takes the current element as a parameter. In the loop body you can see how the $$-operator is used just as the $-operator in Haskell to apply a JavaScript function to arguments. As the usefulness of partial application is questionable in the context of deep embedded JavaScript, we only allow uncurried functions.

Using these techniques we can render the clock with about 90 lines of Haskell.
clockJS :: JS A (JSFunction () ())
clockJS = function $ \() -> do
-- Renders a single line (with number) of the clock face.
renderClockFaceLine <- function $ \
( c :: JSCanvas
, u :: JSNumber
, n :: JSNumber) -> do
c # save
-- Draw one of the indicator lines
c # beginPath
c # moveTo (0, -u * 1.0)
ifB (n `mod` 5 ==* 0)
(c # lineTo (0, -u * 0.8)) -- Minute line
(c # lineTo (0, -u * 0.9)) -- Hour line
ifB (n `mod` 15 ==* 0)
(c # setLineWidth 8 ) -- Quarter line
(c # setLineWidth 3 ) -- Non-Quarter line
c # stroke
c # closePath
-- Draw of the hour numbers
ifB (n `mod` 5 ==* 0)
(do
c # translate (-u * 0.75, 0)
c # rotate (-2 * pi / 4)
c # fillText (cast $ n `div` 5) (0, 0)
) (return ())
c # restore
-- Renders a single clock pointer.
renderClockPointer <- function $ \
( c :: JSCanvas
, u :: JSNumber
, angle :: JSNumber
, width :: JSNumber
, len :: JSNumber) -> do
c # save
c # setLineCap "round"
c # rotate angle
c # setLineWidth width
c # beginPath
c # moveTo (0, u * 0.1)
c # lineTo (0, -u * len)
c # stroke
c # closePath
c # restore
-- Renders the clocks pointers for hours, minutes and seconds.
renderClockPointers <- function $ \(c :: JSCanvas, u :: JSNumber) -> do
(h, m, s) <- currentTime
c # save
c # setLineCap "round"
-- Hour pointer
renderClockPointer $$
(c, u, (2 * pi / 12) * ((h `mod` 12) + (m `mod` 60) / 60), 15, 0.4)
-- Minute pointer
renderClockPointer $$
( c, u, (2 * pi / 60) * ((m `mod` 60) + (s `mod` 60) / 60), 10, 0.7)
-- Second pointer
c # setStrokeStyle "red"
renderClockPointer $$ ( c, u, (2 * pi / 60) * (s `mod` 60), 4, 0.9)
-- Restore everything
c # restore
-- Renders the complete face of the clock, without pointers.
renderClockFace <- function $ \(c :: JSCanvas, u :: JSNumber) -> do
c # save
c # rotate (2 * pi / 4) -- 0 degrees is at the top
-- Draw all hour lines.
lines <- array [1..60::Int]
lines # forEach $ \n -> do
c # save
c # rotate ((2 * pi / 60) * n)
renderClockFaceLine $$ (c, u, n)
c # restore
c # restore -- Undo all the rotation.
-- Renders the complete clock.
renderClock <- continuation $ \() -> do
u <- clockUnit
(w,h) <- canvasSize
c <- context
-- Basic setup
c # save
c # setFillStyle "black"
c # setStrokeStyle "black"
c # setLineCap "round"
c # setTextAlign "center"
c # setFont ((cast $ u * 0.1) <> "px serif")
c # setTextBaseline "top"
c # clearRect (0,0) (w,h)
c # translate (w / 2, h / 2)
-- Draw all hour lines.
renderClockFace $$ (c, u)
-- Draw the clock pointers
renderClockPointers $$ (c, u)
c # restore
return ()
window # setInterval (goto renderClock) 1000
-- and draw one now, rather than wait till later
goto renderClock ()

return ()

Using the sunroofCompileJSA function we can compile the deep embedded JavaScript into a string of actual JavaScript.
sunroofCompileJSA def "main" clockJS >>= writeFile "main.js"

The compiled string will contain a function main that executes our JavaScript. This is then called in the HTML file to execute.

There are a few small utilities used in the code. The current time is perceived by currentTime which uses the JavaScript date API provided by the module Language.Sunroof.JS.Date.
currentTime :: JS A (JSNumber, JSNumber, JSNumber)
currentTime = do
date <- newDate ()
h <- date # getHours
m <- date # getMinutes
s <- date # getSeconds
return (h, m, s)

Note that this will literally copy the JavaScript produced by currentTime to where it is used, because it is not abstracted to a function in JavaScript. Every time you write Sunroof code that is not wrapped in a function, the Haskell binding will work like a macro.

The other helpers are just shortcuts to get certain values:
canvas :: JS A JSObject
canvas = document # getElementById "canvas"

context :: JS A JSCanvas
context = canvas >>= getContext "2d"

clockUnit :: JS A JSNumber
clockUnit = do
(w, h) <- canvasSize
return $ (maxB w h) / 2

canvasSize :: JS A (JSNumber, JSNumber)
canvasSize = do
c <- jQuery "#canvas"
w <- c # invoke "innerWidth" ()
h <- c # invoke "innerHeight" ()
return (w, h)

You can see the clock in action here.

As you can see Sunroof mirrors JavaScript closely, and allows access to the capabilities a browser provides. But is this Haskell for Haskell's sake? We do not think so:

  • Sunroof is a deeply embedded DSL, so it is easy to write functions that generate custom code.

  • Sunroof provides some level of type safely on top of JavaScript, including typed arrays, finite maps, functions and continuations.

  • Sunroof also offers an abstraction over the JavaScript threading model, by providing two types of threads, atomic and (cooperatively) blocking. On top of this, Sunroof provides some Haskell concurrency patterns
    like MVar or Chan (JSMVar and JSChan).

  • Furthermore, the sunroof-server package offers a ready to use web-server to deploy generated JavaScript on the fly. It enables you to interleave Haskell and JavaScript computations as needed, through synchronous or asynchronous remote procedure calls.


A number of examples and a tutorial is provided on GitHub. Their Haskell sources can be found on github, they are part of the sunroof-examples package.

Wednesday, April 3, 2013

The Constrained-Type-Class Problem

In Haskell, there are some data types that you want to make an instance of a standard type class, but are unable to do so because of class constraints on the desired class methods. The classic example is that the Set type (from Data.Set) cannot be made an instance of Monad because of an Ord constraint on its desired binding operation:

returnSet :: a -> Set a
returnSet = singleton

bindSet :: Ord b => Set a -> (a -> Set b) -> Set b
bindSet sa k = unions (map k (toList sa))

However, despite being the classic example, in some ways it's not a very good example, because the constraint appears only on the second type parameter of bindSet, not on the first type parameter, nor on returnSet.

Another example of the problem also arises in the context of embedded domain-specific languages. When constructing a deep embedding of a computation that will later be compiled, it is often necessary to restrict the involved types to those that can be reified to the target language. For example:

data EDSL :: * -> * where
  Value  :: Reifiable a => a -> EDSL a
  ...
  Return :: Reifiable a => a -> EDSL a
  Bind   :: (Reifiable a, Reifiable b) =>
            EDSL a -> (a -> EDSL b) -> EDSL b

While we can construct a computation using Return and Bind, we cannot declare a Monad instance using those constructors because of the Reifiable class constraint.

(Note: if you want to try out the code in this post, you'll need the following:

{-# LANGUAGE GADTs, MultiParamTypeClasses, KindSignatures,
    ConstraintKinds, TypeFamilies, RankNTypes,
    InstanceSigs, ScopedTypeVariables #-}

import GHC.Exts (Constraint)
import Data.Set hiding (map)

)

Restricted Type Classes


There have been numerous solutions proposed to address this problem. John Hughes suggested extending Haskell with Restricted Data Types: data types with attached class constraints. In the same paper, Hughes also suggested defining Restricted Type Classes: type classes that take a constraint as a parameter and impose it on all polymorphic type variables in the class methods. This latter approach was simulated several times (by Oleg Kiselyov and Ganesh Sittampalam, amongst others), before the constraint-kinds extension made it possible to encode it directly:

class RMonad (c :: * -> Constraint) (m :: * -> *) where
  return :: c a        => a                 -> m a
  (>>=)  :: (c a, c b) => m a -> (a -> m b) -> m b

It is then straightforward to define instances that require class constraints:

instance RMonad Reifiable EDSL where
  return = Return
  (>>=)  = Bind

However, restricted type classes are new type classes: using them doesn't allow compatibility with existing type classes. If restricted type classes were already used everywhere instead of the original type classes then there would be no problem, but this is not the case. A variant of restricted type classes (suggested by Orchard and Schrijvers is to use an associated type function with a default instance:

class Monad (m :: * -> *) where
  type Con m (a :: *) :: Constraint
  type Con m a = ()

  return :: Con m a            => a                 -> m a
  (>>=)  :: (Con m a, Con m b) => m a -> (a -> m b) -> m b

instance Monad EDSL where
  type Con EDSL a = Reifiable a

  return = Return
  (>>=)  = Bind

An attraction of this approach is that this type class could replace the existing Monad class in the standard libraries, without breaking any existing code. EDIT: Edward Kmett points out that this claim is not true (see comment below). Any code that is polymorphic in an arbitrary monad m would be broken, as the unknown constraint Con m will need to be satisfied.

Normality can be Constraining


If we don't want to modify the type class, then the alternative is to modify the data type. Specifically, we need to modify it in such a way that we can declare the type-class instance we want, but such that the operations of that type class will correspond to the operations we desired on the original data type. For monads, one way to do this is to use continuations, as demonstrated by Persson et al. An alternative (and, in our opinion, more intuitive) way to achieve the same effect is to construct a deep embedding of the computation, and restructure it into a normal form. The normal form we use is the same one used by Unimo and Operational, and consists of a sequence of right-nested >>=s terminating with a return:





The first argument to each >>= is a value of the original data type, which we will call primitive operations (a.k.a. "non-proper morphisms", "effect basis", or "instructions sets").

The key feature of the normal form is that every type either appears as a type parameter on a primitive operation, or appears as the top-level type parameter of the computation. Consequently, if we enforce that all primitives have constrained type parameters, then only the top-level type parameter can remain unconstrained (which is easy to deal with, as we will show later). We can represent this using the following deep embedding:

data NM :: (* -> Constraint) -> (* -> *) -> * -> * where
  Return :: a                             -> NM c t a
  Bind   :: c x => t x -> (x -> NM c t a) -> NM c t a

The t parameter is the type of the primitive operations (e.g. Set), and c is the class constraint (e.g. Ord).

We can define a Monad instance for this deep embedding, which applies the monad laws to restructure the computation into the normal form during construction (just like the Operational package.)

instance Monad (NM c t) where
  return :: a -> NM c t a
  return = Return

  (>>=) :: NM c t a -> (a -> NM c t b) -> NM c t b
  (Return a)  >>= k = k a                        -- left identity
  (Bind ta h) >>= k = Bind ta (\ a -> h a >>= k) -- associativity

Primitive operations can be lifted into the NM type by applying the remaining monad law:

liftNM :: c a => t a -> NM c t a
liftNM ta = Bind ta Return -- right identity

Notice that only primitive operations with constrained type parameters can be lifted, thereby preventing any unconstrained types infiltrating the computation.

Once a computation has been constructed, it can then be interpreted in whatever way is desired. In many cases (e.g. the Set monad), we want to interpret it as the same type as the primitive operations. This can be achieved by the following lowering function, which takes interpretations for return and >>= as arguments.

lowerNM :: forall a c t. (a -> t a) ->
  (forall x. c x => t x -> (x -> t a) -> t a) -> NM c t a -> t a
lowerNM ret bind = lowerNM'
  where
    lowerNM' :: NM c t a -> t a
    lowerNM' (Return a)  = ret a
    lowerNM' (Bind tx k) = bind tx (lowerNM' . k)

Because the top-level type parameter of the computation is visible, we can (crucially) also constrain that type. For example, we can lower a monadic Set computation as follows:

lowerSet :: Ord a => NM Ord Set a -> Set a
lowerSet = lowerNM singleton bindSet

This approach is essentially how the AsMonad transformer from the RMonad library is implemented.

The idea of defining a deep embedding of a normal form that only contains constrained types is not specific to monads, but can be applied to any type class with a normal form such that all types appears as parameters on primitive operations, or as a top-level type parameter. We've just written a paper about this, which is available online along with accompanying code. The code for our principal solution is also available on Hackage.