diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+## 0.2
+* First public release
+
diff --git a/HISTORY.md b/HISTORY.md
new file mode 100644
--- /dev/null
+++ b/HISTORY.md
@@ -0,0 +1,23 @@
+javascript-bridge allows Haskell to call JavaScript APIs, and
+receive JavaScript events. 
+
+Started Nov 2016 by Andy Gill while at the University of Kansas,
+to support calling JavaScript from Haskell, via web sockets,
+replacing the comet design pattern based kansas-comet.
+
+ - Reworked in 2018 to
+    - support Justin Dawson's Blank Canvas and Remote Monad work
+    - direct remote monad / remote applicative support
+ - Reworked in 2019 to
+    - use finally tagless
+    - other improvements and clean up
+ 
+Authors, contributors, or sponsors:
+  Andy Gill
+  Ryan Scott, Indiana University
+  Google Inc.
+    - (Andy Gill works at Google, so his contributions to this library during
+       his employment comply with Google's open source patching policy)
+  This work is supported by the National Science Foundation CAREER #1350901.
+
+Other authors or contributors are welcome!
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2016-2019, The University of Kansas
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of The University of Kansas nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,78 @@
+# javascript-bridge [![Build Status](https://img.shields.io/travis/ku-fpg/javascript-bridge.svg?style=flat)](https://travis-ci.org/ku-fpg/javascript-bridge)
+
+**javascript-bridge** is a straightforward way of calling JavaScript
+from Haskell, using web-sockets as the underlying transport
+mechanism. Conceptually, javascript-bridge gives Haskell acccess to
+the JavaScript `eval` function.  However, we also support calling and
+returning values from JavaScript functions, constructing and using
+remote objects, and sending events from JavaScript to Haskell, all
+using a remote monad.
+
+# Overview of API
+
+**javascript-bridge** remotely executes JavaScript *fragments*.
+The basic Haskell idiom is.
+```Haskell
+     send eng $ command "console.log('Hello!')"
+```
+where `send` is an `IO` function that sends a commands for remote execution,
+`eng` is a handle into a specific JavaScript engine,
+and `command` is a command builder.
+
+There are also ways synchronously sending a `procedure`,
+that is a JavaScript expression that constructs a value,
+then returns the resulting value.
+
+```Haskell
+  do xs :: String <- send eng $ procedure "new Date().toLocaleTimeString()"
+     print xs
+```
+
+There are ways of creating remote values, for future use,
+where Haskell has a handle for this remote value.
+
+```Haskell
+data Date = Date -- phantom
+
+  do t :: RemoteValue Date <- send eng $ constructor "new Date()"
+     send eng $ procedure $ "console.log(" <> var t <> ".toLocaleTimeString())"
+```
+
+Finally, there is a way of sending events from JavaScript,
+then listening for the event in Haskell.
+
+```Haskell
+  do -- Have JavaScript send an event to Haskell
+     send eng $ command $ event ('Hello!'::String)"
+     -- Have Haskell wait for the event, which is an Aeson 'Value'.
+     e :: Value <- listen eng
+     print e
+```
+
+# Bootstrapping
+
+Bootstrapping the connection is straightforward.
+First, use a `middleware` to setup the (Haskell) server.
+
+```Haskell
+import Network.JavaScript
+
+        ...
+        scotty 3000 $ do
+          middleware $ start app
+          ...
+
+app :: Engine -> IO ()
+app eng = send eng $ command "console.log('Hello!')"
+```
+
+Next, include the following fragment in your HTML code.
+
+```HTML
+    <script>
+        window.jsb = {ws: new WebSocket('ws://' + location.host)};
+        jsb.ws.onmessage = (evt) => eval(evt.data);
+    </script>
+```
+
+That's it!
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/examples/Main.hs b/examples/Main.hs
new file mode 100644
--- /dev/null
+++ b/examples/Main.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Web.Scotty
+import Network.JavaScript
+  
+import Paths_javascript_bridge
+
+main :: IO ()
+main = main_ 3000
+
+main_ :: Int -> IO ()
+main_ i = do
+  dataDir <- getDataDir
+  -- dataDir <- return "." -- use for debugging
+  scotty i $ do
+    middleware $ start app  
+    get "/" $ file $ dataDir ++ "/examples/Main.html"
+
+app :: Engine -> IO ()
+app eng = do
+  send eng $ do
+    command $ call "console.log" [string "starting..."]
+    render "Hello!"
+
+-- It is good practice to reflect the JavaScript utilties
+-- you are using as typed Haskell functions.
+render :: Command f => String -> f ()
+render t = command $ call "jsb.render" [value t]
diff --git a/examples/Main.html b/examples/Main.html
new file mode 100644
--- /dev/null
+++ b/examples/Main.html
@@ -0,0 +1,24 @@
+<!doctype html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
+    <title>Example</title>
+  </head>
+  <body>
+    <h2>Example</h2>
+    <div id="target"></div>
+    <script>
+      // Bootstrap code
+      window.jsb = {ws: new WebSocket('ws://' + location.host)};
+      jsb.ws.onmessage = (evt) => eval(evt.data);
+      // Debugging to JavaScript console
+      jsb.debug = true;
+      // Example-specific code
+      jsb.render = (t) => {
+	  document.querySelector('#target').innerHTML += t;
+	  document.querySelector('#target').innerHTML += '<BR>';
+      }
+    </script>
+  </body>
+</html>
diff --git a/examples/Multi.hs b/examples/Multi.hs
new file mode 100644
--- /dev/null
+++ b/examples/Multi.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Web.Scotty
+import Network.JavaScript
+import Data.Semigroup
+import Text.Read(readMaybe)
+  
+import Paths_javascript_bridge
+
+main :: IO ()
+main = main_ 3000
+
+data Applets
+  = Commands
+  | Procedures
+  | Constructors
+  | Promises
+  deriving (Eq, Ord, Show, Read, Enum, Bounded)
+
+
+main_ :: Int -> IO ()
+main_ i = do
+  dataDir <- getDataDir
+  --dataDir <- return "." -- use for debugging
+  scotty i $ do
+    middleware $ start app
+    -- Any path, including /, returns the contents of Main.hs
+    get "/:cmd" $ file $ dataDir ++ "/examples/Main.html"
+
+app :: Engine -> IO ()
+app eng = do
+  -- simple dispatch based on location
+  hash <- send eng $ procedure "window.location.pathname"
+  case hash of
+    "/" -> indexPage eng
+    '/':xs -> case readMaybe xs of
+                Just sub -> applet eng sub
+                Nothing -> return ()
+    _ -> return ()
+
+indexPage :: Engine -> IO ()
+indexPage eng = send eng $ render $
+      "<ol>" <> Prelude.concat
+        ["<li><a href=\"/" <> show a <> "\">"
+          <> show a
+          <> "</a></li>"
+        | a <- [minBound .. maxBound] :: [Applets]
+        ] <>
+      "</ol>"
+
+applet :: Engine -> Applets -> IO ()
+applet eng Commands = do
+  send eng $ do
+    render "Hello World!"
+applet eng Procedures = do
+  send eng $ do
+    -- The addition is done using JavaScript
+    n <- addition 1.0 2.0
+    render $ "1.0 + 2.0 = " ++ show n
+applet eng Constructors = do
+  send eng $ do
+    -- Here, we construct an object, and it remotely
+    o <- constructor "{n : 1}"
+    n :: Int <- procedure $ var o <> ".n"
+    render $ show n
+    command $ var o <> ".n++"
+    n :: Int <- procedure $ var o <> ".n"
+    render $ show n
+applet eng Promises = do
+  send eng $ do
+    -- When a promise is returned by a procedure,
+    -- then we wait for it to resolve.
+    p1 <- procedure $
+      "new Promise((resolve,reject) => {" <>
+      "  setTimeout(() => { resolve('Done p1')}, 1000)"  <>
+      "})"
+    render $ show (p1 :: String)
+  send eng $ do
+    -- When we group return values, we wait for all
+    -- promises to resolve before returning to Haskell.
+    -- Internally, this uses Promises.all()
+    (p2,p3) <- (,) <$>
+       (procedure $
+         "new Promise((resolve,reject) => {" <>
+          "  setTimeout(() => { resolve('Done p2')}, 1000)"  <>
+          "})") <*>
+       (procedure $
+         "new Promise((resolve,reject) => {" <>
+          "  setTimeout(() => { resolve('Done p3')}, 500)"  <>
+          "})")
+    render $ show (p2 :: String, p3 :: String)
+  send eng $ do
+    -- constructors create remote handles, and the
+    -- handle can be a promise, and is returned
+    -- immeduately.
+    p2 <- constructor $
+      "new Promise((resolve,reject) => {" <>
+      "  setTimeout(() => { resolve('Done p4')}, 1000)"  <>
+      "})"
+    command $ var p2 <> ".then((v) => { jsb.render(JSON.stringify(v)) })"
+
+    
+-- It is good practice to reflect the JavaScript utilties
+-- you are using as typed Haskell functions.
+render :: Command f => String -> f ()
+render t = command $ call "jsb.render" [value t]
+
+addition :: Procedure f => Double -> Double -> f Double
+addition a b = procedure $ value a <> "+" <> value b
diff --git a/javascript-bridge.cabal b/javascript-bridge.cabal
new file mode 100644
--- /dev/null
+++ b/javascript-bridge.cabal
@@ -0,0 +1,78 @@
+name:                javascript-bridge
+version:             0.2.0
+synopsis:            Remote Monad for JavaScript on the browser
+description:         Bridge from Haskell to JavaScript on the browser
+license:             BSD3
+license-file:        LICENSE
+author:              Andy Gill
+maintainer:          andygill@ku.edu
+copyright:           Copyright (c) 2016-2019 The University of Kansas
+category:            Network
+build-type:          Simple
+extra-source-files:  CHANGELOG.md, README.md, HISTORY.md
+cabal-version:       >=1.10
+tested-with:         GHC == 8.4.4
+                   , GHC == 8.6.5
+                   , GHC == 8.8.1
+
+data-files:
+  examples/Main.html
+           
+source-repository head
+  type:                git
+  location:            https://github.com/ku-fpg/javascript-bridge
+
+library
+  exposed-modules:     Network.JavaScript,
+                       Network.JavaScript.Internal,
+                       Network.JavaScript.Services
+  build-depends:       base                 >= 4.9     && < 4.14
+                     , binary               >= 0.8     && < 0.9
+                     , aeson                >= 1.4     && < 1.5
+                     , containers           >= 0.5     && < 0.7
+                     , stm                  >= 2.4     && < 2.6
+                     , text                 >= 1.2     && < 1.3
+                     , time                 >= 1.6     && < 1.10                     
+                     , transformers         >= 0.4     && < 0.6
+                     , wai                  >= 3.2     && < 3.3
+                     , wai-websockets       >= 3.0.1   && < 3.1
+                     , websockets           >= 0.10    && < 0.13
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+
+test-suite javascript-bridge-test
+  type:       exitcode-stdio-1.0
+  main-is:             Main.hs
+  build-depends:       base                 >= 4.9 && < 4.14
+                     , aeson                >= 1.0 && < 1.5
+                     , javascript-bridge
+                     , scotty               == 0.11.*
+                     , wai-extra            == 3.0.*
+                     , stm                  >= 2.4 && < 2.6
+                     , text                 >= 1.2 && < 1.3
+                     , time                 >= 1.6 && < 1.10
+  hs-source-dirs:      test
+  default-language:    Haskell2010
+  ghc-options:         -threaded -Wall
+
+executable javascript-bridge-simple
+  main-is:             Main.hs
+  other-modules:       Paths_javascript_bridge
+  build-depends:       base                 >= 4.9 && < 4.14
+                     , javascript-bridge
+                     , scotty               == 0.11.*
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -threaded -Wall
+
+executable javascript-bridge-examples
+  main-is:             Multi.hs
+  other-modules:       Paths_javascript_bridge
+  build-depends:       base                 >= 4.9 && < 4.14
+                     , javascript-bridge
+                     , scotty               == 0.11.*
+                     , text                 >= 1.2 && < 1.3
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -threaded -Wall
diff --git a/src/Network/JavaScript.hs b/src/Network/JavaScript.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/JavaScript.hs
@@ -0,0 +1,294 @@
+{-# LANGUAGE OverloadedStrings,KindSignatures, GADTs, ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ConstraintKinds #-}
+
+module Network.JavaScript
+  (  -- * Sending Remote Monads and Packets
+    send
+  , sendA
+  , sendE
+    -- * Building Remote Monads and Packets
+  , JavaScript(..)
+  , command
+  , procedure
+  , constructor
+    -- * Remote Applicative and Monads, and classes for building them
+  , Packet
+  , RemoteMonad
+  , Command()
+  , Procedure()
+    -- * Remote Values
+  , RemoteValue
+  , delete
+  , localize
+  , remote
+    -- * JavaScript builders
+  , var
+  , value
+  , call
+  , number
+  , string
+    -- * Events
+  , JavaScriptException(..)
+  , event
+  , addListener
+  , listen
+  , readEventChan
+  -- * Web services
+  , start
+  , Engine
+  , Application
+  ) where
+
+import Control.Applicative(liftA2)
+import Control.Exception(Exception, throwIO)
+import Data.Monoid ((<>))
+import qualified Data.Text.Lazy as LT
+import Data.Text.Lazy (Text)
+import Network.Wai (Application)
+import Control.Monad.Trans.State.Strict
+
+import Data.Aeson ( Value(..), FromJSON(..), ToJSON(..), encode, Result(..), fromJSON)
+import Data.Text.Lazy.Encoding(decodeUtf8)
+
+
+import Network.JavaScript.Internal
+import Network.JavaScript.Services
+
+------------------------------------------------------------------------------
+
+-- | 'command' statement to execute in JavaScript. ';' is not needed as a terminator.
+--   Should never throw an exception, which may be reported to console.log.
+command :: Command f => JavaScript -> f ()
+command = internalCommand
+  
+-- | 'constructor' expression to execute in JavaScript. ';' is not needed as a terminator.
+--   Should never throw an exception, but any exceptions are returned to the 'send'
+--   as Haskell exceptions.
+--
+--   The value returned in not returned to Haskell. Instead, a handle is returned,
+--   that can be used to access the remote value. Examples of remote values include
+--   objects that can not be serialized, or values that are too large to serialize.
+--
+--   The first type argument is the phantom type of the 'RemoteValue', so that
+--   type application can be used to specify the type.
+constructor :: forall a f . Command f => JavaScript -> f (RemoteValue a)
+constructor = internalConstructor
+
+-- | 'procedure' expression to execute in JavaScript. ';' is not needed as a terminator.
+--   Should never throw an exception, but any exceptions are returned to the 'send'
+--   as Haskell exceptions.
+--
+--   Procedures can return Promises. Before completing the transaction, all the values
+--   for all the procedures that are promises are fulfilled (using Promises.all).
+--
+--  If a procedure throws an exception, future commands and procedures in
+--  the same packet will not be executed. Use promises to allow all commands and
+--  procedures to be invoked, if needed.
+procedure :: forall a f . (Procedure f, FromJSON a) => JavaScript -> f a
+procedure = internalProcedure
+
+------------------------------------------------------------------------------
+
+-- | 'send' a remote monad for execution on a JavaScript engine.
+--  The monad may be split into several packets for transmission
+-- and exection.
+
+send :: Engine -> RemoteMonad a -> IO a
+send e p = do
+  r <- sendE e p
+  case r of
+    Right a -> return a
+    Left err -> throwIO $ JavaScriptException err
+
+data JavaScriptException = JavaScriptException Value
+    deriving (Show,Eq)
+
+instance Exception JavaScriptException
+
+-- | 'send' with all JavaScript exceptions caught and returned.
+sendE :: Engine -> RemoteMonad a -> IO (Either Value a)
+sendE e (RemoteMonad rm) = go rm
+  where
+    go m = do
+      w <- walkStmtM e m
+      case w of
+        ResultPacket af _ -> sendStmtA e af
+        IntermPacket af k -> do
+          r <- sendStmtA e af
+          case r of
+            Right a -> go (k a)
+            Left msg -> return $ Left msg
+
+data PingPong a where
+  ResultPacket :: AF Stmt a -> Maybe a -> PingPong a
+  IntermPacket :: AF Stmt a -> (a -> M Primitive b) -> PingPong b
+
+walkStmtM :: Engine -> M Primitive a -> IO (PingPong a)
+walkStmtM _          (PureM a) = pure $ ResultPacket (pure a) (pure a)
+walkStmtM Engine{..} (PrimM p) = do
+  s <- prepareStmt genNonce p
+  let af = PrimAF s
+  return $ ResultPacket af (evalStmtA af [])
+walkStmtM e          (ApM g h) = do
+  w1 <- walkStmtM e g
+  case w1 of
+    ResultPacket g_af g_r -> do
+      w2 <- walkStmtM e h
+      case w2 of
+        ResultPacket h_af h_r -> return $ ResultPacket (g_af <*> h_af) (liftA2 ($) g_r h_r)
+        IntermPacket h_af k -> return $
+          IntermPacket (liftA2 (,) g_af h_af)
+                       (\ (r1,r2) -> pure r1 <*> k r2)
+    IntermPacket g_af k -> return $ IntermPacket g_af (\ r -> k r <*> h)
+walkStmtM e          (BindM m k) = do
+  w1 <- walkStmtM e m
+  case w1 of
+    ResultPacket m_af (Just a) -> do
+      w2 <- walkStmtM e (k a)
+      case w2 of
+        ResultPacket h_af h_r ->
+          return $ ResultPacket (m_af *> h_af) h_r
+        IntermPacket h_af k' -> return $
+          IntermPacket (m_af *> h_af) k'
+    ResultPacket m_af Nothing ->
+          return $ IntermPacket m_af k
+    IntermPacket m_af k0 -> return $ IntermPacket m_af (\ r -> k0 r >>= k)
+
+-- | send an (applicative) 'Packet'. This packet always sent atomically to JavaScript.
+sendA :: Engine -> Packet a -> IO a
+sendA e p = do
+  r <- sendAE e p
+  case r of
+    Right a -> return a
+    Left err -> throwIO $ JavaScriptException err
+
+-- INLINE
+sendAE :: Engine -> Packet a -> IO (Either Value a)
+sendAE e@Engine{..} (Packet af) = prepareStmtA genNonce af >>= sendStmtA e
+
+-- statements are internal single JavaScript statements, that can be
+-- transliterated trivially into JavaScript, or interpreted to give
+-- a remote effect, including result.
+
+data Stmt a where
+  CommandStmt   :: JavaScript -> Stmt ()
+  ProcedureStmt :: FromJSON a => Int -> JavaScript -> Stmt a
+  ConstructorStmt :: RemoteValue a -> JavaScript -> Stmt (RemoteValue a)
+
+deriving instance Show (Stmt a)
+  
+prepareStmtA :: Monad f => f Int -> AF Primitive a -> f (AF Stmt a)
+prepareStmtA _  (PureAF a) = pure (pure a)
+prepareStmtA ug (PrimAF p) = PrimAF <$> prepareStmt ug p
+prepareStmtA ug (ApAF g h) = ApAF <$> prepareStmtA ug g <*> prepareStmtA ug h
+
+prepareStmt :: Monad f => f Int -> Primitive a -> f (Stmt a)
+prepareStmt _ (Command stmt)     = pure $ CommandStmt stmt
+prepareStmt ug (Procedure stmt)   = ug >>= \ i -> pure $ ProcedureStmt i stmt
+prepareStmt ug (Constructor stmt) = ug >>= \ i -> pure $ ConstructorStmt (RemoteValue i) stmt
+   
+showStmtA :: AF Stmt a -> JavaScript
+showStmtA stmts = JavaScript
+                $ LT.concat [ js | JavaScript js <- concatAF (return . showStmt) stmts ]
+
+showStmt :: Stmt a -> JavaScript
+showStmt (CommandStmt cmd)     = cmd <> ";"
+showStmt (ProcedureStmt n cmd) = "var " <> procVar n <> "=" <> cmd <> ";"
+showStmt (ConstructorStmt rv cmd) = var rv <> "=" <> cmd <> ";"
+
+evalStmtA :: AF Stmt a -> [Value] -> Maybe a
+evalStmtA af st = evalStateT (evalAF evalStmt af) st
+
+evalStmt :: Stmt a -> StateT [Value] Maybe a
+evalStmt (CommandStmt _)       = pure ()
+evalStmt (ProcedureStmt _ _)   = do
+  vs <- get
+  case vs of
+    (v:vs') -> put vs' >> case fromJSON v of
+      Error _ -> fail "can not parse result"
+      Success r -> return r
+    _ -> fail "not enough values"
+evalStmt (ConstructorStmt c _) = pure c
+
+sendStmtA :: Engine -> AF Stmt a -> IO (Either Value a)
+sendStmtA _ (PureAF a) = return (pure a)
+sendStmtA e af
+    | null assignments = do
+        sendJavaScript e $ showStmtA af
+        return $ case evalStmtA af [] of
+            Nothing -> error "internal failure"
+            Just r -> Right r        
+    | otherwise = do
+        nonce <- genNonce e
+        sendJavaScript e $ catchMe nonce $ showStmtA af
+        theReply <- replyBox e nonce
+        case theReply of
+          Right replies -> return $ case evalStmtA af replies of
+            Nothing -> error "internal failure"
+            Just r -> Right r
+          Left err -> return $ Left err
+        
+  where
+    catchMe :: Int -> JavaScript -> JavaScript
+    catchMe nonce txt =
+      "try{" <> txt
+             <> "}catch(err){jsb.error(" <> JavaScript (LT.pack (show nonce))
+             <> ",err);};" <>
+      reply nonce <> ";"
+
+    assignments :: [Int]
+    assignments = concatAF findAssign af
+
+    findAssign :: Stmt a -> Maybe Int
+    findAssign (ProcedureStmt i _) = Just i
+    findAssign _ = Nothing
+    
+    -- generate the call to reply (as a final command)
+    reply :: Int -> JavaScript
+    reply n = JavaScript $
+      "jsb.reply(" <> LT.intercalate ","
+      [ LT.pack (show n)
+      , "[" <> LT.intercalate "," [ x | JavaScript x <- map procVar assignments] <> "]"
+      ] <> ")"
+
+-- TODO: Consider a wrapper around this Int
+procVar :: Int -> JavaScript
+procVar n = JavaScript $ "v" <> LT.pack (show n)
+
+------------------------------------------------------------------------------
+
+-- | 'delete' a remote value.
+delete :: Command f => RemoteValue a -> f ()
+delete rv = command $ "delete " <> var rv
+
+-- | 'localize' brings a remote value into Haskell.
+localize :: Procedure f => RemoteValue a -> f Value
+localize = procedure . var
+
+-- | 'remote' sends a local value to JavaScript.
+remote :: Command f => Value -> f (RemoteValue a)
+remote = constructor . value
+
+-- | Generate a 'JavaScript' value, including for 'RemoteValue''s.
+value :: ToJSON v => v -> JavaScript
+value = JavaScript . decodeUtf8 . encode
+
+-- | Generate JavaScript number
+number :: Double -> JavaScript
+number = value
+
+-- | Generate (quoted) JavaScript string
+string :: Text -> JavaScript
+string = value
+
+-- | Generate a function call
+call :: JavaScript -> [JavaScript] -> JavaScript
+call fn args = fn <> "(" <> JavaScript (LT.intercalate "," [ js | JavaScript js <- args ]) <> ")"
+
+-- | Send an event back to Haskell
+event :: ToJSON v => v -> JavaScript
+event v = call "jsb.event" [value v]
diff --git a/src/Network/JavaScript/Internal.hs b/src/Network/JavaScript/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/JavaScript/Internal.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE OverloadedStrings,KindSignatures, GADTs, ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ConstraintKinds #-}
+
+module Network.JavaScript.Internal
+  ( -- * JavaScript
+    JavaScript(..)
+    -- * Commands
+  , Command()
+  , internalCommand
+  , internalConstructor
+    -- * Procedures
+  , Procedure()
+  , internalProcedure
+    -- * Primitives and (Remote) Values
+  , Primitive(..)
+  , RemoteValue(..)
+  , var
+    -- * (Applicative) Packets
+  , Packet(..)
+  , AF(..)
+  , RemoteMonad(..)
+  , evalAF
+  , concatAF
+    -- * Monads
+  , M(..)
+  , evalM
+  ) where
+
+import           Data.Aeson (ToJSON(..), FromJSON(..))
+import qualified Data.Aeson.Encoding.Internal as AI
+import qualified Data.Binary.Builder as B
+import           Data.Text.Lazy(Text, pack)
+import           Data.Text.Lazy.Encoding(encodeUtf8)
+import           Data.String
+
+------------------------------------------------------------------------------
+
+newtype JavaScript = JavaScript Text
+  deriving Show
+
+instance IsString JavaScript where
+  fromString = JavaScript . fromString
+  
+instance Semigroup JavaScript where
+  JavaScript x <> JavaScript y = JavaScript $ x <> y
+  
+instance Monoid JavaScript where
+  mempty = JavaScript mempty
+  mappend = (<>)
+
+class Command f where
+  internalCommand :: JavaScript -> f ()
+  internalConstructor :: JavaScript -> f (RemoteValue a)
+
+class Procedure f where
+  internalProcedure :: FromJSON a => JavaScript -> f a
+  
+-- | The Remote Applicative Packet
+newtype Packet a = Packet (AF Primitive a)
+  deriving (Functor, Applicative)
+
+-- | The Remote Monad
+newtype RemoteMonad a = RemoteMonad (M Primitive a)
+  deriving (Functor, Applicative, Monad)
+
+data Primitive :: * -> * where
+  Command   :: JavaScript -> Primitive ()
+  Procedure :: FromJSON a => JavaScript -> Primitive a
+  Constructor :: JavaScript -> Primitive (RemoteValue a)
+
+instance Command Packet where
+  internalCommand = Packet . PrimAF . Command  
+  internalConstructor = Packet . PrimAF . Constructor
+
+instance Procedure Packet where
+  internalProcedure = Packet . PrimAF . Procedure
+
+instance Command RemoteMonad where
+  internalCommand = RemoteMonad . PrimM . Command  
+  internalConstructor = RemoteMonad . PrimM . Constructor
+
+instance Procedure RemoteMonad where
+  internalProcedure = RemoteMonad . PrimM . Procedure
+
+-- A Local handle into a remote value.
+newtype RemoteValue a = RemoteValue Int
+  deriving (Eq, Ord, Show)
+
+-- Remote values can not be encoded in JSON, but are JavaScript variables.
+instance ToJSON (RemoteValue a) where
+  toJSON = error "toJSON not supported for RemoteValue"
+  toEncoding rv = AI.unsafeToEncoding $ B.fromLazyByteString $ encodeUtf8 txt
+    where
+      JavaScript txt = var rv
+      
+-- | generate the text for a RemoteValue. They can be used as assignment
+--   targets as well, but exposes the JavaScript scoping semantics.
+var :: RemoteValue a -> JavaScript
+var (RemoteValue n) = JavaScript $ "jsb.rs[" <> pack (show n) <> "]"
+
+------------------------------------------------------------------------------
+-- Framework types for Applicative and Monad
+
+data AF :: (* -> *) -> * -> * where
+ PureAF :: a -> AF m a
+ PrimAF :: m a -> AF m a
+ ApAF :: AF m (a -> b) -> AF m a -> AF m b
+
+instance Functor (AF m) where
+  fmap f g = pure f <*> g
+  
+instance Applicative (AF m) where
+  pure = PureAF
+  (<*>) = ApAF
+
+concatAF :: (forall x . m x -> Maybe b) -> AF m a -> [b]
+concatAF _ (PureAF _) = []
+concatAF f (PrimAF p) = case f p of
+  Nothing -> []
+  Just r -> [r]
+concatAF f (ApAF m1 m2) = concatAF f m1 ++ concatAF f m2
+
+evalAF :: Applicative f => (forall x . m x -> f x) -> AF m a -> f a
+evalAF _ (PureAF a) = pure a
+evalAF f (PrimAF p) = f p
+evalAF f (ApAF g h) = evalAF f g <*> evalAF f h
+
+data M :: (* -> *) -> * -> * where
+ PureM :: a -> M m a
+ PrimM :: m a -> M m a
+ ApM :: M m (a -> b) -> M m a -> M m b
+ BindM :: M m a -> (a -> M m b) -> M m b
+
+instance Functor (M m) where
+  fmap f g = pure f <*> g
+  
+instance Applicative (M m) where
+  pure = PureM
+  (<*>) = ApM
+
+instance Monad (M m) where
+  return = PureM
+  (>>=) = BindM
+  (>>) = (*>)
+
+evalM :: Monad f => (forall x . m x -> f x) -> M m a -> f a
+evalM _ (PureM a) = pure a
+evalM f (PrimM p) = f p
+evalM f (ApM g h) = evalM f g <*> evalM f h
+evalM f (BindM m k) = evalM f m >>=  evalM f . k
diff --git a/src/Network/JavaScript/Services.hs b/src/Network/JavaScript/Services.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/JavaScript/Services.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE OverloadedStrings,KindSignatures, GADTs, ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+module Network.JavaScript.Services
+  ( -- * Web Services
+    Engine(..)
+  , start
+  , addListener
+  , listen
+  , readEventChan
+  , Application
+  ) where
+
+import Control.Applicative((<|>))
+import qualified Data.Text.Lazy as LT
+import Data.Time.Clock
+import qualified Network.Wai.Handler.WebSockets as WS
+import Network.Wai (Application)
+import qualified Network.WebSockets as WS
+
+import Control.Concurrent (forkIO, ThreadId)
+import Control.Exception (try, SomeException)
+import Control.Monad (forever)
+import Control.Concurrent.STM
+import Data.Aeson (Value(..), decode', FromJSON(..),withObject,(.:))
+import qualified Data.IntMap.Strict as IM
+
+import Network.JavaScript.Internal(JavaScript(..))
+
+-- | This accepts WebSocket requests, calls the callback with
+--   an 'Engine' that can be used to access JavaScript.
+
+start :: (Engine -> IO ())
+      -> Application -> Application
+start kE = WS.websocketsOr WS.defaultConnectionOptions $ \ pc -> do
+  conn <- WS.acceptRequest pc
+  -- Use ping to keep connection alive
+  WS.forkPingThread conn 10
+  -- Bootstrap the remote handler
+  WS.sendTextData conn bootstrap
+  -- Handling packets
+  nonceRef <- newTVarIO 0
+  replyMap <- newTVarIO IM.empty
+  eventQueue <- newTChanIO
+  
+  let catchMe m = try m >>= \ (_ :: Either SomeException ()) -> return ()
+  _ <- forkIO $ catchMe $ forever $ do
+    d <- WS.receiveData conn
+    case decode' d of
+      Just (Result _ []) -> return ()
+      Just (Result n replies) -> atomically
+                      $ modifyTVar replyMap
+                      $ IM.insert n
+                      $ Right
+                      $ replies
+      Just (Error n obj) -> atomically
+                      $ modifyTVar replyMap
+                      $ IM.insert n
+                      $ Left
+                      $ obj
+      Just (Event event) -> do
+        utc <- getCurrentTime
+        atomically $ writeTChan eventQueue (event,utc)
+        
+      Nothing -> print ("bad (non JSON) reply from JavaScript"::String,d)
+
+  kE $ Engine
+     { sendJavaScript = \ (JavaScript js) -> WS.sendTextData conn js
+     , genNonce = atomically $ do
+         n <- readTVar nonceRef
+         writeTVar nonceRef $ succ n
+         return n
+     , replyBox = \ n -> atomically $ do
+         t <- readTVar replyMap
+         case IM.lookup n t of
+           Nothing -> retry
+           Just v -> return v
+     , eventChan = readTChan eventQueue
+     }
+
+-- | An 'Engine' is a handle to a specific JavaScript engine
+data Engine = Engine
+  { sendJavaScript :: JavaScript -> IO ()      -- send text to the JS engine
+  , genNonce       ::               IO Int     -- nonce generator
+  , replyBox       :: Int        -> IO (Either Value [Value]) -- reply mailbox
+  , eventChan      ::               STM (Value, UTCTime)
+  }
+
+bootstrap :: LT.Text
+bootstrap = LT.unlines
+   [     "jsb.event =  function(ev) {"
+   ,     "         if (jsb.debug) { console.log('event',{event: ev}); }"
+   ,     "         jsb.ws.send(JSON.stringify({event: ev}));"
+   ,     "   };"
+   ,     "jsb.error = function(n,err) {"
+   ,     "         if (jsb.debug) { console.log('send',{id: n, error: err}); }"
+   ,     "         jsb.ws.send(JSON.stringify({id: n, error: err}));"
+   ,     "         throw(err);"
+   ,     "   };"   
+   ,     "jsb.reply = function(n,obj) {"
+   ,     "       Promise.all(obj).then(function(obj){"
+   ,     "         if (jsb.debug) { console.log('reply',{id:n, result:obj}); }"   
+   ,     "         jsb.ws.send(JSON.stringify({id: n, result: obj}));"
+   ,     "       }).catch(function(err){"
+   ,     "         jsb.error(n,err);"
+   ,     "       });"
+   ,     "   };"
+   ,     "jsb.ws.onmessage = function(evt){ "
+   ,     "   if (jsb.debug) { console.log('eval',evt.data); }"
+   ,     "   eval('(function(){' + evt.data + '})()');"
+   ,     "};"
+   ,     "jsb.rs = [];"
+   ]
+
+--
+-- | Add a listener for events. There can be many. non-blocking.
+--
+--   From JavaScript, you can call event(..) to send
+--   values to this listener. Any valid JSON value can be sent.
+addListener :: Engine -> (Value -> IO ()) -> IO ThreadId
+addListener e k = forkIO $ forever $ listen e >>= k
+
+-- | 'listen' for the next event. blocking.
+--
+--   From JavaScript, you can call event(..) to send
+--   values to this listener. Any valid JSON value can be sent.
+--
+--
+listen :: Engine -> IO Value
+listen e = atomically $ fst <$> readEventChan e
+
+-- | 'readEventChan' uses STM to read the next event.
+--
+--   From JavaScript, you can call event(..) to send
+--   values to this channel. Any valid JSON value can be sent.
+--
+--
+readEventChan :: Engine -> STM (Value, UTCTime)
+readEventChan = eventChan
+
+------------------------------------------------------------------------------
+
+-- This is what we send back from JavaScript.
+data Reply = Result Int [Value]
+           | Error Int Value
+           | Event Value
+  deriving Show
+
+instance FromJSON Reply where
+  parseJSON o =  parseEvent o
+             <|> parseResult o
+             <|> parseError o
+    where
+      parseEvent = withObject "Event" $ \v -> Event
+        <$> v .: "event"
+      parseResult = withObject "Result" $ \v -> Result
+        <$> v .: "id"
+        <*> v .: "result"
+      parseError = withObject "Error" $ \v -> Error
+        <$> v .: "id"
+        <*> v .: "error"
+
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,282 @@
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GADTs #-}
+import Control.Applicative
+import Control.Concurrent
+import Control.Concurrent.STM
+import qualified Control.Exception as E
+import Control.Monad (forever, foldM, void)
+import Data.Aeson
+import Data.Monoid((<>))
+import qualified Data.Text.Lazy as T
+import Network.JavaScript as JS
+import Network.Wai.Middleware.RequestLogger
+import System.Exit
+import Web.Scotty hiding (delete, function)
+import Data.Time.Clock
+
+main = main_ 3000
+
+main_ :: Int -> IO ()
+main_ i = do
+        lock <- newEmptyMVar
+
+        void $ forkIO $ scotty i $ do
+--          middleware $ logStdout
+          
+          middleware $ start $ \ e -> example e `E.finally`
+                       (do putMVar lock ()
+                           putStrLn "Finished example")
+
+
+          get "/" $ do
+            html $ mconcat $
+               [
+                 "<!doctype html>"
+               , "<html lang=\"en\">"
+               , "<head>"
+               , "<!-- Required meta tags -->"
+               , "<meta charset=\"utf-8\">"
+               , "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1, shrink-to-fit=no\">"
+               , "<!-- Bootstrap CSS -->"
+               , "<link rel=\"stylesheet\" href=\"https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css\" integrity=\"sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO\" crossorigin=\"anonymous\">"
+
+               , "<title>JavaScript Bridge Tests</title>"
+               , "</head>"
+               , "<body>"
+               , " <div class=\"container\">"
+               ,   "<h3>JavaScript Bridge Tests</h3>"
+               , "  <div class=\"row\">"
+               , "    <div class=\"col-3\"><p class=\"font-weight-bold\">Groups</p></div>"
+               , "    <div class=\"col-5\"><p class=\"font-weight-bold\">Tests</p></div>"
+               , "    <div class=\"col-2\"><p class=\"text-center font-weight-bold\">Applicative</p></div>"
+               , "    <div class=\"col-2\"><p class=\"text-center font-weight-bold\">Monad</p></div>"
+               , "  </div>"
+               , T.pack (table tests)
+               , "</div>"
+               ,   "<script>"
+               ,     "window.jsb = {ws: new WebSocket('ws://' + location.host)};"
+               ,     "jsb.ws.onmessage = (evt) => eval(evt.data);"
+                    -- remote object to allow interesting commands and procedures
+               ,     "var remote = [];"
+               ,     "var stepme = function(dom,s) {"
+               ,     "   var start = null;"
+               ,     "   function step(timestamp) {"
+               ,     "      if (!start) start = timestamp;"
+               ,     "      if (dom.classList.contains('bg-success') || dom.classList.contains('bg-danger')) return;"
+               ,     "      var progress = parseInt((timestamp - start) * 100 / (1000 * s));"
+               ,     "      dom.style.width='' + progress + '%';"
+               ,     "      dom.innerHTML='' + progress + '%';"
+               ,     "      if (progress < 100) {"
+               ,     "        window.requestAnimationFrame(step);"
+               ,     "      } else {"               
+               ,     "       dom.classList.add('bg-danger');"
+               ,     "      }"
+               ,     "    }"
+               ,     "    requestAnimationFrame(step);"
+               ,     "};"
+               ,   "</script>"
+               , "</body>"
+               , "</html>"
+               ]
+
+        takeMVar lock
+
+data Test
+ = TestA String (forall f . (Command f, Procedure f, Applicative f) => API f -> IO (Maybe String))
+ | TestM String (forall f . (Command f, Procedure f, Monad f)       => API f -> IO (Maybe String))
+
+data Tests = Tests String [Test]
+
+data API f = API
+ { send :: forall a . f a -> IO a
+ , recv :: IO (Result Value)
+ , progressBar :: RemoteValue DOM
+ }
+
+data DOM
+
+------------------------------------------------------------------------------
+
+tests :: [Tests]
+tests =
+  [ Tests "Commands"
+    [ TestA "command" $ \ API{..} -> send (command "1") >> pure Nothing
+    ]
+  , Tests "Procedures"
+    [ TestA "procedure 1 + 1" $ \ API{..} -> do
+        v :: Int <- send (procedure "1+1")
+        assert v (2 :: Int)
+    , TestA "procedure 'Hello'" $ \ API{..} -> do
+        v :: String <- send (procedure "'Hello'")
+        assert v ("Hello" :: String)
+    , TestA "procedure [true,false]" $ \ API{..} -> do
+        v :: [Bool] <- send (procedure "[true,false]")
+        assert v [True,False]
+    ]
+  , Tests "Combine Commands / Procedure"
+    [ TestA "command [] + push" $ \ API{..} -> do
+        send (command "local = []" *> command "local.push(99)")        
+        v :: [Int] <- send (procedure "local")
+        assert v [99]
+    , TestA "command [] + push + procedure" $ \ API{..} -> do
+        v :: [Int] <- send (command "local = []" *> command "local.push(99)" *> procedure "local")
+        assert v [99]
+    , TestA "procedure + procedure" $ \ API{..} -> do
+        v :: (Int,Bool) <- send (liftA2 (,)
+                                            (procedure "99")
+                                            (procedure "false"))
+        assert v (99,False)
+    ]    
+  , Tests "Promises"
+    [ TestA "promises" $ \ API{..} -> do
+        v :: (String,String) <- send $ liftA2 (,)
+                 (procedure "new Promise(function(good,bad) { good('Hello') })")
+                 (procedure "new Promise(function(good,bad) { good('World') })")
+        assert v ("Hello","World")
+    , TestA "promise + procedure" $ \ API{..} -> do
+        v :: (String,String) <- send $ liftA2 (,)
+                 (procedure "new Promise(function(good,bad) { good('Hello') })")
+                 (procedure "'World'")
+        assert v ("Hello","World")
+    , TestA "good and bad promises" $ \ API{..} -> do
+        v :: Either JavaScriptException ((String,String,String)) <- E.try $ send $ liftA3 (,,)
+                 (procedure "new Promise(function(good,bad) { good('Hello') })")
+                 (procedure "new Promise(function(good,bad) { bad('Promise Reject') })")
+                 (procedure "new Promise(function(good,bad) { good('News') })")
+        assert v (Left $ JavaScriptException $ String "Promise Reject")        
+    ]
+  , Tests "Constructors"
+    [ TestA "constructor" $ \ API{..} -> do
+        rv :: RemoteValue () <- send $ constructor "'Hello'"
+        v1 :: String <- send $ procedure (var rv)
+        send $ delete rv        
+        v2 :: Value <- send $ procedure (var rv)
+        assert (v1,v2) ("Hello",Null)
+    ]
+  , Tests "Exceptions"
+    [ TestA "command throw" $ \ API{..} -> do
+        send $ command $ "throw 'Command Fail';"
+        assert () ()
+    , TestA "procedure throw" $ \ API{..} -> do
+        v :: Either JavaScriptException Value <- E.try $ send $ procedure $ "(function(){throw 'Command Fail';})()"
+        assert v (Left $ JavaScriptException $ String "Command Fail")
+    ]
+  , Tests "Events"
+    [ TestA "event" $ \ API{..} -> do
+        send $ command $ event ("Hello, World" :: String)
+        event <- recv
+        assert event (Success $ toJSON ("Hello, World" :: String))
+    ]
+  , Tests "Remote Monad"
+    [ TestM "remote monad procedure chain" $ \ API{..} -> do
+        vs :: Value <- 
+          (send $ foldM (\ (r :: Value) (i :: Int) -> procedure $ value r <> "+" <> value i)
+                           (toJSON (0 :: Int))
+                           [0..100])
+        assert vs (toJSON $ sum [0..100::Int])
+    , TestM "remote monad constructor chain" $ \ API{..} -> do
+        rv <- send $ constructor "0"
+        rv :: RemoteValue () <- 
+          (send $ foldM (\ (r :: RemoteValue ()) (i :: Int) -> constructor $ value r <> "+" <> value i)
+                           rv
+                           [0..100])
+        v :: Int <- (send $ procedure $ value rv)
+        assert v (sum [0..100])
+    ]
+  , Tests "Alive Connection" $
+    [ TestM "before wait" $ \ API{..} -> do
+        assert () ()
+    ] ++ [ TestM ("after wait for " ++ show w) $ \ API{..} -> do
+        send $ command $ "stepme(" <> var progressBar <> "," <> value (fromIntegral w * 1.2 :: Float) <> ")"
+        _ <- threadDelay $ w * 1000 * 1000
+        assert () ()
+        | w <- [3,10,80]
+        ]
+  ]
+
+------------------------------------------------------------------------------
+
+assert :: (Eq a, Show a) => a -> a -> IO (Maybe String)
+assert n g
+  | n == g    = return $ Nothing
+  | otherwise = return $ Just $ show ("assert failure",n,g)
+
+table :: [Tests] -> String
+table ts = go0 [] ts 
+  where
+    go0 p ts = concatMap (\ (t,n) -> go1 (n:p) t) (zip ts [0..])
+
+    go1 p (Tests txt ts) = unlines
+      [ "<div class=\"row\">" ++
+        "<div class=\"col-3\">" ++
+         pre ++
+        "</div>" ++
+        "<div class=\"col-5\">" ++
+        tst ++
+        "</div>" ++
+        "<div class=\"col-2\">" ++
+        mon ++
+        "</div>" ++
+        "<div class=\"col-2\">" ++
+        app ++
+        "</div>" ++        
+        "</div>"
+      | (t,n) <- ts `zip` [0..]
+      , let pre | n == 0 = txt
+                | otherwise = ""
+      , let (tst,mon,app) = go (n:p) t
+      ]
+
+    go p (TestA txt _) = (txt,bar p "a",bar p "m")
+    go p (TestM txt _) = (txt,"",bar p "m")
+
+    bar p a = "<div class=\"progress\"><div id=\"" ++ tag p ++ "-" ++ a ++ "\" class=\"progress-bar\" role=\"progressbar\" style=\"width: 0%;\"></div></div>"
+
+tag :: [Int] -> String
+tag p = "tag" ++ concatMap (\ a -> '-' : show a) p
+
+runTest :: Engine -> [Int] -> Test -> IO ()
+runTest e p (TestA txt k) = do
+  recv <- doRecv e
+  mBar <- JS.send e $ constructor $ JavaScript $ "document.getElementById('" <> T.pack (tag p ++ "-m") <> "')"
+  aBar <- JS.send e $ constructor $ JavaScript $ "document.getElementById('" <> T.pack (tag p ++ "-a") <> "')"
+  doTest (API (JS.send e) recv mBar)  "-m" p k
+  doTest (API (JS.sendA e) recv aBar) "-a" p k
+runTest e p (TestM txt k) = do
+  recv <- doRecv e
+  mBar <- JS.send e $ constructor $ JavaScript $ "document.getElementById('" <> T.pack (tag p ++ "-m") <> "')"
+  doTest (API (JS.send e) recv mBar)  "-m" p k
+
+doRecv :: Engine -> IO (IO (Result Value))
+doRecv e = do
+  return $ do
+        wait <- registerDelay $ 1000 * 1000
+        atomically $ (pure . fst <$> readEventChan e)
+                     `orElse` (do b <- readTVar wait ; check b ; return $ Error "timeout!")        
+
+doTest :: (Applicative f, Command f) => API f -> String -> [Int] -> (API f -> IO (Maybe String)) -> IO ()
+doTest api@API{..} suff p k = do
+  tm0 <- getCurrentTime
+  rM <- k api
+  tm1 <- getCurrentTime
+  let tm = show (diffUTCTime tm1 tm0)
+  case rM of
+    Nothing -> do
+      send $
+       (command $ var progressBar <> ".style.width='100%'") *>
+       (command $ var progressBar <> ".classList.add('bg-success')") *>
+       (command $ var progressBar <> ".innerHTML=" <> value tm)       
+    Just msg -> do
+      print ("doTest failed"::String,msg)
+      send $
+       (command $ var progressBar <> ".style.width='100%'") *>
+       (command $ var progressBar <> ".classList.add('bg-danger')") *>
+       (command $ var progressBar <> ".innerHTML=" <> value tm)       
+       
+runTests :: Engine -> [Int] -> [Tests] -> IO ()
+runTests e p ts = sequence_ [ runTest e (m:n:p) t | (Tests _ ts,n) <- ts `zip` [0..], (t,m) <- ts `zip` [0..] ]
+
+example :: Engine -> IO ()
+example e = runTests e  [] tests