For a time I have wanted to try GHCJS, but it was rumored to be hard to install. However, as I recently installed NixOS on my desktop computer and it has packages for GHCJS, I decided I would give GHCJS a shot. Bas van Diijk had made a mailing list post outlining how he uses uses GHCJS with NixOS. However, being new to NixOS and the Nix package manager language, I had a hard time understanding Bas van Diijk’s post. But with time and a lot of errors, I got a working setup. In this post I will describe what I did.

If you want to follow this howto, you properly already have NixOS installed. If not, you can find a good guide in the Nix Manual. If you want to install NixOS in a virtual machine this guide will help you.

Our example will depend on the unstable Nix package repository. Therefore do:

> mkdir ProducerConsumer
> cd ProducerConsumer
> git clone https://github.com/NixOS/nixpkgs.git

Unfortunately, I could not get the code to work with the newest version of Nix unstable. This is not necessarily surprising as unstable is a moving and not always perfectly working target – hence the name. But here the Nix way comes to the rescue, as one can just roll back the Nix Git repository back to when it did work:

> cd nixpkgs
> git reset --hard 1901f3fe77d24c0eef00f73f73c176fae3bcb44e
> cd ..

So with Nix you can easily follow the bleeding edge, without getting traped in a non-working unstable branch. I would not know how to do this easily with my former Linux distribution Debian.

We will start creating the client:

> mkdir client
> mkdir client/src

We need a client/default.nix file descriping how to buld this client:

{ pkgs ? (import <nixpkgs> {})
, hp ? pkgs.haskellPackages_ghcjs  # use ghcjs packages instead of ghc packages
}:

hp.cabal.mkDerivation (self: {
  pname = "ProducerConsumerClient";
  version = "1.0.0";
  src = ./.;
  isLibrary = false;
  isExecutable = true;
  buildDepends = [ hp.ghcjsDom hp.random hp.stm ];
  buildTools = [ hp.cabalInstall ];
})

This is fairly standard default.nix for Haskell projects, except that we are using GHCJS instead of GHC. If you’re not familiar with Nix expressions, then a good guide can be found here.

We also need a Cabal file client/ProducerConsumerClient.cabal:

name:                ProducerConsumerClient
version:             1.0.0
author:              Mads Lindstrøm
build-type:          Simple
cabal-version:       >=1.10

executable producer-consumer-client
  main-is:             Main.hs
  build-depends:       base >=4.7 && <4.8,
                       ghcjs-dom >= 0.1.1.3,
                       random >= 1.0.1.3,
                       stm >= 2.4.2
  hs-source-dirs:      src
  default-language:    Haskell2010

Finally we need to actually program. We create a small example with a producer and consumer of integers. And a showNumbersVar function, which presents the numbers to the user. We only have one source file client/src/Main.hs:

module Main (
    main
) where

import GHCJS.DOM
import GHCJS.DOM.Document
import GHCJS.DOM.HTMLElement

import System.Random (randomRIO)
import Control.Concurrent.STM (TVar, retry, atomically, modifyTVar, readTVar, newTVar)
import Control.Concurrent (threadDelay, forkIO)

main :: IO ()
main = do
  numbersVar <- atomically $ newTVar [1, 2, 3]
  forkIO (producer numbersVar)
  forkIO (consumer numbersVar)
  showNumbersVar [] numbersVar

showNumbersVar :: [Int] -> TVar [Int] -> IO ()
showNumbersVar lastNumbers numbersVar = do
  currentNumbers <- atomically (do numbers <- readTVar numbersVar
                                   if lastNumbers == numbers then retry else return numbers
                               )
  Just doc <- currentDocument
  Just body   <- documentGetBody doc
  htmlElementSetInnerHTML body ("<h1>" ++ unlines (map (\x -> show x ++ "<br>") currentNumbers) ++ "</h1>")
  showNumbersVar currentNumbers numbersVar

producer :: TVar [Int] -> IO ()
producer numbersVar = do
  sleepMillies 500 2000
  newNumber <- randomRIO (0, 100)
  atomically (modifyTVar numbersVar (newNumber:))
  producer numbersVar

