Getting started with GHCJS dev

David Johnson @dmjio

June 22, 2016

Problem

Browser sophistication / industry demands

  • Browser functionality is getting more complex
    • WebRTC, IndexedDB, WebSockets, WebGL, Web Workers
  • Front-end apps are becoming more ambitious
    • Video Conferencing, Realtime collaboration, 3D Games

JavaScript is not ideal

Ill-equipped to manage complexity

  • Dynamically typed
  • Weakly typed
  • Implicit global state
  • Ambiguous scoping rules
  • No native module system
  • Verbose syntax

Can we do better?

This is Haskell
This is Haskell

Philosophy

  • Strong static types
  • Strong algebraic abstractions
  • Higher kinded-type system
  • Purity
  • Immutability
  • Unobtrusive syntax
  • Code reuse

Objections

  • Objection 1: Hard to install
    • Rebuttal: stack
  • Objection 2: Large artifact sizes
    • Rebuttal: closure compile it (moot since most large js projects are equivalent in size)
  • Objection 3: Lack of rapid development feedback
    • Rebuttal: ghcjsi / wai-ghcjs
    • Philosophy
      • Failing at compile time > Failing at runtime

Getting ghjcs

compiler-check: match-exact
resolver: nightly-2016-04-17
compiler: ghcjs-0.2.0.820160417_ghc-7.10.3

setup-info:
  ghcjs:
    source:
      ghcjs-0.2.0.820160417_ghc-7.10.3:
        url: "https://tolysz.org/ghcjs/nightly-2016-04-17-820160417.tar.gz"

packages:
- location: '.'

Add your own js

executable main
  js-sources:       js/jquery.js
  main-is:          Main.hs
  ghc-options:      -Wall -O2
  build-depends:    base
  default-language: Haskell2010

Example code

main :: IO ()
main = putStrLn "hi"

stack build

λ Davids-MacBook-Pro jQuery-ex → sb
jquery-0.1.0.0: configure
Configuring jquery-0.1.0.0...
jquery-0.1.0.0: build
Preprocessing executable 'main' for jquery-0.1.0.0...
[1 of 1] Compiling Main             ( Main.hs, .stack-work/dist/x86_64-osx/Cabal-1.22.8.0_ghcjs/build/main/main-tmp/Main.js_o )
Linking .stack-work/dist/x86_64-osx/Cabal-1.22.8.0_ghcjs/build/main/main.jsexe (Main)
jquery-0.1.0.0: copy/register
Installing executable(s) in
/Users/dmj/Desktop/jQuery-ex/.stack-work/install/x86_64-osx/nightly-2016-04-17/ghcjs-0.2.0.820160417_ghc-7.10.3/bin

Artifacts

λ Davids-MacBook-Pro jQuery-ex → cd .stack-work/dist/x86_64-osx/Cabal-1.22.8.0_ghcjs/build/main/main.jsexe
λ Davids-MacBook-Pro main.jsexe → ls -l
total 4984
-rw-r--r--  1 dmj  staff  1264825 Jun 21 11:43 all.js
-rw-r--r--  1 dmj  staff      305 Jun 21 11:43 index.html
-rw-r--r--  1 dmj  staff   322067 Jun 21 11:43 lib.js
-rw-r--r--  1 dmj  staff      312 Jun 21 11:43 manifest.webapp
-rw-r--r--  1 dmj  staff   346297 Jun 21 11:43 out.js
-rw-r--r--  1 dmj  staff     2544 Jun 21 11:43 out.stats
-rw-r--r--  1 dmj  staff   596430 Jun 21 11:43 rts.js
-rw-r--r--  1 dmj  staff       31 Jun 21 11:43 runmain.js
λ Davids-MacBook-Pro main.jsexe → du -hs all.js
1.2M             all.js
λ Davids-MacBook-Pro main.jsexe → ccjs all.js > min.js && du -hs min.js
628K             min.js

Result

Result of "hi" example
Result of "hi" example

Haddocks

  • git clone https://github.com/ghcjs/ghcjs-base
  • put your stack.yaml file in there
  • stack haddock

GHCJSi

  • Hot code swapping
  • npm i socket.io@1.3.7
  • export NODE_PATH=./node_modules

Time API

module Main where

import Control.Monad         ( forever )

import GHCJS.DOM             ( currentWindow )
import GHCJS.DOM.Window      ( getPerformance )
import GHCJS.DOM.Performance ( now )

foreign import javascript unsafe  "console.log($1);"
  consolelog :: Double -> IO ()

main :: IO ()
main = do
  Just window <- currentWindow
  Just performance <- getPerformance window
   forever $ do
     double <- now performance :: IO Double
     consolelog double

Local/Session storage

module Main where

import GHCJS.DOM
import GHCJS.DOM.Window
import GHCJS.DOM.Storage