consumer :: TVar [Int] -> IO ()
consumer numbersVar = do
  sleepMillies 500 2000
  atomically (modifyTVar numbersVar (drop 1))
  consumer numbersVar

sleepMillies :: Int -> Int -> IO()
sleepMillies minMs maxMs = randomRIO (minMs*1000, maxMs*1000) >>= threadDelay

This is ordinary Haskell and the code should not have many surprises for the experienced Haskell programmer. It is very nice that we can use Software Transactional Memory (STM) to handle integer list. STM is likely to be especially helpful in a user interface application, where there necessarily is a lot of concurrency.

We can build the client now:

> nix-build -I . client

If successful you should get a link called result, which points to the ProducerConsumerClient in the Nix store. Try:

> ls -l result/bin/producer-consumer-client.jsexe/

Where you should see some files including javascript and html files.

Next the server part. The server parts needs access to the client. We can achieve this by creating a Nix expression pointing to both client and server. Create packages.nix:

{ pkgs ? import <nixpkgs> {} }:

rec {
    client = import ./client { };
    server = import ./server { inherit client; };
}

The server will be a simple Snap application, which just serves the JavaScript files created by ProducerConsumerClient.

We need a server directory:

> mkdir server
> mkdir server/src

And server/default.nix:

{ pkgs ? (import <nixpkgs> {})
, hp ? pkgs.haskellPackages_ghc784
, client
}:

hp.cabal.mkDerivation (self: {
  pname = "ProducerConsumerServer";
  version = "1.0.0";
  src = ./.;
  enableSplitObjs = false;
  buildTools = [ hp.cabalInstall ];
  isExecutable = true;
  isLibrary = false;
  buildDepends = [
      hp.MonadCatchIOTransformers hp.mtl hp.snapCore hp.snapServer hp.split hp.systemFilepath
      client
  ];
  extraLibs = [ ];

  preConfigure = ''
    rm -rf dist
  '';
  
  postInstall = ''
    # This is properly not completely kosher, but it works.
    cp -r $client/bin/producer-consumer-client.jsexe $out/javascript
  '';

  inherit client;
  })

And server/ProducerConsumerServer.cabal:

Name:                ProducerConsumerServer
Version:             1.0
Author:              Author
Category:            Web
Build-type:          Simple
Cabal-version:       >=1.2

Executable producer-consumer-server
  hs-source-dirs: src
  main-is: Main.hs

  Build-depends:
    base                      >= 4     && < 5,
    bytestring                >= 0.9.1 && < 0.11,
    MonadCatchIO-transformers >= 0.2.1 && < 0.4,
    mtl                       >= 2     && < 3,
    snap-core                 >= 0.9   && < 0.10,
    snap-server               >= 0.9   && < 0.10,
    split                     >= 0.2.2,
    system-filepath           >= 0.4.13,
    filepath                  >= 1.3.0.2

  ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
               -fno-warn-unused-do-bind

And server/src/Main.hs:

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Prelude hiding (head, id, div)
import qualified Prelude

import Snap.Core (Snap, dir, modifyResponse, addHeader)
import Snap.Util.FileServe (serveDirectory)
import Snap.Http.Server (quickHttpServe)

import System.Environment (getEnvironment, getEnv, getExecutablePath)
import System.FilePath
import Data.List.Split (splitOn)
import Data.List (isInfixOf)

main :: IO ()
main = do
   exePath <- getExecutablePath
   let baseDir = takeDirectory exePath ++ "/../javascript/"
   quickHttpServe $ site baseDir

getClientDir :: IO String
getClientDir = do
   getEnvironment >>= mapM_ print
   nativeBuildInputs <- getEnv "propagatedNativeBuildInputs"
   return $ Prelude.head $ filter (isInfixOf "my-test-app") $ splitOn " " nativeBuildInputs

site :: String -> Snap ()
site clientDir =
   do Snap.Core.dir "client" (serveDirectory clientDir)
      let header key value = modifyResponse (addHeader key value)
      header "Cache-Control" "no-cache, no-store, must-revalidate"
      header "Pragma" "no-cache"
      header "Expires" "0"

Now we can compile the client, using packages.nix, and the server:

> nix-build -I . packages.nix -A client
> nix-build -I . packages.nix -A server

Now it is time to run the application:

> result/bin/producer-consumer-server

and point your browser to http://localhost:8000/client. You should see the numbers one, two, and three. After about a second you should see the numbers lists changing, as the producer and consumer changes the list.

Introduction

Currently there is no type safe way to make composite widgets with wxHaskell. We can compose two widgets and present them in a GUI. However, we cannot (type safely) compose two widgets into a larger widget, that behaves similarly to ordinary wxHaskell widgets (the Window w -kind). The only solutions that I have found is the CustomControls example in wxHaskell repository and as explained in this mailinglist post. Neither of them is type safe. These examples use unsafe casting of attributes and unsafe casting of the composite widget. Also as seen in the latter example, when widgets needs state they must be kept in a global hashtable, which results in more safety issues. The hashtable is created using unsafePerformIO.

Composability is important for most (maybe any) programming abstraction, and thus we would also like it for wxHaskell. Composability is also common in other GUI toolkit like AWT for Java.

In this post I will propose how we could add composability to wxHaskell.

The source code for this proposal can be found here Composite.hs, here ListExample.hs, and here IntEntryExample.hs.

In this post application programmer will refer to a person implementing a GUI application. Library programmer will refer to a person implementing the wxHaskell library.

Goals

But before going into details, I will state which goals I think is important for composing widgets:

  1. the composite should behave like an ordinary widget to the eyes of the application programmer
  2. be safe to use
  3. be easy to use
  4. simple implementation

The first goal means that the composite type should implement many (if not all) of those type classes that wxHaskell widgets normally implements.

As stated above, current ways of making composite widgets involves unsafe type casting. This is of cause less than ideal. We do not want this or similar risky code.

And lastly, we would of cause want composing to be as easy as possible. Both for the application programmer and the wxHaskell library programmer.

How to compose widgets

In this section I will describe how the application programmer creates new composite widgets, rather than how the library programmer implements the composer functions, which will be shown in the next section. We will show how to compose widgets using two examples.

We create new widgets using the compose function:

compose :: (Panel () -> IO (Layout, super, user))
        -> Window w -> [Prop (Composite super user)] -> IO (Composite super user)

which takes an IO action as input. The action should return a Layout, a super-type, and a user-type. The role of the super-type is to easily inherit some instances. E.g. if the super-type is SingleListBox () then we will inherit instances for Items, Selection, and Selecting. The role of the user-type is to let the composite-widget programmer instantiate arbitrary classes. We will see the use of super-type in the first example, and the user of user-type in the second example.

List-box example

We will create a composite widget containing a list and a button to delete elements in the list. The button should only be enabled when some element is selected in the list.

First, the code for the list-box widget:

type MyList = Composite (SingleListBox ()) ()

-- List with delete button
myList :: Window w -> [Prop MyList] -> IO MyList
myList = compose $ \p ->
    do ls <- singleListBox p [ ]
       b  <- button p [ text := "Delete item"
                      , on command := do s <- get ls selection
                                         when (s /= (-1)) (itemDelete ls s)
                      , enabled := False
                      ]
       set ls [ on mouse := \_ -> do s <- get ls selection
                                     set b [ enabled := (s /= (-1)) ]
                                     putStrLn "Mouse event"
                                     propagateEvent
              ]
       return (row 10 [ widget ls, widget b ], ls, ())

as can be seen this code resembles ordinary wxHaskell code, except for the compose function. Thus, it should be easy for the wxHaskell application programmer to get started. Next the code to use our new widget:

main :: IO ()
main = start $
       do w <- frame []

          -- here we use the new MyList widget
          ls <- myList w [ text := "My list", items := map show [1..7], fontSize := 18
                         , on select := print "Some item selected..."
                         ]
          enableB   <- button w [ text := "Outer enable"
                                , on command := do set ls [ enabled := True ] ]
          disableB  <- button w [ text := "Outer disable"
                                , on command := do set ls [ enabled := False ] ]

          set w [ layout := row 10 [ widget ls, widget enableB, widget disableB ] ]

the main function creates a MyList and two buttons which can enable and disable the widget. Again this resembles ordinary wxHaskell code. The reader should note, that we do the right thing with respect to enabledness. If we hit the enable-button MyList’s delete button is only enabled if some item is selected. That is, the widget do not just blindly enable all of it’s child widgets.