main :: IO ()
main = do
  Just window <- currentWindow
  Just sessionStorage <- getSessionStorage window
  setItem sessionStorage foo bar
  Just itemSession  :: Maybe String <- getItem sessionStorage foo
  alert window itemSession
  -- removeItem "foo" sessionStorage

  Just localStorage <- getLocalStorage window
  setItem localStorage foo bar
  Just itemLocal :: Maybe String <- getItem localStorage foo
  alert window itemLocal
  -- removeItem localStorage foo
    where
      foo, bar :: String; foo = "foo"; bar = "bar"

AJAX Example

module Main where

import           Data.Aeson
import           Data.ByteString               (ByteString)
import qualified Data.ByteString.Lazy          as L
import           Data.JSString
import           GHCJS.DOM
import           GHCJS.DOM.Window
import           JavaScript.Web.XMLHttpRequest
import           Prelude                       hiding (div)

mkReq :: Method -> JSString -> Request
mkReq method str =
  Request { reqMethod = method :: Method
          , reqURI = str :: JSString
          , reqLogin = Nothing :: Maybe (JSString, JSString)
          , reqHeaders = [] 
          , reqWithCredentials = False 
          , reqData = NoData :: RequestData
          }

req :: Request
req = mkReq GET "https://api.ipify.org?format=json"

newtype IPObject = IPObject { ip :: String } deriving (Show)

instance FromJSON IPObject where
  parseJSON = withObject "IP" $ \o ->
    IPObject <$> o .: "ip"

ajax :: FromJSON a => Request -> IO (Either String a)
ajax Request{..} = do
  resp :: Maybe ByteString <- contents <$> xhrByteString req
  pure $ case resp of
    Nothing -> Left "Empty body"
    Just bs -> eitherDecode (L.fromStrict bs)

main :: IO ()
main = do
  Just window <- currentWindow
  result <- ajax req
  alert window $ show (result :: Either String IPObject)

Canvas example

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Monad
import GHCJS.DOM
import GHCJS.DOM.Document
import GHCJS.DOM.Node
import GHCJS.DOM.Types
import GHCJS.Marshal
import GHCJS.Types
import JavaScript.Web.Canvas

main :: IO ()
main = do
  -- Create canvas
  Just doc <- currentDocument
  Just body <- getBody doc
  canvas <- create 500 500
  -- Casting
  Just (ele :: HTMLCanvasElement) <- fromJSVal (jsval canvas)
  -- Add to body
  void $ appendChild body $ Just ele
  -- Draw circle
  ctx <- getContext canvas
  beginPath ctx
  arc 95 80 52 0 (2*pi) False ctx
  stroke ctx

Geolocation example

module Main where

import Control.Concurrent    ( threadDelay )
import Control.Monad         ( forever )
import Prelude               hiding (log)

import GHCJS.DOM             ( currentWindow )
import GHCJS.DOM.Coordinates ( getLatitude, getLongitude )
import GHCJS.DOM.Types       ( toJSString )
import GHCJS.DOM.Geolocation ( getCurrentPosition )
import GHCJS.DOM.Geoposition ( getCoords )
import GHCJS.DOM.Navigator   ( getGeolocation )
import GHCJS.DOM.Window      ( getNavigator )
import GHCJS.Types           ( JSString )

foreign import javascript unsafe "console.log()" log :: JSString -> IO ()

main :: IO ()
main = do
  Just window <- currentWindow
  Just navigator <- getNavigator window
  Just geolocation <- getGeolocation navigator
  forever $ do
    threadDelay 200
    position <- getCurrentPosition geolocation Nothing
    Just coords <- getCoords position
    lat <- getLatitude coords
    lon <- getLongitude coords
    log $ toJSString $ 
      unlines [ "lat: " ++ show lat
              , "lon: " ++ show lon
              ]

Websocket example

module Main where

import Control.Concurrent     (threadDelay)
import Control.Monad          (forever, when)
import Control.Monad.IO.Class (liftIO)
import GHCJS.DOM.EventM       (on, event)
import GHCJS.DOM.WebSocket    ( open, newWebSocket, sendString, message
                              , close, closeEvent, getReadyState )
import GHCJS.DOM.Types
import GHCJS.Types

secs :: Int -> Int
secs = (*1000000)

foreign import javascript unsafe "console.log($1);"
  log :: JSVal -> IO ()

main :: IO ()
main = do
  webSocket <- newWebSocket
     ("wss://echo.websocket.org" :: String)
     (Just ([] :: [String]))
  removeOpenListener <- on webSocket open $ forever $ do
     ready :: Int <- fromIntegral <$> getReadyState webSocket
     when (ready == 1) $ do
       liftIO $ threadDelay (secs 1)
       sendString webSocket $ ("hello!" :: String)
  removeMessageListener <- on webSocket message $ do
     MessageEvent m <- event
     liftIO $ Main.log m
  webSocketClosedListener <- on webSocket closeEvent $ do
     CloseEvent c <- castToCloseEvent <$> event
     liftIO $ Main.log c
     threadDelay (secs 11)
  close webSocket 3000 ("because" :: String)
  removeOpenListener
  removeMessageListener
  webSocketClosedListener

Example App

Markup rocks

The end