Integer entry

This example will create a text entry specialised for integer values. This time we will not inherit the instances of a super-type but implement our own.

-- Text entry for integers

type IntEntry = Composite () (IO Int, Int -> IO ())

intEntry :: Window w -> [Prop IntEntry] -> IO IntEntry
intEntry = compose $ \p ->
    do intEn <- textEntry p [ processEnter := True
                            , on anyKey := handleInput
                            , text := "0"
                            ]
       let getter = do val <- get intEn text
                       readIO val
           setter x = set intEn [ text := show x ]
       return (widget intEn, (), (getter, setter))
    where
      handleInput (KeyChar c) =
          do if c `elem` ['0'..'9']
                then propagateEvent
                else return ()
      handleInput _ = propagateEvent

class IntValue a where
    intValue :: Attr a Int

instance IntValue IntEntry where
    intValue = newAttr "Int attribute" getter setter
        where getter composite = fst (pickUser composite)
              setter composite = snd (pickUser composite)

as can be seen we made a new class for integer valued widgets. Our new composite widget implements this type.

Here is the full code for IntEntry.

Inherited instances

Regardless of using a super-type or not these instances:

  • Widget
  • Able
  • Bordered
  • Child
  • Dimensions
  • Identity
  • Literate
  • Visible
  • Reactive (event class)

are always inherited. This also means that we cannot specialise these instances for a particular widget. But behavior for these classes should be similar for all widgets. Thus, there is no need to specialise them.

If the super-type implements any of:

  • Items
  • Selection
  • Selections
  • Textual
  • Commanding (event class)
  • Selecting (event class)

then so will the composite widget.

Those it is possible to automatically inherit most of the ordinary wxHaskell instances.

Goals

The two examples show that we fulfil goal one though three, as the code resembles ordinary wxHaskell code, is fairly easy to use, and do not involve unsafe code.

Implementation of compose

We use a Composite type to contain the widgets. It is defined as follows:

data Composite super user =
    Composite { pickPanel :: Panel ()
              , pickSuper :: super
              , pickUser  :: user
              }

All of wxHaskell’s widgets are of type ‘forall w. Window w’, but the Composite type is not. However, this is not problematic, as the Composite type will still look like an ordinary wxHaskell widget to the application programmer, due to implementing most of the ordinary wxHaskell type classes.

The most interesting piece is properly the compose function:

compose :: (Panel () -> IO (Layout, super, user))
        -> Window w -> [Prop (Composite super user)] -> IO (Composite super user)
compose f w props =
    do p <- panel w []
       (lay, super, user) <- f p
       set p [ layout := container p lay  ]
       let composite = Composite p super user
       set composite props
       return composite

it simply creates a panel, sets the layout of the panel, and sets all properties. One should note that no properties are set at widget creation time. This may be problematic for functions like fullRepaintOnResize that requires to be set at creation time.

And now we can instantiate the ordinary Haskell classes:

-- Inherit from Panel () - all composites will inherit these classes
instance Widget (Composite super user) where
    widget w = widget (pickPanel w)

instance Able (Composite super user) where
    enabled = mapFromPanel enabled

...

-- Inherit from super
instance Checkable super => Checkable (Composite super user) where
    checkable = mapFromSuper checkable
    checked   = mapFromSuper checked

...

We have not shown all the instantiated classes. However, these can be found at the accompanying source code.

The complete implementation (with comments) is 208 lines, where most of it is boilerplate class instantiations. While I would like it shorter, it is not overly long and the structure is fairly simple.

Conclusion

As shown the proposal lives up to the goals stated in the beginning:

  1. the composite should behave like an ordinary widget to the eyes of the application programmer
  2. be safe to use
  3. be easy to use
  4. simple implementation

One problem with this proposal is that a small number of wxHaskell functions must be called at widget creation time. We might be able to alleviate this with type-safe casts. But this will have to wait for a future posts.

Another issue could be that Composite is not of type ‘forall w. Window w’. However, I do not see any real problem with this, but would very much like comments from people who do.

Feel free to discuss this proposal. Any improvements, critique, questions, or other comments will be most welcome.

Follow

Get every new post delivered to your Inbox.