diff --git a/CHANGELOG b/CHANGELOG
new file mode 100644
--- /dev/null
+++ b/CHANGELOG
@@ -0,0 +1,25 @@
+HsQML - Release History
+
+release-0.2.0.0 - 2013.10.08
+
+  * Added support for firing QML signals.
+  * Added dynamic object references.
+  * Added MacOS support.
+  * Added QuickCheck-based test suite.
+  * Added envionment variable to control logging.
+  * New design for marshalling type-classes.
+  * New API for Engine management.
+  * Relexed Cabal dependency constraints.
+  * Fixed linking problem on some Linux systems.
+  * Fixed support for non-threaded RTS.
+  * Fixed various object lifetime issues.
+  * Fixed crash in property marshaller.
+  * Fixed crash in logging code.
+
+release-0.1.1 - 2012.09.11
+
+  * Fix running test suite on Windows.
+
+release-0.1.0 - 2012.09.10
+
+  * Initial release.
diff --git a/cbits/HsQMLClass.cpp b/cbits/HsQMLClass.cpp
--- a/cbits/HsQMLClass.cpp
+++ b/cbits/HsQMLClass.cpp
@@ -1,35 +1,47 @@
 #include <cstdlib>
 #include <HsFFI.h>
-#include <QAtomicInt>
-#include <QMetaObject>
-#include <QString>
-#include <QDebug>
+#include <QtCore/QMetaObject>
+#include <QtCore/QMetaType>
+#include <QtCore/QString>
 
 #include "hsqml.h"
 #include "HsQMLClass.h"
 #include "HsQMLManager.h"
 
-QAtomicInt gClassId;
+enum MDFields {
+    MD_METHOD_COUNT   = 4,
+    MD_PROPERTY_COUNT = 6,
+};
 
+static const char* cRefSrcNames[] = {"Hndl", "Proxy"};
+
 HsQMLClass::HsQMLClass(
     unsigned int*  metaData,
     char*          metaStrData,
+    HsStablePtr    hsTypeRep,
     HsQMLUniformFunc* methods,
     HsQMLUniformFunc* properties)
     : mRefCount(0)
     , mMetaData(metaData)
     , mMetaStrData(metaStrData)
-    , mMethods(methods)
-    , mProperties(properties)
+    , mHsTypeRep(hsTypeRep)
     , mMethodCount(metaData[MD_METHOD_COUNT])
     , mPropertyCount(metaData[MD_PROPERTY_COUNT])
-    , mMetaObject(QMetaObject {{
+    , mMethods(methods)
+    , mProperties(properties)
+{
+    // Create meta-object
+    QMetaObject tmp = {
           &QObject::staticMetaObject,
           mMetaStrData,
           mMetaData,
-          0}})
-{
+          0};
+    mMetaObject = new QMetaObject(tmp);
+
+    // Add reference
     ref(Handle);
+
+    gManager->updateCounter(HsQMLManager::ClassCount, 1);
 }
 
 HsQMLClass::~HsQMLClass()
@@ -42,17 +54,36 @@
             gManager->freeFun((HsFunPtr)mProperties[i]);
         }
     }
+    gManager->freeStable(mHsTypeRep);
     std::free(mMetaData);
     std::free(mMetaStrData);
     std::free(mMethods);
     std::free(mProperties);
+    delete mMetaObject;
+
+    gManager->updateCounter(HsQMLManager::ClassCount, -1);
 }
 
 const char* HsQMLClass::name()
 {
-    return mMetaObject.className();
+    return mMetaObject->className();
 } 
 
+HsStablePtr HsQMLClass::hsTypeRep()
+{
+    return mHsTypeRep;
+}
+
+int HsQMLClass::methodCount()
+{
+    return mMethodCount;
+}
+
+int HsQMLClass::propertyCount()
+{
+    return mPropertyCount;
+}
+
 const HsQMLUniformFunc* HsQMLClass::methods()
 {
     return mMethods;
@@ -63,26 +94,27 @@
     return mProperties;
 }
 
+const QMetaObject* HsQMLClass::metaObj()
+{
+    return mMetaObject;
+}
+
 void HsQMLClass::ref(RefSrc src)
 {
     int count = mRefCount.fetchAndAddOrdered(1);
 
-    if (gLogLevel >= (count == 0 ? 1 : 2)) {
-        qDebug() << QString().sprintf(
-            "HsQML: %s Class, name=%s, src=%d, count=%d.",
-            count ? "Ref" : "New", name(), src, count+1);
-    }
+    HSQML_LOG(count == 0 ? 1 : 2,
+        QString().sprintf("%s Class, name=%s, src=%s, count=%d.",
+        count ? "Ref" : "New", name(), cRefSrcNames[src], count+1));
 }
 
 void HsQMLClass::deref(RefSrc src)
 {
     int count = mRefCount.fetchAndAddOrdered(-1);
 
-    if (gLogLevel >= (count == 1 ? 1 : 2)) {
-        qDebug() << QString().sprintf(
-            "HsQML: %s Class, name=%s, src=%d, count=%d.",
-            count > 1 ? "Deref" : "Delete", name(), src, count);
-    }
+    HSQML_LOG(count == 1 ? 1 : 2,
+        QString().sprintf("%s Class, name=%s, src=%s, count=%d.",
+        count > 1 ? "Deref" : "Delete", name(), cRefSrcNames[src], count));
 
     if (count == 1) {
         delete this;
@@ -91,17 +123,18 @@
 
 extern "C" int hsqml_get_next_class_id()
 {
-    return gClassId.fetchAndAddRelaxed(1);
+    return gManager->updateCounter(HsQMLManager::ClassSerial, 1);
 }
 
 extern "C" HsQMLClassHandle* hsqml_create_class(
     unsigned int*  metaData,
     char*          metaStrData,
+    HsStablePtr    hsTypeRep,
     HsQMLUniformFunc* methods,
     HsQMLUniformFunc* properties)
 {
     HsQMLClass* klass = new HsQMLClass(
-            metaData, metaStrData, methods, properties);
+            metaData, metaStrData, hsTypeRep, methods, properties);
     return (HsQMLClassHandle*)klass;
 }
 
diff --git a/cbits/HsQMLClass.h b/cbits/HsQMLClass.h
--- a/cbits/HsQMLClass.h
+++ b/cbits/HsQMLClass.h
@@ -1,26 +1,25 @@
 #ifndef HSQML_CLASS_H
 #define HSQML_CLASS_H
 
-#include <QObject>
-#include <QAtomicInt>
+#include <QtCore/QObject>
+#include <QtCore/QAtomicInt>
 
 #include "hsqml.h"
 
-enum MDFields {
-    MD_CLASS_NAME     = 1,
-    MD_METHOD_COUNT   = 4,
-    MD_PROPERTY_COUNT = 6,
-};
-
 class HsQMLClass
 {
 public:
     HsQMLClass(
-        unsigned int*, char*, HsQMLUniformFunc*, HsQMLUniformFunc*);
+        unsigned int*, char*, HsStablePtr,
+        HsQMLUniformFunc*, HsQMLUniformFunc*);
     ~HsQMLClass();
     const char* name();
+    HsStablePtr hsTypeRep();
+    int methodCount();
+    int propertyCount();
     const HsQMLUniformFunc* methods();
     const HsQMLUniformFunc* properties();
+    const QMetaObject* metaObj();
     enum RefSrc {Handle, ObjProxy};
     void ref(RefSrc);
     void deref(RefSrc);
@@ -29,13 +28,12 @@
     QAtomicInt mRefCount;
     unsigned int* mMetaData;
     char* mMetaStrData;
+    HsStablePtr mHsTypeRep;
+    int mMethodCount;
+    int mPropertyCount;
     HsQMLUniformFunc* mMethods;
     HsQMLUniformFunc* mProperties;
-
-public:
-    const int mMethodCount;
-    const int mPropertyCount;
-    const QMetaObject mMetaObject;
+    QMetaObject* mMetaObject;
 };
 
 #endif /*HSQML_CLASS_H*/
diff --git a/cbits/HsQMLEngine.cpp b/cbits/HsQMLEngine.cpp
--- a/cbits/HsQMLEngine.cpp
+++ b/cbits/HsQMLEngine.cpp
@@ -1,43 +1,84 @@
-#include "hsqml.h"
 #include "HsQMLManager.h"
 #include "HsQMLEngine.h"
 #include "HsQMLObject.h"
 #include "HsQMLWindow.h"
 
-HsQMLEngine::HsQMLEngine(HsQMLEngineConfig& config)
+HsQMLScriptHack::HsQMLScriptHack(QDeclarativeEngine* declEng)
+    : mEngine(NULL)
 {
+    QDeclarativeEngine::setObjectOwnership(
+        this, QDeclarativeEngine::CppOwnership);
+    QDeclarativeExpression expr(declEng->rootContext(), this, "hack(self());");
+    expr.evaluate();
+    Q_ASSERT(!expr.hasError());
+}
+
+QObject* HsQMLScriptHack::self()
+{
+    return this;
+}
+
+void HsQMLScriptHack::hack(QScriptValue value)
+{
+    mEngine = value.engine();
+}
+
+QScriptEngine* HsQMLScriptHack::scriptEngine() const
+{
+    return mEngine;
+}
+
+HsQMLEngine::HsQMLEngine(const HsQMLEngineConfig& config)
+    : mScriptEngine(HsQMLScriptHack(&mDeclEngine).scriptEngine())
+    , mStopCb(config.stopCb)
+{
     // Obtain, re-parent, and set QML global object
     if (config.contextObject) {
-        QObject* contextObject = config.contextObject->object();
-        contextObject->setParent(this);
-        mEngine.rootContext()->setContextObject(contextObject);
+        mContextObj.reset(config.contextObject->object(this));
+        mDeclEngine.rootContext()->setContextObject(mContextObj.data());
     }
 
     // Create window
     HsQMLWindow* win = new HsQMLWindow(this);
+    win->setParent(this);
     win->setSource(config.initialURL);
     win->setVisible(config.showWindow);
     if (config.setWindowTitle) {
         win->setTitle(config.windowTitle);
     }
-    mWindows.insert(win);
 }
 
 HsQMLEngine::~HsQMLEngine()
 {
+    // Call stop callback
+    mStopCb();
+    gManager->freeFun(reinterpret_cast<HsFunPtr>(mStopCb));
 }
 
-QDeclarativeEngine* HsQMLEngine::engine()
+void HsQMLEngine::childEvent(QChildEvent* ev)
 {
-    return &mEngine;
+    if (ev->removed() && children().size() == 0) {
+        deleteLater();
+    }
 }
 
+QDeclarativeEngine* HsQMLEngine::declEngine()
+{
+    return &mDeclEngine;
+}
+
+QScriptEngine* HsQMLEngine::scriptEngine()
+{
+    return mScriptEngine;
+}
+
 extern "C" void hsqml_create_engine(
     HsQMLObjectHandle* contextObject,
     HsQMLUrlHandle* initialURL,
     int showWindow,
     int setWindowTitle,
-    HsQMLStringHandle* windowTitle)
+    HsQMLStringHandle* windowTitle,
+    HsQMLTrivialCb stopCb)
 {
     HsQMLEngineConfig config;
     config.contextObject = reinterpret_cast<HsQMLObjectProxy*>(contextObject);
@@ -47,9 +88,8 @@
         config.setWindowTitle = true;
         config.windowTitle = *reinterpret_cast<QString*>(windowTitle);
     }
+    config.stopCb = stopCb;
 
     Q_ASSERT (gManager);
-    QMetaObject::invokeMethod(
-        gManager, "createEngine", Qt::QueuedConnection,
-        Q_ARG(HsQMLEngineConfig, config));
+    gManager->createEngine(config);
 }
diff --git a/cbits/HsQMLEngine.h b/cbits/HsQMLEngine.h
--- a/cbits/HsQMLEngine.h
+++ b/cbits/HsQMLEngine.h
@@ -1,11 +1,16 @@
 #ifndef HSQML_ENGINE_H
 #define HSQML_ENGINE_H
 
-#include <QSet>
-#include <QString>
-#include <QUrl>
-#include <QDeclarativeEngine>
+#include <QtCore/QScopedPointer>
+#include <QtCore/QString>
+#include <QtCore/QUrl>
+#include <QtScript/QScriptEngine>
+#include <QtScript/QScriptValue>
+#include <QtDeclarative/QDeclarativeEngine>
+#include <QtDeclarative/QDeclarativeExpression>
 
+#include "hsqml.h"
+
 class HsQMLObjectProxy;
 class HsQMLWindow;
 
@@ -15,6 +20,7 @@
         : contextObject(NULL)
         , showWindow(false)
         , setWindowTitle(false)
+        , stopCb(NULL)
     {}
 
     HsQMLObjectProxy* contextObject;
@@ -22,20 +28,41 @@
     bool showWindow;
     bool setWindowTitle;
     QString windowTitle;
+    HsQMLTrivialCb stopCb;
 };
 
+class HsQMLScriptHack : public QObject
+{
+    Q_OBJECT
+
+public:
+    HsQMLScriptHack(QDeclarativeEngine*);
+    Q_INVOKABLE virtual QObject* self();
+    Q_INVOKABLE virtual void hack(QScriptValue);
+    QScriptEngine* scriptEngine() const;
+
+private:
+    QScriptEngine* mEngine;
+};
+
 class HsQMLEngine : public QObject
 {
     Q_OBJECT
 
 public:
-    HsQMLEngine(HsQMLEngineConfig&);
+    HsQMLEngine(const HsQMLEngineConfig&);
     ~HsQMLEngine();
-    QDeclarativeEngine* engine();
+    virtual void childEvent(QChildEvent*);
+    QDeclarativeEngine* declEngine();
+    QScriptEngine* scriptEngine();
 
 private:
-    QDeclarativeEngine mEngine;
-    QSet<HsQMLWindow*> mWindows;
+    Q_DISABLE_COPY(HsQMLEngine)
+
+    QDeclarativeEngine mDeclEngine;
+    QScriptEngine* mScriptEngine;
+    QScopedPointer<QObject> mContextObj;
+    HsQMLTrivialCb mStopCb;
 };
 
 #endif /*HSQML_ENGINE_H*/
diff --git a/cbits/HsQMLIntrinsics.cpp b/cbits/HsQMLIntrinsics.cpp
--- a/cbits/HsQMLIntrinsics.cpp
+++ b/cbits/HsQMLIntrinsics.cpp
@@ -1,8 +1,8 @@
 #include <cstdlib>
 #include <cstring>
 
-#include <QString>
-#include <QUrl>
+#include <QtCore/QString>
+#include <QtCore/QUrl>
 
 #include "hsqml.h"
 
diff --git a/cbits/HsQMLManager.cpp b/cbits/HsQMLManager.cpp
--- a/cbits/HsQMLManager.cpp
+++ b/cbits/HsQMLManager.cpp
@@ -1,38 +1,87 @@
-#include <QMetaType>
+#include <iostream>
+#include <cstdlib>
+#include <QtCore/QBasicTimer>
+#include <QtCore/QMetaType>
+#include <QtCore/QMutexLocker>
+#include <QtCore/QThread>
 
 #include "HsQMLManager.h"
+#include "HsQMLObject.h"
 
-QMutex gMutex;
-HsQMLManager* gManager;
-int gLogLevel;
+static const char* cCounterNames[] = {
+    "ClassCounter",
+    "ObjectCounter",
+    "QObjectCounter",
+    "ClassSerial",
+    "ObjectSerial"
+};
 
+extern "C" void hsqml_dump_counters()
+{
+    Q_ASSERT (gManager);
+    if (gManager->checkLogLevel(1)) {
+        for (int i=0; i<HsQMLManager::TotalCounters; i++) {
+            gManager->log(QString().sprintf("%s = %d.",
+                cCounterNames[i], gManager->updateCounter(
+                    static_cast<HsQMLManager::CounterId>(i), 0)));
+        }
+    }
+}
+
+QAtomicPointer<HsQMLManager> gManager;
+
 HsQMLManager::HsQMLManager(
-    int& argc,
-    char** argv,
     void (*freeFun)(HsFunPtr),
     void (*freeStable)(HsStablePtr))
-    : mApp(argc, argv)
+    : mLogLevel(0)
+    , mAtExit(false)
     , mFreeFun(freeFun)
     , mFreeStable(freeStable)
+    , mApp(NULL)
+    , mLock(QMutex::Recursive)
+    , mRunning(false)
+    , mRunCount(0)
+    , mStartCb(NULL)
+    , mJobsCb(NULL)
+    , mYieldCb(NULL)
+    , mActiveEngine(NULL)
 {
+    qRegisterMetaType<HsQMLEngineConfig>("HsQMLEngineConfig");
+
+    const char* env = std::getenv("HSQML_DEBUG_LOG_LEVEL");
+    if (env) {
+        setLogLevel(QString(env).toInt());
+    }
 }
 
-HsQMLManager::~HsQMLManager()
+void HsQMLManager::setLogLevel(int ll)
 {
+    mLogLevel = ll;
+    if (ll > 0 && !mAtExit) {
+        if (atexit(&hsqml_dump_counters) == 0) {
+            mAtExit = true;
+        }
+        else {
+            log("Failed to register callback with atexit().");
+        }
+    }
 }
 
-void HsQMLManager::run()
+bool HsQMLManager::checkLogLevel(int ll)
 {
-    mApp.exec();
+    return mLogLevel >= ll;
+}
 
-    // Delete engines once the event loop returns
-    for (QVector<HsQMLEngine*>::iterator it = mEngines.begin();
-            it != mEngines.end(); ++it) {
-        delete *it;
-    }
-    mEngines.clear();
+void HsQMLManager::log(const QString& msg)
+{
+    std::cerr << "HsQML: " << msg.toStdString() << std::endl;
 }
 
+int HsQMLManager::updateCounter(CounterId id, int delta)
+{
+    return mCounters[id].fetchAndAddRelaxed(delta);
+}
+
 void HsQMLManager::freeFun(HsFunPtr funPtr)
 {
     mFreeFun(funPtr);
@@ -43,36 +92,223 @@
     mFreeStable(stablePtr);
 }
 
-void HsQMLManager::createEngine(HsQMLEngineConfig config)
+bool HsQMLManager::isEventThread()
 {
-    mEngines.push_back(new HsQMLEngine(config));
+    return mApp && mApp->thread() == QThread::currentThread();
 }
 
-extern "C" void hsqml_init(
-    void (*free_fun)(HsFunPtr),
-    void (*free_stable)(HsStablePtr))
+HsQMLManager::EventLoopStatus HsQMLManager::runEventLoop(
+    HsQMLTrivialCb startCb,
+    HsQMLTrivialCb jobsCb,
+    HsQMLTrivialCb yieldCb)
 {
-    gMutex.lock();
-    if (!gManager) {
-        qRegisterMetaType<HsQMLEngineConfig>("HsQMLEngineConfig");
+    QMutexLocker locker(&mLock);
 
-        int* argcp = new int[1];
-        *argcp = 1;
-        char** argv = new char*[1];
-        argv[0] = new char[1];
-        argv[0][0] = '\0';
-        gManager = new HsQMLManager(*argcp, argv, free_fun, free_stable);
+    // Check if already running
+    if (mRunning) {
+        return HSQML_EVLOOP_ALREADY_RUNNING;
     }
-    gMutex.unlock();
+
+    // Check if event loop bound to a different thread
+    if (mApp && !isEventThread()) {
+        return HSQML_EVLOOP_WRONG_THREAD;
+    }
+
+    // Create application object
+    if (!mApp) {
+        mApp = new HsQMLManagerApp();
+    }
+
+    // Save callbacks
+    mStartCb = startCb;
+    mJobsCb = jobsCb;
+    mYieldCb = yieldCb;
+
+    // Setup events
+    QCoreApplication::postEvent(
+        mApp, new QEvent(HsQMLManagerApp::StartedLoopEvent),
+        Qt::HighEventPriority);
+    QBasicTimer idleTimer;
+    if (yieldCb) {
+        idleTimer.start(0, mApp);
+    }
+
+    // Run loop
+    int ret = mApp->exec();
+
+    // Remove redundant events
+    QCoreApplication::removePostedEvents(
+        mApp, HsQMLManagerApp::RemoveGCLockEvent);
+
+    // Cleanup callbacks
+    freeFun(startCb);
+    mStartCb = NULL;
+    freeFun(jobsCb);
+    mJobsCb = NULL;
+    if (yieldCb) {
+        freeFun(yieldCb);
+        mYieldCb = NULL;
+    }
+
+    // Return
+    if (ret == 0) {
+        return HSQML_EVLOOP_OK;
+    }
+    else {
+        QCoreApplication::removePostedEvents(
+            mApp, HsQMLManagerApp::StartedLoopEvent);
+        return HSQML_EVLOOP_OTHER_ERROR;
+    }
 }
 
-extern "C" void hsqml_run()
+HsQMLManager::EventLoopStatus HsQMLManager::requireEventLoop()
 {
-    Q_ASSERT (gManager);
-    gManager->run();
+    QMutexLocker locker(&mLock);
+    if (mRunCount > 0) {
+        mRunCount++;
+        return HSQML_EVLOOP_OK;
+    }
+    else {
+        return HSQML_EVLOOP_NOT_RUNNING;
+    }
 }
 
-extern "C" void hsqml_set_debug_loglevel(int level)
+void HsQMLManager::releaseEventLoop()
 {
-    gLogLevel = level;
+    QMutexLocker locker(&mLock);
+    if (--mRunCount == 0) {
+        QCoreApplication::postEvent(
+            mApp, new QEvent(HsQMLManagerApp::StopLoopEvent),
+            Qt::LowEventPriority);
+    }
+}
+
+void HsQMLManager::notifyJobs()
+{
+    QMutexLocker locker(&mLock);
+    if (mRunCount > 0) {
+        QCoreApplication::postEvent(
+            mApp, new QEvent(HsQMLManagerApp::PendingJobsEvent));
+    }
+}
+
+void HsQMLManager::createEngine(const HsQMLEngineConfig& config)
+{
+    Q_ASSERT (mApp);
+    QMetaObject::invokeMethod(
+        mApp, "createEngine", Q_ARG(HsQMLEngineConfig, config));
+}
+
+void HsQMLManager::setActiveEngine(HsQMLEngine* engine)
+{
+    Q_ASSERT(!mActiveEngine || !engine);
+    mActiveEngine = engine;
+}
+
+HsQMLEngine* HsQMLManager::activeEngine()
+{
+    return mActiveEngine;
+}
+
+void HsQMLManager::postObjectEvent(HsQMLObjectEvent* ev)
+{
+    QCoreApplication::postEvent(mApp, ev);
+}
+
+HsQMLManagerApp::HsQMLManagerApp()
+    : mArgC(1)
+    , mArg0(0)
+    , mArgV(&mArg0)
+    , mApp(mArgC, &mArgV)
+{
+    mApp.setQuitOnLastWindowClosed(false);
+}
+
+HsQMLManagerApp::~HsQMLManagerApp()
+{}
+
+void HsQMLManagerApp::customEvent(QEvent* ev)
+{
+    switch (ev->type()) {
+    case HsQMLManagerApp::StartedLoopEvent: {
+        gManager->mRunning = true;
+        gManager->mRunCount++;
+        gManager->mLock.unlock();
+        gManager->mStartCb();
+        gManager->mJobsCb();
+        break;}
+    case HsQMLManagerApp::StopLoopEvent: {
+        gManager->mLock.lock();
+        const QObjectList& cs = gManager->mApp->children();
+        while (!cs.empty()) {
+            delete cs.front();
+        }
+        gManager->mRunning = false;
+        gManager->mApp->mApp.quit();
+        break;}
+    case HsQMLManagerApp::PendingJobsEvent: {
+        gManager->mJobsCb();
+        break;}
+    case HsQMLManagerApp::RemoveGCLockEvent: {
+        static_cast<HsQMLObjectEvent*>(ev)->process();
+        break;}
+    }
+}
+
+void HsQMLManagerApp::timerEvent(QTimerEvent*)
+{
+    Q_ASSERT(gManager->mYieldCb);
+    gManager->mYieldCb();
+}
+
+void HsQMLManagerApp::createEngine(HsQMLEngineConfig config)
+{
+    HsQMLEngine* engine = new HsQMLEngine(config);
+    engine->setParent(this);
+}
+
+int HsQMLManagerApp::exec()
+{
+    return mApp.exec();
+}
+
+extern "C" void hsqml_init(
+    void (*freeFun)(HsFunPtr),
+    void (*freeStable)(HsStablePtr))
+{
+    if (gManager == NULL) {
+        HsQMLManager* manager = new HsQMLManager(freeFun, freeStable);
+        if (!gManager.testAndSetOrdered(NULL, manager)) {
+            delete manager;
+        }
+    }
+}
+
+extern "C" HsQMLEventLoopStatus hsqml_evloop_run(
+    HsQMLTrivialCb startCb,
+    HsQMLTrivialCb jobsCb,
+    HsQMLTrivialCb yieldCb)
+{
+    return gManager->runEventLoop(startCb, jobsCb, yieldCb);
+}
+
+extern "C" HsQMLEventLoopStatus hsqml_evloop_require()
+{
+    return gManager->requireEventLoop();
+}
+
+extern "C" void hsqml_evloop_release()
+{
+    gManager->releaseEventLoop();
+}
+
+extern "C" void hsqml_evloop_notify_jobs()
+{
+    gManager->notifyJobs();
+}
+
+extern "C" void hsqml_set_debug_loglevel(int ll)
+{
+    Q_ASSERT (gManager);
+    gManager->setLogLevel(ll);
 }
diff --git a/cbits/HsQMLManager.h b/cbits/HsQMLManager.h
--- a/cbits/HsQMLManager.h
+++ b/cbits/HsQMLManager.h
@@ -1,42 +1,109 @@
 #ifndef HSQML_MANAGER_H
 #define HSQML_MANAGER_H
 
-#include <QApplication>
-#include <QMutex>
-#include <QVector>
-#include <QUrl>
+#include <QtCore/QAtomicPointer>
+#include <QtCore/QAtomicInt>
+#include <QtCore/QMutex>
+#include <QtCore/QString>
+#include <QtGui/QApplication>
 
 #include "hsqml.h"
 #include "HsQMLEngine.h"
 
-class HsQMLManager : public QObject
-{
-    Q_OBJECT
+#define HSQML_LOG(ll, msg) if (gManager->checkLogLevel(ll)) gManager->log(msg)
 
+class HsQMLManagerApp;
+class HsQMLObjectEvent;
+
+class HsQMLManager
+{
 public:
+    enum CounterId {
+        ClassCount,
+        ObjectCount,
+        QObjectCount,
+        ClassSerial,
+        ObjectSerial,
+        TotalCounters
+    }; 
+
     HsQMLManager(
-        int& argc,
-        char** argv,
         void (*)(HsFunPtr),
         void (*)(HsStablePtr));
-    ~HsQMLManager();
-    void run();
+    void setLogLevel(int);
+    bool checkLogLevel(int);
+    void log(const QString&);
+    int updateCounter(CounterId, int);
     void freeFun(HsFunPtr);
     void freeStable(HsStablePtr);
-    Q_SLOT void createEngine(HsQMLEngineConfig);
+    bool isEventThread();
+    typedef HsQMLEventLoopStatus EventLoopStatus;
+    EventLoopStatus runEventLoop(
+        HsQMLTrivialCb, HsQMLTrivialCb, HsQMLTrivialCb);
+    EventLoopStatus requireEventLoop();
+    void releaseEventLoop();
+    void notifyJobs();
+    void createEngine(const HsQMLEngineConfig&);
+    void setActiveEngine(HsQMLEngine*);
+    HsQMLEngine* activeEngine();
+    void postObjectEvent(HsQMLObjectEvent*);
 
 private:
-    HsQMLManager(const HsQMLManager&);
-    HsQMLManager& operator=(const HsQMLManager&);
+    friend class HsQMLManagerApp;
+    Q_DISABLE_COPY(HsQMLManager)
 
-    QApplication mApp;
-    QVector<HsQMLEngine*> mEngines;
+    int mLogLevel;
+    QAtomicInt mCounters[TotalCounters];
+    bool mAtExit;
     void (*mFreeFun)(HsFunPtr);
     void (*mFreeStable)(HsStablePtr);
+    HsQMLManagerApp* mApp;
+    QMutex mLock;
+    bool mRunning;
+    int mRunCount;
+    HsQMLTrivialCb mStartCb;
+    HsQMLTrivialCb mJobsCb;
+    HsQMLTrivialCb mYieldCb;
+    HsQMLEngine* mActiveEngine;
 };
 
-extern QMutex gMutex;
-extern HsQMLManager* gManager;
-extern int gLogLevel;
+class HsQMLManagerApp : public QObject
+{
+    Q_OBJECT
+
+public:
+    HsQMLManagerApp();
+    virtual ~HsQMLManagerApp();
+    virtual void customEvent(QEvent*);
+    virtual void timerEvent(QTimerEvent*);
+    Q_SLOT void createEngine(HsQMLEngineConfig);
+    int exec();
+
+    enum CustomEventIndicies {
+        StartedLoopEventIndex,
+        StopLoopEventIndex,
+        PendingJobsEventIndex,
+        RemoveGCLockEventIndex
+    };
+
+    static const QEvent::Type StartedLoopEvent =
+        static_cast<QEvent::Type>(QEvent::User+StartedLoopEventIndex);
+    static const QEvent::Type StopLoopEvent =
+        static_cast<QEvent::Type>(QEvent::User+StopLoopEventIndex);
+    static const QEvent::Type PendingJobsEvent =
+        static_cast<QEvent::Type>(QEvent::User+PendingJobsEventIndex);
+    static const QEvent::Type RemoveGCLockEvent =
+        static_cast<QEvent::Type>(QEvent::User+RemoveGCLockEventIndex);
+
+private:
+    Q_DISABLE_COPY(HsQMLManagerApp)
+
+    int mArgC;
+    char mArg0;
+    char* mArgV;
+    QApplication mApp;
+};
+
+extern QAtomicPointer<HsQMLManager> gManager;
 
 #endif /*HSQML_MANAGER_H*/
diff --git a/cbits/HsQMLObject.cpp b/cbits/HsQMLObject.cpp
--- a/cbits/HsQMLObject.cpp
+++ b/cbits/HsQMLObject.cpp
@@ -1,25 +1,29 @@
 #include <HsFFI.h>
-#include <QDeclarativeEngine>
-#include <QString>
-#include <QDebug>
+#include <QtCore/QString>
+#include <QtDeclarative/QDeclarativeEngine>
 
 #include "HsQMLObject.h"
 #include "HsQMLClass.h"
 #include "HsQMLManager.h"
 
+static const char* cRefSrcNames[] = {"Hndl", "Obj", "Event"};
+
 HsQMLObjectProxy::HsQMLObjectProxy(HsStablePtr haskell, HsQMLClass* klass)
     : mHaskell(haskell)
     , mKlass(klass)
+    , mSerial(gManager->updateCounter(HsQMLManager::ObjectSerial, 1))
     , mObject(NULL)
     , mRefCount(0)
 {
     ref(Handle);
     mKlass->ref(HsQMLClass::ObjProxy);
+    gManager->updateCounter(HsQMLManager::ObjectCount, 1);
 }
 
 HsQMLObjectProxy::~HsQMLObjectProxy()
 {
     mKlass->deref(HsQMLClass::ObjProxy);
+    gManager->updateCounter(HsQMLManager::ObjectCount, -1);
 }
 
 HsStablePtr HsQMLObjectProxy::haskell() const
@@ -32,65 +36,145 @@
     return mKlass;
 }
 
-HsQMLObject* HsQMLObjectProxy::object()
+HsQMLObject* HsQMLObjectProxy::object(HsQMLEngine* engine)
 {
+    Q_ASSERT(gManager->isEventThread());
+    Q_ASSERT(engine);
     if (!mObject) {
-        mObject = new HsQMLObject(this);
+        mObject = new HsQMLObject(this, engine);
+        tryGCLock();
+
+        HSQML_LOG(5,
+            QString().sprintf("New QObject, class=%s, id=%d, qptr=%p.",
+            mKlass->name(), mSerial, mObject));
     }
     return mObject;
 }
 
 void HsQMLObjectProxy::clearObject()
 {
+    Q_ASSERT(gManager->isEventThread());
+
     mObject = NULL;
+
+    HSQML_LOG(5,
+        QString().sprintf("Release QObject, class=%s, id=%d, qptr=%p.",
+        mKlass->name(), mSerial, mObject));
 }
 
+void HsQMLObjectProxy::tryGCLock()
+{
+    Q_ASSERT(gManager->isEventThread());
+
+    if (mObject && mHndlCount > 0 && !mObject->isGCLocked()) {
+        mObject->setGCLock();
+
+        HSQML_LOG(5,
+            QString().sprintf("Lock QObject, class=%s, id=%d, qptr=%p.",
+            mKlass->name(), mSerial, mObject));
+    }
+}
+
+void HsQMLObjectProxy::removeGCLock()
+{
+    Q_ASSERT(gManager->isEventThread());
+
+    if (mObject && mHndlCount == 0 && mObject->isGCLocked()) {
+        mObject->clearGCLock();
+
+        HSQML_LOG(5,
+            QString().sprintf("Unlock QObject, class=%s, id=%d, qptr=%p.",
+            mKlass->name(), mSerial, mObject));
+    }
+}
+
+HsQMLEngine* HsQMLObjectProxy::engine() const
+{
+    if (mObject != NULL) {
+        return mObject->engine();
+    }
+    return NULL;
+}
+
 void HsQMLObjectProxy::ref(RefSrc src)
 {
     int count = mRefCount.fetchAndAddOrdered(1);
 
-    if (gLogLevel >= (count == 0 ? 3 : 4)) {
-        qDebug() << QString().sprintf(
-            "HsQML: %s ObjProxy, class=%s, ptr=%p, src=%d, count=%d.",
-            count ? "Ref" : "New", mKlass->name(), this, src, count+1);
+    HSQML_LOG(count == 0 ? 3 : 4,
+        QString().sprintf("%s ObjProxy, class=%s, id=%d, src=%s, count=%d.",
+        count ? "Ref" : "New", mKlass->name(),
+        mSerial, cRefSrcNames[src], count+1));
+
+    if (src == Handle) {
+        mHndlCount.fetchAndAddOrdered(1);
     }
 }
 
 void HsQMLObjectProxy::deref(RefSrc src)
 {
+    // Remove JavaScript GC lock when there are no handles
+    if (src == Handle) {
+        int hndlCount = mHndlCount.fetchAndAddOrdered(-1);
+        if (hndlCount == 1 && mObject) {
+            // This will increment the reference count for the lifetime of the
+            // of the event.
+            gManager->postObjectEvent(new HsQMLObjectEvent(this));
+        }
+    }
+
     int count = mRefCount.fetchAndAddOrdered(-1);
 
-    if (gLogLevel >= (count == 1 ? 3 : 4)) {
-        qDebug() << QString().sprintf(
-            "HsQML: %s ObjProxy, class=%s, ptr=%p, src=%d, count=%d.",
-            count > 1 ? "Deref" : "Delete", mKlass->name(), this, src, count);
-    }
+    HSQML_LOG(count == 1 ? 3 : 4,
+        QString().sprintf("%s ObjProxy, class=%s, id=%d, src=%s, count=%d.",
+        count > 1 ? "Deref" : "Delete", mKlass->name(),
+        mSerial, cRefSrcNames[src], count));
 
     if (count == 1) {
         delete this;
     }
 }
 
-HsQMLObject::HsQMLObject(HsQMLObjectProxy* proxy)
+HsQMLObjectEvent::HsQMLObjectEvent(HsQMLObjectProxy* proxy)
+    : QEvent(HsQMLManagerApp::RemoveGCLockEvent)
+    , mProxy(proxy)
+{
+    mProxy->ref(HsQMLObjectProxy::Event);
+}
+
+HsQMLObjectEvent::~HsQMLObjectEvent()
+{
+    mProxy->deref(HsQMLObjectProxy::Event);
+}
+
+void HsQMLObjectEvent::process()
+{
+    Q_ASSERT(type() == HsQMLManagerApp::RemoveGCLockEvent);
+    mProxy->removeGCLock();
+}
+
+HsQMLObject::HsQMLObject(HsQMLObjectProxy* proxy, HsQMLEngine* engine)
     : mProxy(proxy)
     , mHaskell(proxy->haskell())
     , mKlass(proxy->klass())
+    , mEngine(engine)
 {
     QDeclarativeEngine::setObjectOwnership(
         this, QDeclarativeEngine::JavaScriptOwnership);
     mProxy->ref(HsQMLObjectProxy::Object);
+    gManager->updateCounter(HsQMLManager::QObjectCount, 1);
 }
 
 HsQMLObject::~HsQMLObject()
 {
     mProxy->clearObject();
     mProxy->deref(HsQMLObjectProxy::Object);
+    gManager->updateCounter(HsQMLManager::QObjectCount, -1);
 }
 
 const QMetaObject* HsQMLObject::metaObject() const
 {
     return QObject::d_ptr->metaObject ?
-        QObject::d_ptr->metaObject : &mKlass->mMetaObject;
+        QObject::d_ptr->metaObject : mKlass->metaObj();
 }
 
 void* HsQMLObject::qt_metacast(const char* clname)
@@ -98,9 +182,7 @@
     if (!clname) {
         return 0;
     }
-    if (!strcmp(clname,
-            mKlass->mMetaObject.d.stringdata +
-            mKlass->mMetaObject.d.data[MD_CLASS_NAME])) {
+    if (!strcmp(clname, mKlass->metaObj()->className())) {
         return static_cast<void*>(const_cast<HsQMLObject*>(this));
     }
     return QObject::qt_metacast(clname);
@@ -112,36 +194,59 @@
     if (id < 0) {
         return id;
     }
+    gManager->setActiveEngine(mEngine);
     if (QMetaObject::InvokeMetaMethod == c) {
         mKlass->methods()[id](this, a);
-        id -= mKlass->mMethodCount;
+        id -= mKlass->methodCount();
     }
     else if (QMetaObject::ReadProperty == c) {
         mKlass->properties()[2*id](this, a);
-        id -= mKlass->mPropertyCount;
+        id -= mKlass->propertyCount();
     }
     else if (QMetaObject::WriteProperty == c) {
         HsQMLUniformFunc uf = mKlass->properties()[2*id+1];
         if (uf) {
             uf(this, a);
         }
-        id -= mKlass->mPropertyCount;
+        id -= mKlass->propertyCount();
     }
     else if (QMetaObject::QueryPropertyDesignable == c ||
              QMetaObject::QueryPropertyScriptable == c ||
              QMetaObject::QueryPropertyStored == c ||
              QMetaObject::QueryPropertyEditable == c ||
              QMetaObject::QueryPropertyUser == c) {
-        id -= mKlass->mPropertyCount;
+        id -= mKlass->propertyCount();
     }
+    gManager->setActiveEngine(NULL);
     return id;
 }
 
+void HsQMLObject::setGCLock()
+{
+    mGCLock = mEngine->scriptEngine()->newQObject(
+        this, QScriptEngine::ScriptOwnership);
+}
+
+void HsQMLObject::clearGCLock()
+{
+    mGCLock = QScriptValue();
+}
+
+bool HsQMLObject::isGCLocked() const
+{
+    return mGCLock.isValid();
+}
+
 HsQMLObjectProxy* HsQMLObject::proxy() const
 {
     return mProxy;
 }
 
+HsQMLEngine* HsQMLObject::engine() const
+{
+    return mEngine;
+}
+
 extern "C" HsQMLObjectHandle* hsqml_create_object(
     HsStablePtr haskell, HsQMLClassHandle* kHndl)
 {
@@ -149,6 +254,25 @@
     return (HsQMLObjectHandle*)proxy;
 }
 
+extern "C" void hsqml_object_set_active(
+    HsQMLObjectHandle* hndl)
+{
+    HsQMLObjectProxy* proxy = (HsQMLObjectProxy*)hndl;
+    if (proxy) {
+        gManager->setActiveEngine(proxy->engine());
+    }
+    else {
+        gManager->setActiveEngine(NULL);
+    }
+}
+
+extern "C" HsStablePtr hsqml_object_get_hs_typerep(
+    HsQMLObjectHandle* hndl)
+{
+    HsQMLObjectProxy* proxy = (HsQMLObjectProxy*)hndl;
+    return proxy->klass()->hsTypeRep();
+}
+
 extern HsStablePtr hsqml_object_get_haskell(
     HsQMLObjectHandle* hndl)
 {
@@ -160,32 +284,23 @@
     HsQMLObjectHandle* hndl)
 {
     HsQMLObjectProxy* proxy = (HsQMLObjectProxy*)hndl;
-    return (void*)proxy->object();
+    return (void*)proxy->object(gManager->activeEngine());
 }
 
 extern HsQMLObjectHandle* hsqml_get_object_handle(
-    void* ptr, HsQMLClassHandle* klassHndl)
+    void* ptr)
 {
     // Return NULL if the input pointer is NULL
     if (!ptr) {
         return NULL;
     }
 
-    // Return NULL if the object type doesn't match any supplied class
-    if (klassHndl) {
-        HsQMLClass* klass = (HsQMLClass*)klassHndl;
-        QObject* qObj = static_cast<QObject*>(ptr);
-        if (0 != strcmp(
-            qObj->metaObject()->className(),
-            klass->mMetaObject.className())) {
-            return NULL;
-        }
-    }
-
-    // Return object proxy
+    // Get object proxy
     HsQMLObject* object = (HsQMLObject*)ptr;
     HsQMLObjectProxy* proxy = object->proxy();
     proxy->ref(HsQMLObjectProxy::Handle);
+    proxy->tryGCLock();
+
     return (HsQMLObjectHandle*)proxy;
 }
 
@@ -195,5 +310,20 @@
     if (hndl) {
         HsQMLObjectProxy* proxy = (HsQMLObjectProxy*)hndl;
         proxy->deref(HsQMLObjectProxy::Handle);
+    }
+}
+
+extern void hsqml_fire_signal(
+    HsQMLObjectHandle* hndl, int idx, void** args)
+{
+    HsQMLObjectProxy* proxy = (HsQMLObjectProxy*)hndl;
+    HsQMLEngine* engine = proxy->engine();
+    // Ignore objects which haven't been marshalled as they are not connected.
+    if (engine) {
+        // Clear active engine in case the slot code calls back into Haskell.
+        Q_ASSERT(gManager->activeEngine() == engine);
+        gManager->setActiveEngine(NULL);
+        HsQMLObject* obj = proxy->object(engine);
+        QMetaObject::activate(obj, proxy->klass()->metaObj(), idx, args);
     }
 }
diff --git a/cbits/HsQMLObject.h b/cbits/HsQMLObject.h
--- a/cbits/HsQMLObject.h
+++ b/cbits/HsQMLObject.h
@@ -1,8 +1,12 @@
 #ifndef HSQML_OBJECT_H
 #define HSQML_OBJECT_H
 
-#include <QObject>
+#include <QtCore/QObject>
+#include <QtCore/QAtomicInt>
+#include <QtCore/QEvent>
+#include <QtScript/QScriptValue>
 
+class HsQMLEngine;
 class HsQMLClass;
 class HsQMLObject;
 
@@ -13,33 +17,55 @@
     virtual ~HsQMLObjectProxy();
     HsStablePtr haskell() const;
     HsQMLClass* klass() const;
-    HsQMLObject* object();
+    HsQMLObject* object(HsQMLEngine*);
     void clearObject();
-    enum RefSrc {Handle, Object};
+    void tryGCLock();
+    void removeGCLock();
+    HsQMLEngine* engine() const;
+    enum RefSrc {Handle, Object, Event};
     void ref(RefSrc);
     void deref(RefSrc);
 
 private:
     HsStablePtr mHaskell;
     HsQMLClass* mKlass;
-    HsQMLObject* mObject;
+    int mSerial;
+    HsQMLObject* volatile mObject;
     QAtomicInt mRefCount;
+    QAtomicInt mHndlCount;
 };
 
+class HsQMLObjectEvent : public QEvent
+{
+public:
+    HsQMLObjectEvent(HsQMLObjectProxy*);
+    virtual ~HsQMLObjectEvent();
+    void process();
+
+private:
+    HsQMLObjectProxy* mProxy;
+};
+
 class HsQMLObject : public QObject
 {
 public:
-    HsQMLObject(HsQMLObjectProxy*);
+    HsQMLObject(HsQMLObjectProxy*, HsQMLEngine*);
     virtual ~HsQMLObject();
     virtual const QMetaObject* metaObject() const;
     virtual void* qt_metacast(const char*);
     virtual int qt_metacall(QMetaObject::Call, int, void**);
+    void setGCLock();
+    void clearGCLock();
+    bool isGCLocked() const;
     HsQMLObjectProxy* proxy() const;
+    HsQMLEngine* engine() const;
 
 private:
     HsQMLObjectProxy* mProxy;
     HsStablePtr mHaskell;
     HsQMLClass* mKlass;
+    HsQMLEngine* mEngine;
+    QScriptValue mGCLock;
 };
 
 #endif /*HSQML_OBJECT_H*/
diff --git a/cbits/HsQMLWindow.cpp b/cbits/HsQMLWindow.cpp
--- a/cbits/HsQMLWindow.cpp
+++ b/cbits/HsQMLWindow.cpp
@@ -5,15 +5,16 @@
 HsQMLWindow::HsQMLWindow(HsQMLEngine* engine)
     : QObject(engine)
     , mEngine(engine)
-    , mContext(engine->engine())
+    , mContext(engine->declEngine())
     , mView(&mScene)
     , mComponent(NULL)
 {
     // Setup context
     mContext.setContextProperty("window", this);
 
-    // Don't delete on close
+    // Handle Window close event manually
     mWindow.setAttribute(Qt::WA_DeleteOnClose, false);
+    mWindow.installEventFilter(this);
 
     // Setup for QML performance
     mView.setOptimizationFlags(QGraphicsView::DontSavePainterState);
@@ -32,6 +33,14 @@
 {
 }
 
+bool HsQMLWindow::eventFilter(QObject* obj, QEvent* ev)
+{
+    if (obj == &mWindow && ev->type() == QEvent::Close) {
+        deleteLater();
+    }
+    return false;
+}
+
 QUrl HsQMLWindow::source() const
 {
     return mSource;
@@ -46,7 +55,7 @@
     }
     if (!mSource.isEmpty()) {
         mComponent = new QDeclarativeComponent(
-            mEngine->engine(), mSource, this);
+            mEngine->declEngine(), mSource, this);
         if (mComponent->isLoading()) {
             QObject::connect(
                 mComponent,
@@ -94,11 +103,5 @@
 
 void HsQMLWindow::close()
 {
-    QMetaObject::invokeMethod(
-        this, "completeClose", Qt::QueuedConnection);
-}
-
-void HsQMLWindow::completeClose()
-{
-    delete this;
+    deleteLater();
 }
diff --git a/cbits/HsQMLWindow.h b/cbits/HsQMLWindow.h
--- a/cbits/HsQMLWindow.h
+++ b/cbits/HsQMLWindow.h
@@ -1,12 +1,12 @@
 #ifndef HSQML_WINDOW_H
 #define HSQML_WINDOW_H
 
-#include <QMainWindow>
-#include <QDeclarativeContext>
-#include <QDeclarativeItem>
-#include <QGraphicsScene>
-#include <QGraphicsView>
-#include <QUrl>
+#include <QtCore/QUrl>
+#include <QtGui/QMainWindow>
+#include <QtGui/QGraphicsScene>
+#include <QtGui/QGraphicsView>
+#include <QtDeclarative/QDeclarativeContext>
+#include <QtDeclarative/QDeclarativeItem>
 
 #include "HsQMLManager.h"
 
@@ -19,6 +19,7 @@
 public:
     HsQMLWindow(HsQMLEngine*);
     virtual ~HsQMLWindow();
+    virtual bool eventFilter(QObject*, QEvent*);
     QUrl source() const;
     void setSource(const QUrl&);
     Q_PROPERTY(QUrl source READ source WRITE setSource);
@@ -32,7 +33,6 @@
 
 private:
     Q_SLOT void completeSetSource();
-    Q_SLOT void completeClose();
     HsQMLEngine* mEngine;
     QDeclarativeContext mContext;
     QMainWindow mWindow;
diff --git a/cbits/hsqml.h b/cbits/hsqml.h
--- a/cbits/hsqml.h
+++ b/cbits/hsqml.h
@@ -13,10 +13,30 @@
     void (*)(HsFunPtr),
     void (*)(HsStablePtr));
 
-extern void hsqml_run();
-
 extern void hsqml_set_debug_loglevel(int);
 
+/* Event Loop */
+typedef void (*HsQMLTrivialCb)();
+
+typedef enum {
+    HSQML_EVLOOP_OK = 0,
+    HSQML_EVLOOP_ALREADY_RUNNING,
+    HSQML_EVLOOP_WRONG_THREAD,
+    HSQML_EVLOOP_NOT_RUNNING,
+    HSQML_EVLOOP_OTHER_ERROR
+} HsQMLEventLoopStatus;
+
+extern HsQMLEventLoopStatus hsqml_evloop_run(
+    HsQMLTrivialCb startCb,
+    HsQMLTrivialCb jobsCb,
+    HsQMLTrivialCb yieldCb);
+
+extern HsQMLEventLoopStatus hsqml_evloop_require();
+
+extern void hsqml_evloop_release();
+
+extern void hsqml_evloop_notify_jobs();
+
 /* String */
 typedef char HsQMLStringHandle;
 
@@ -61,7 +81,7 @@
 extern int hsqml_get_next_class_id();
 
 extern HsQMLClassHandle* hsqml_create_class(
-    unsigned int*, char*, HsQMLUniformFunc*, HsQMLUniformFunc*);
+    unsigned int*, char*, HsStablePtr, HsQMLUniformFunc*, HsQMLUniformFunc*);
 
 extern void hsqml_finalise_class_handle(
     HsQMLClassHandle* hndl);
@@ -72,6 +92,12 @@
 extern HsQMLObjectHandle* hsqml_create_object(
     HsStablePtr, HsQMLClassHandle*);
 
+extern void hsqml_object_set_active(
+    HsQMLObjectHandle*);
+
+extern HsStablePtr hsqml_object_get_hs_typerep(
+    HsQMLObjectHandle*);
+
 extern HsStablePtr hsqml_object_get_haskell(
     HsQMLObjectHandle*);
 
@@ -79,18 +105,22 @@
     HsQMLObjectHandle*);
 
 extern HsQMLObjectHandle* hsqml_get_object_handle(
-    void*, HsQMLClassHandle*);
+    void*);
 
 extern void hsqml_finalise_object_handle(
     HsQMLObjectHandle*);
 
+extern void hsqml_fire_signal(
+    HsQMLObjectHandle*, int, void**);
+
 /* Engine */
 extern void hsqml_create_engine(
     HsQMLObjectHandle*,
     HsQMLUrlHandle*,
     int,
     int,
-    HsQMLStringHandle*);
+    HsQMLStringHandle*,
+    HsQMLTrivialCb stopCb);
 
 #ifdef __cplusplus
 }
diff --git a/hsqml.cabal b/hsqml.cabal
--- a/hsqml.cabal
+++ b/hsqml.cabal
@@ -1,31 +1,41 @@
 Name:               hsqml
-Version:            0.1.1
+Version:            0.2.0.0
 Cabal-version:      >= 1.10
 Build-type:         Custom
 License:            BSD3
 License-file:       LICENSE
-Copyright:          (c) 2010-2012 Robin KAY
+Copyright:          (c) 2010-2013 Robin KAY
 Author:             Robin KAY
 Maintainer:         komadori@gekkou.co.uk
 Stability:          experimental
-Homepage:           http://www.gekkou.co.uk/
+Homepage:           http://www.gekkou.co.uk/software/hsqml/
 Category:           Graphics
 Synopsis:           Haskell binding for Qt Quick
-Extra-source-files: cbits/*.cpp cbits/*.h
+Extra-source-files: CHANGELOG cbits/*.cpp cbits/*.h test/Graphics/QML/Test/*.hs
 Description:
     A Haskell binding for Qt Quick.
 
     General documentation is present in the 'Graphics.QML' module.
 
+Flag UsePkgConfig
+    Description:
+        Use pkg-config for libraries instead of the platform default mechanism.
+    Default: False
+
+Flag ThreadedTestSuite
+    Description:
+        Build test executable with the threaded RTS.
+    Default: True
+
 Library
     Default-language: Haskell2010
     Build-depends:
         base         == 4.*,
-        containers   == 0.4.*,
+        containers   >= 0.4 && < 0.6,
         filepath     == 1.3.*,
-        network      == 2.3.*,
+        network      >= 2.3 && < 2.5,
         text         == 0.11.*,
-        tagged       == 0.4.*,
+        tagged       >= 0.4 && < 0.8,
         transformers >= 0.2 && < 0.4
     Exposed-modules:
         Graphics.QML
@@ -34,12 +44,13 @@
         Graphics.QML.Marshal
         Graphics.QML.Objects
     Other-modules:
+        Graphics.QML.Internal.BindPrim
+        Graphics.QML.Internal.BindObj
+        Graphics.QML.Internal.BindCore
+        Graphics.QML.Internal.JobQueue
         Graphics.QML.Internal.Marshal
         Graphics.QML.Internal.Objects
-        Graphics.QML.Internal.PrimValues
-        Graphics.QML.Internal.Engine
     Hs-source-dirs: src
-    Cc-options: -std=c++0x
     C-sources:
         cbits/HsQMLClass.cpp
         cbits/HsQMLEngine.cpp
@@ -54,19 +65,16 @@
         cbits/HsQMLWindow.h
     X-separate-cbits: True
     Build-tools: c2hs
-    if os(windows)
-        Include-dirs:
-            /QT_ROOT/include
-            /QT_ROOT/include/QtCore
-            /QT_ROOT/include/QtGui
-            /QT_ROOT/include/QtDeclarative
-        Extra-libraries: QtCore4, QtGui4, QtDeclarative4, stdc++
-        Extra-lib-dirs:
-            /SYS_ROOT/bin
-            /QT_ROOT/bin
+    if os(windows) && !flag(UsePkgConfig)
+        Include-dirs: /QT_ROOT/include
+        Extra-libraries: QtCore4, QtGui4, QtScript4, QtDeclarative4, stdc++
+        Extra-lib-dirs: /SYS_ROOT/bin /QT_ROOT/bin
     else
-        Pkgconfig-depends:
-            QtDeclarative >= 4.7
+        if os(darwin) && !flag(UsePkgConfig)
+            Frameworks: QtCore QtGui QtScript QtDeclarative
+        else
+            Pkgconfig-depends: QtScript >= 4.7, QtDeclarative >= 4.7
+        Extra-libraries: stdc++
 
 Test-Suite hsqml-test1
     Type: exitcode-stdio-1.0
@@ -74,11 +82,17 @@
     Hs-source-dirs: test
     Main-is: Test1.hs
     Build-depends:
-        base      == 4.*,
-        directory == 1.1.*,
-        network   == 2.3.*,
-        hsqml     == 0.1.*
+        base       == 4.*,
+        containers >= 0.4 && < 0.6,
+        directory  >= 1.1 && < 1.3,
+        network    >= 2.3 && < 2.5,
+        text       == 0.11.*,
+        tagged     >= 0.4 && < 0.8,
+        QuickCheck >= 2.4 && < 2.7,
+        hsqml      == 0.2.*
+    if flag(ThreadedTestSuite)
+        GHC-options: -threaded
 
 Source-repository head
     type:     darcs
-    location: https://patch-tag.com/r/komadori/HsQML
+    location: http://hub.darcs.net/komadori/HsQML/
diff --git a/src/Graphics/QML/Debug.hs b/src/Graphics/QML/Debug.hs
--- a/src/Graphics/QML/Debug.hs
+++ b/src/Graphics/QML/Debug.hs
@@ -3,7 +3,7 @@
     setDebugLogLevel
 ) where
 
-import Graphics.QML.Internal.Engine
+import Graphics.QML.Internal.BindCore
 
 -- | Sets the global debug log level. At level zero, no logging information
 -- will be printed. Higher levels will increase debug verbosity.
diff --git a/src/Graphics/QML/Engine.hs b/src/Graphics/QML/Engine.hs
--- a/src/Graphics/QML/Engine.hs
+++ b/src/Graphics/QML/Engine.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE
-    ExistentialQuantification,
-    Rank2Types
+    DeriveDataTypeable,
+    FlexibleContexts,
+    GeneralizedNewtypeDeriving
   #-}
 
 -- | Functions for starting QML engines, displaying content in a window.
 module Graphics.QML.Engine (
+  -- * Engines
   InitialWindowState(
     ShowWindow,
     ShowWindowWithTitle,
@@ -15,21 +17,39 @@
     initialWindowState,
     contextObject),
   defaultEngineConfig,
-  createEngine,
-  runEngines,
+  Engine,
+  runEngine,
+  runEngineWith,
+  runEngineAsync,
+  runEngineLoop,
+
+  -- * Event Loop
+  RunQML(),
+  runEventLoop,
+  requireEventLoop,
+  EventLoopException(),
+
+  -- * Utilities
   filePathToURI
 ) where
 
+import Graphics.QML.Internal.JobQueue
 import Graphics.QML.Internal.Marshal
 import Graphics.QML.Internal.Objects
-import Graphics.QML.Internal.Engine
+import Graphics.QML.Internal.BindCore
 import Graphics.QML.Marshal
 import Graphics.QML.Objects
 
+import Control.Applicative
+import Control.Concurrent
+import Control.Concurrent.MVar
+import Control.Exception
+import Control.Monad
+import Control.Monad.IO.Class
 import Data.List
 import Data.Maybe
+import Data.Traversable as T
 import Data.Typeable
-import Foreign.Storable
 import System.FilePath (isAbsolute, splitDirectories, pathSeparators)
 import Network.URI (URI(URI), URIAuth(URIAuth), nullURI, uriPath)
 
@@ -46,18 +66,18 @@
   | HideWindow
 
 -- | Holds parameters for configuring a QML runtime engine.
-data EngineConfig a = EngineConfig {
+data EngineConfig = EngineConfig {
   -- | URL for the first QML document to be loaded.
   initialURL         :: URI,
   -- | Window state for the initial QML document.
   initialWindowState :: InitialWindowState,
   -- | Context 'Object' made available to QML script code.
-  contextObject      :: Maybe (ObjRef a)
+  contextObject      :: Maybe AnyObjRef
 }
 
 -- | Default engine configuration. Loads @\"main.qml\"@ from the current
 -- working directory into a visible window with no context object.
-defaultEngineConfig :: EngineConfig a
+defaultEngineConfig :: EngineConfig
 defaultEngineConfig = EngineConfig {
   initialURL         = nullURI {uriPath = "main.qml"},
   initialWindowState = ShowWindow,
@@ -73,26 +93,132 @@
 getWindowTitle (ShowWindowWithTitle t) = Just t
 getWindowTitle _ = Nothing
 
--- | Create a QML engine from a specification of its configuration.
-createEngine :: (Object a) => EngineConfig a -> IO ()
-createEngine config = do
-  hsqmlInit
-  let hndl = fmap (\(ObjRef h) -> h) $ contextObject config
-      url = initialURL config
-      state = initialWindowState config
-      showWin = isWindowShown state
-      maybeTitle = getWindowTitle state
-      setTitle = isJust maybeTitle
-      titleStr = fromMaybe "" maybeTitle
-  mOutAlloc url $ \urlPtr -> do
-    mOutAlloc titleStr $ \titlePtr -> do
-      hsqmlCreateEngine hndl urlPtr showWin setTitle titlePtr
+-- | Represents a QML engine.
+data Engine = Engine
 
--- | Enters the Qt event loop and runs until all engines have terminated.
-runEngines :: IO ()
-runEngines = do
-  hsqmlInit
-  hsqmlRun
+runEngineImpl :: EngineConfig -> IO () -> IO Engine
+runEngineImpl config stopCb = do
+    hsqmlInit
+    let obj = contextObject config
+        url = initialURL config
+        state = initialWindowState config
+        showWin = isWindowShown state
+        maybeTitle = getWindowTitle state
+        setTitle = isJust maybeTitle
+        titleStr = fromMaybe "" maybeTitle
+    hndl <- T.sequence $ fmap mHsToObj $ obj
+    mHsToAlloc url $ \urlPtr -> do
+        mHsToAlloc titleStr $ \titlePtr -> do
+            hsqmlCreateEngine hndl urlPtr showWin setTitle titlePtr stopCb
+    return Engine
+
+-- | Starts a new QML engine using the supplied configuration and blocks until
+-- the engine has terminated.
+runEngine :: EngineConfig -> RunQML ()
+runEngine config = runEngineWith config (const $ return ())
+
+-- | Starts a new QML engine using the supplied configuration. The \'with\'
+-- function is executed once the engine has been started and after it returns
+-- this function blocks until the engine has terminated.
+runEngineWith :: EngineConfig -> (Engine -> RunQML a) -> RunQML a
+runEngineWith config with = RunQML $ do
+    finishVar <- newEmptyMVar
+    let stopCb = putMVar finishVar () 
+    eng <- runEngineImpl config stopCb
+    let (RunQML withIO) = with eng
+    ret <- withIO
+    void $ takeMVar finishVar
+    return ret
+
+-- | Starts a new QML engine using the supplied configuration and returns
+-- immediately without blocking.
+runEngineAsync :: EngineConfig -> RunQML Engine
+runEngineAsync config = RunQML $ do
+    runEngineImpl config (return ())
+
+-- | Conveniance function that both runs the event loop and starts a new QML
+-- engine. It blocks keeping the event loop running until the engine has
+-- terminated.
+runEngineLoop :: EngineConfig -> IO ()
+runEngineLoop config =
+    runEventLoop $ runEngine config
+
+-- | Wrapper around the IO monad for running actions which depend on the Qt
+-- event loop.
+newtype RunQML a = RunQML (IO a) deriving (Functor, Applicative, Monad)
+
+instance MonadIO RunQML where
+    liftIO io = RunQML io
+
+-- | This function enters the Qt event loop and executes the supplied function
+-- in the 'RunQML' monad on a new unbound thread. The event loop will continue
+-- to run until all functions in the 'RunQML' monad have completed. This
+-- includes both the 'RunQML' function launched by this call and any launched
+-- asynchronously via 'requireEventLoop'. When the event loop exits, all
+-- engines will be terminated.
+--
+-- It's recommended that applications run the event loop on their primordial
+-- thread as some platforms mandate this. Once the event loop has finished, it
+-- can be started again, but only on the same operating system thread as
+-- before. If the event loop fails to start then an 'EventLoopException' will
+-- be thrown.
+runEventLoop :: RunQML a -> IO a
+runEventLoop (RunQML runFn) = tryRunInBoundThread $ do
+    hsqmlInit
+    finishVar <- newEmptyMVar
+    let startCb = void $ forkIO $ do
+            ret <- try runFn
+            case ret of
+                Left ex -> putMVar finishVar $ throwIO (ex :: SomeException)
+                Right ret -> putMVar finishVar $ return ret
+            hsqmlEvloopRelease
+        yieldCb = if rtsSupportsBoundThreads
+                  then Nothing
+                  else Just yield
+    status <- hsqmlEvloopRun startCb processJobs yieldCb
+    case statusException status of
+        Just ex -> throw ex
+        Nothing -> do 
+            finFn <- takeMVar finishVar
+            finFn
+
+tryRunInBoundThread :: IO a -> IO a
+tryRunInBoundThread action = do
+    if rtsSupportsBoundThreads
+    then runInBoundThread action
+    else action
+
+-- | Executes a function in the 'RunQML' monad asynchronously to the event
+-- loop. Callers must apply their own sychronisation to ensure that the event
+-- loop is currently running when this function is called, otherwise an
+-- 'EventLoopException' will be thrown. The event loop will not exit until the
+-- supplied function has completed.
+requireEventLoop :: RunQML a -> IO a
+requireEventLoop (RunQML runFn) = do
+    hsqmlInit
+    let reqFn = do
+            status <- hsqmlEvloopRequire
+            case statusException status of
+                Just ex -> throw ex
+                Nothing -> return ()
+    bracket_ reqFn hsqmlEvloopRelease runFn
+
+statusException :: HsQMLEventLoopStatus -> Maybe EventLoopException
+statusException HsqmlEvloopOk = Nothing
+statusException HsqmlEvloopAlreadyRunning = Just EventLoopAlreadyRunning
+statusException HsqmlEvloopWrongThread = Just EventLoopWrongThread
+statusException HsqmlEvloopNotRunning = Just EventLoopNotRunning
+statusException _ = Just EventLoopOtherError
+
+-- | Exception type used to report errors pertaining to the event loop.
+data EventLoopException
+    = EventLoopAlreadyRunning
+    | EventLoopWrongThread
+    | EventLoopNotRunning
+    | EventLoopOtherError
+    deriving (Show, Typeable)
+
+instance Exception EventLoopException
 
 -- | Convenience function for converting local file paths into URIs.
 filePathToURI :: FilePath -> URI
diff --git a/src/Graphics/QML/Internal/BindCore.chs b/src/Graphics/QML/Internal/BindCore.chs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/QML/Internal/BindCore.chs
@@ -0,0 +1,82 @@
+{-# LANGUAGE
+    ForeignFunctionInterface
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+module Graphics.QML.Internal.BindCore where
+
+{#import Graphics.QML.Internal.BindObj #}
+
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Marshal.Utils
+import Foreign.Ptr
+import Foreign.StablePtr
+
+#include <HsFFI.h>
+
+#include "hsqml.h"
+
+type HsFreeFunPtr = FunPtr (FunPtr (IO ()) -> IO ())
+foreign import ccall "HsFFI.h &hs_free_fun_ptr"
+  hsFreeFunPtr :: HsFreeFunPtr
+
+type HsFreeStablePtr = FunPtr (Ptr () -> IO ())
+foreign import ccall "HsFFI.h &hs_free_stable_ptr"
+  hsFreeStablePtr :: HsFreeStablePtr
+
+{#fun unsafe hsqml_init as hsqmlInit_
+  {id `HsFreeFunPtr',
+   id `HsFreeStablePtr'} ->
+  `()' #}
+
+hsqmlInit :: IO ()
+hsqmlInit = hsqmlInit_ hsFreeFunPtr hsFreeStablePtr
+
+type TrivialCb = IO ()
+
+foreign import ccall "wrapper"  
+  marshalTrivialCb :: TrivialCb -> IO (FunPtr TrivialCb)
+
+withTrivialCb :: TrivialCb -> (FunPtr TrivialCb -> IO a) -> IO a
+withTrivialCb f with = marshalTrivialCb f >>= with
+
+withMaybeTrivialCb :: Maybe TrivialCb -> (FunPtr TrivialCb -> IO b) -> IO b
+withMaybeTrivialCb (Just f) = withTrivialCb f
+withMaybeTrivialCb Nothing = \cont -> cont nullFunPtr
+
+{#enum HsQMLEventLoopStatus as ^ {underscoreToCase} #}
+
+cIntToEnum :: Enum a => CInt -> a
+cIntToEnum = toEnum . fromIntegral
+
+{#fun hsqml_evloop_run as ^
+  {withTrivialCb* `TrivialCb',
+   withTrivialCb* `TrivialCb',
+   withMaybeTrivialCb* `Maybe TrivialCb'} ->
+  `HsQMLEventLoopStatus' cIntToEnum #}
+
+{#fun hsqml_evloop_require as ^
+  {} ->
+  `HsQMLEventLoopStatus' cIntToEnum #}
+
+{#fun hsqml_evloop_release as ^
+  {} ->
+  `()' #}
+
+{#fun unsafe hsqml_evloop_notify_jobs as ^
+  {} ->
+  `()' #}
+
+{#fun hsqml_create_engine as ^
+  {withMaybeHsQMLObjectHandle* `Maybe HsQMLObjectHandle',
+   castPtr `Ptr ()',
+   fromBool `Bool',
+   fromBool `Bool',
+   castPtr `Ptr ()',
+   withTrivialCb* `TrivialCb'} ->
+  `()' #}
+
+{#fun unsafe hsqml_set_debug_loglevel as ^
+  {fromIntegral `Int'} -> `()'
+  #}
diff --git a/src/Graphics/QML/Internal/BindObj.chs b/src/Graphics/QML/Internal/BindObj.chs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/QML/Internal/BindObj.chs
@@ -0,0 +1,156 @@
+{-# LANGUAGE
+    ForeignFunctionInterface
+  #-}
+
+module Graphics.QML.Internal.BindObj where
+
+import Control.Exception (bracket_)
+import Data.Typeable
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.ForeignPtr.Safe
+import Foreign.ForeignPtr.Unsafe
+import Foreign.StablePtr
+
+#include "hsqml.h"
+
+marshalStable :: a -> (Ptr () -> IO b) -> IO b
+marshalStable obj f = do
+  sPtr <- newStablePtr obj
+  res <- f $ castStablePtrToPtr sPtr
+  return res
+
+fromStable :: Ptr () -> IO a
+fromStable =
+  deRefStablePtr . castPtrToStablePtr
+
+{#fun unsafe hsqml_get_next_class_id as ^
+  {} ->
+  `CInt' id #}
+
+type UniformFunc = Ptr () -> Ptr (Ptr ()) -> IO ()
+
+foreign import ccall "wrapper"  
+  marshalFunc :: UniformFunc -> IO (FunPtr UniformFunc)
+
+{#pointer *HsQMLClassHandle as ^ foreign newtype #}
+
+foreign import ccall "hsqml.h &hsqml_finalise_class_handle"
+  hsqmlFinaliseClassHandlePtr :: FunPtr (Ptr (HsQMLClassHandle) -> IO ())
+
+newClassHandle :: Ptr HsQMLClassHandle -> IO (Maybe HsQMLClassHandle)
+newClassHandle p =
+  if nullPtr == p
+    then return Nothing
+    else do
+      fp <- newForeignPtr hsqmlFinaliseClassHandlePtr p
+      return $ Just $ HsQMLClassHandle fp
+
+{#fun unsafe hsqml_create_class as ^
+  {id `Ptr CUInt',
+   id `Ptr CChar',
+   marshalStable* `TypeRep',
+   id `Ptr (FunPtr UniformFunc)',
+   id `Ptr (FunPtr UniformFunc)'} ->
+  `Maybe HsQMLClassHandle' newClassHandle* #}
+
+withMaybeHsQMLObjectHandle ::
+    Maybe HsQMLObjectHandle -> (Ptr HsQMLObjectHandle -> IO b) -> IO b
+withMaybeHsQMLObjectHandle (Just (HsQMLObjectHandle fp)) = withForeignPtr fp
+withMaybeHsQMLObjectHandle Nothing = \f -> f nullPtr
+
+{#pointer *HsQMLObjectHandle as ^ foreign newtype #}
+
+foreign import ccall "hsqml.h &hsqml_finalise_object_handle"
+  hsqmlFinaliseObjectHandlePtr :: FunPtr (Ptr (HsQMLObjectHandle) -> IO ())
+
+newObjectHandle :: Ptr HsQMLObjectHandle -> IO HsQMLObjectHandle
+newObjectHandle p = do
+  fp <- newForeignPtr hsqmlFinaliseObjectHandlePtr p
+  return $ HsQMLObjectHandle fp
+
+isNullObjectHandle :: HsQMLObjectHandle -> Bool
+isNullObjectHandle (HsQMLObjectHandle fp) =
+  nullPtr == unsafeForeignPtrToPtr fp
+
+{#fun unsafe hsqml_create_object as ^
+  {marshalStable* `a',
+   withHsQMLClassHandle* `HsQMLClassHandle'} ->
+  `HsQMLObjectHandle' newObjectHandle* #}
+
+{#fun unsafe hsqml_object_set_active as ^
+  {withMaybeHsQMLObjectHandle* `Maybe HsQMLObjectHandle'} ->
+ `()' #}
+
+withActiveObject :: HsQMLObjectHandle -> IO () -> IO ()
+withActiveObject hndl action =
+    bracket_
+        (hsqmlObjectSetActive $ Just hndl)
+        (hsqmlObjectSetActive Nothing)
+        action
+
+{#fun unsafe hsqml_object_get_haskell as ^
+  {withHsQMLObjectHandle* `HsQMLObjectHandle'} ->
+  `a' fromStable* #}
+
+{#fun unsafe hsqml_object_get_hs_typerep as ^
+  {withHsQMLObjectHandle* `HsQMLObjectHandle'} ->
+  `TypeRep' fromStable* #}
+
+{#fun unsafe hsqml_object_get_pointer as ^
+  {withHsQMLObjectHandle* `HsQMLObjectHandle'} ->
+  `Ptr ()' id #}
+
+{#fun unsafe hsqml_get_object_handle as ^
+  {id `Ptr ()'} ->
+  `HsQMLObjectHandle' newObjectHandle* #}
+
+{#fun hsqml_fire_signal as ^
+  {withHsQMLObjectHandle* `HsQMLObjectHandle',
+   `Int',
+   id `Ptr (Ptr ())'} ->
+  `()' #}
+
+ofDynamicMetaObject :: CUInt
+ofDynamicMetaObject = 0x01
+
+mfAccessPrivate, mfAccessProtected, mfAccessPublic, mfAccessMask,
+  mfMethodMethod, mfMethodSignal, mfMethodSlot, mfMethodConstructor,
+  mfMethodTypeMask, mfMethodCompatibility, mfMethodCloned, mfMethodScriptable
+  :: CUInt
+mfAccessPrivate   = 0x00
+mfAccessProtected = 0x01
+mfAccessPublic    = 0x02
+mfAccessMask      = 0x03
+mfMethodMethod      = 0x00
+mfMethodSignal      = 0x04
+mfMethodSlot        = 0x08
+mfMethodConstructor = 0x0c
+mfMethodTypeMask    = 0x0c
+mfMethodCompatibility = 0x10
+mfMethodCloned        = 0x20
+mfMethodScriptable    = 0x40
+
+pfInvalid, pfReadable, pfWritable, pfResettable, pfEnumOrFlag, pfStdCppSet,
+  pfConstant, pfFinal, pfDesignable, pfResolveDesignable, pfScriptable,
+  pfResolveScriptable, pfStored, pfResolveStored, pfEditable,
+  pfResolveEditable, pfUser, pfResolveUser, pfNotify :: CUInt
+pfInvalid           = 0x00000000
+pfReadable          = 0x00000001
+pfWritable          = 0x00000002
+pfResettable        = 0x00000004
+pfEnumOrFlag        = 0x00000008
+pfStdCppSet         = 0x00000100
+pfConstant          = 0x00000400
+pfFinal             = 0x00000800
+pfDesignable        = 0x00001000
+pfResolveDesignable = 0x00002000
+pfScriptable        = 0x00004000
+pfResolveScriptable = 0x00008000
+pfStored            = 0x00010000
+pfResolveStored     = 0x00020000
+pfEditable          = 0x00040000
+pfResolveEditable   = 0x00080000
+pfUser              = 0x00100000
+pfResolveUser       = 0x00200000
+pfNotify            = 0x00400000
diff --git a/src/Graphics/QML/Internal/BindPrim.chs b/src/Graphics/QML/Internal/BindPrim.chs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/QML/Internal/BindPrim.chs
@@ -0,0 +1,77 @@
+{-# LANGUAGE
+    ForeignFunctionInterface
+  #-}
+
+module Graphics.QML.Internal.BindPrim where
+
+import Foreign.C.Types
+import Foreign.Ptr
+import System.IO.Unsafe
+
+#include "hsqml.h"
+
+cIntConv :: (Integral a, Integral b) => a -> b
+cIntConv = fromIntegral
+
+--
+-- String
+--
+
+{#pointer *HsQMLStringHandle as ^ newtype #}
+
+{#fun unsafe hsqml_get_string_size as ^
+  {} ->
+  `Int' fromIntegral #}
+
+hsqmlStringSize :: Int
+hsqmlStringSize = unsafePerformIO $ hsqmlGetStringSize
+
+{#fun unsafe hsqml_init_string as ^
+  {id `HsQMLStringHandle'} ->
+  `()' #}
+
+{#fun unsafe hsqml_deinit_string as ^
+  {id `HsQMLStringHandle'} ->
+  `()' #}
+
+{#fun unsafe hsqml_marshal_string as ^
+  {`Int',
+   id `HsQMLStringHandle'} ->
+  `Ptr CUShort' id #}
+
+{#fun unsafe hsqml_unmarshal_string as ^
+  {id `HsQMLStringHandle',
+   id `Ptr (Ptr CUShort)'} ->
+  `Int' #}
+
+--
+-- URL
+--
+
+{#pointer *HsQMLUrlHandle as ^ newtype #}
+
+{#fun unsafe hsqml_get_url_size as ^
+  {} ->
+  `Int' fromIntegral #}
+
+hsqmlUrlSize :: Int
+hsqmlUrlSize = unsafePerformIO $ hsqmlGetUrlSize
+
+{#fun unsafe hsqml_init_url as ^
+  {id `HsQMLUrlHandle'} ->
+  `()' #}
+
+{#fun unsafe hsqml_deinit_url as ^
+  {id `HsQMLUrlHandle'} ->
+  `()' #}
+
+{#fun unsafe hsqml_marshal_url as ^
+  {id `Ptr CChar',
+   `Int',
+   id `HsQMLUrlHandle'} ->
+  `()' #}
+
+{#fun unsafe hsqml_unmarshal_url as ^
+  {id `HsQMLUrlHandle',
+   id `Ptr (Ptr CChar)'} ->
+  `Int' #}
diff --git a/src/Graphics/QML/Internal/Engine.chs b/src/Graphics/QML/Internal/Engine.chs
deleted file mode 100644
--- a/src/Graphics/QML/Internal/Engine.chs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-# LANGUAGE
-    ForeignFunctionInterface
-  #-}
-{-# OPTIONS_HADDOCK hide #-}
-
-module Graphics.QML.Internal.Engine where
-
-{#import Graphics.QML.Internal.Objects #}
-
-import Foreign.C.Types
-import Foreign.C.String
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import Foreign.StablePtr
-
-#include <HsFFI.h>
-
-#include "hsqml.h"
-
-type HsFreeFunPtr = FunPtr (FunPtr (IO ()) -> IO ())
-foreign import ccall "HsFFI.h &hs_free_fun_ptr"
-  hsFreeFunPtr :: HsFreeFunPtr
-
-type HsFreeStablePtr = FunPtr (Ptr () -> IO ())
-foreign import ccall "HsFFI.h &hs_free_stable_ptr"
-  hsFreeStablePtr :: HsFreeStablePtr
-
-{#fun unsafe hsqml_init as hsqmlInit_
-  {id `HsFreeFunPtr',
-   id `HsFreeStablePtr'} ->
-  `()' #}
-
-hsqmlInit :: IO ()
-hsqmlInit = hsqmlInit_ hsFreeFunPtr hsFreeStablePtr
-
-{#fun unsafe hsqml_create_engine as ^
-  {withMaybeHsQMLObjectHandle* `Maybe HsQMLObjectHandle',
-   castPtr `Ptr ()',
-   fromBool `Bool',
-   fromBool `Bool',
-   castPtr `Ptr ()'} ->
-  `()' #}
-
-{#fun hsqml_run as ^ {} -> `()' #}
-
-{#fun hsqml_set_debug_loglevel as ^
-  {fromIntegral `Int'} -> `()'
-  #}
diff --git a/src/Graphics/QML/Internal/JobQueue.hs b/src/Graphics/QML/Internal/JobQueue.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/QML/Internal/JobQueue.hs
@@ -0,0 +1,25 @@
+module Graphics.QML.Internal.JobQueue (
+    postJob,
+    processJobs
+) where
+
+import Graphics.QML.Internal.BindCore
+
+import Control.Concurrent.MVar
+import System.IO.Unsafe
+
+{-# NOINLINE jobQueue #-}
+jobQueue :: MVar [IO ()]
+jobQueue = unsafePerformIO $ newMVar []
+
+postJob :: IO () -> IO ()
+postJob j = do
+    notify <- modifyMVar jobQueue $ \js -> return (j:js,null js)
+    if notify
+    then hsqmlEvloopNotifyJobs 
+    else return ()
+
+processJobs :: IO ()
+processJobs = do
+    js <- modifyMVar jobQueue $ \js -> return ([],js)
+    sequence_ $ reverse js
diff --git a/src/Graphics/QML/Internal/Marshal.hs b/src/Graphics/QML/Internal/Marshal.hs
--- a/src/Graphics/QML/Internal/Marshal.hs
+++ b/src/Graphics/QML/Internal/Marshal.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE
-    ScopedTypeVariables
+    ScopedTypeVariables,
+    TypeFamilies,
+    FlexibleContexts,
+    FlexibleInstances,
+    Rank2Types
   #-}
 
 module Graphics.QML.Internal.Marshal where
@@ -15,11 +19,6 @@
   typeName :: String
 }
 
--- | The class 'MarshalIn' allows QML values to be converted into Haskell
--- values.
-class MarshalIn a where
-  mIn :: InMarshaller a
-
 type ErrIO a = MaybeT IO a
 
 runErrIO :: ErrIO a -> IO ()
@@ -32,32 +31,97 @@
 errIO :: IO a -> ErrIO a
 errIO = MaybeT . fmap Just
 
+type MTypeNameFunc t = Tagged t TypeName
+type MValToHsFunc t = Ptr () -> ErrIO t
+type MHsToValFunc t = t -> Ptr () -> IO ()
+type MHsToAllocFunc t = (forall b. t -> (Ptr () -> IO b) -> IO b)
+
+-- | The class 'Marshal' allows Haskell values to be marshalled to and from the
+-- QML environment.
+class Marshal t where
+  -- | The 'MarshalMode' associated type parameter specifies the type of
+  -- marshalling functionality offered by the instance.
+  type MarshalMode t
+  -- | Yields the 'Marshaller' for the type @t@.
+  marshaller :: Marshaller t (MarshalMode t)
+
+-- | Base class containing core functionality for all 'MarshalMode's.
+class MarshalBase m where
+  mTypeName_ :: forall t. Marshaller t m -> MTypeNameFunc t
+
+mTypeName ::
+  forall t. (Marshal t, MarshalBase (MarshalMode t)) => MTypeNameFunc t
+mTypeName = mTypeName_ (marshaller :: Marshaller t (MarshalMode t))
+
+-- | Class for 'MarshalMode's which support marshalling QML-to-Haskell.
+class (MarshalBase m) => MarshalToHs m where
+  mValToHs_ :: forall t. Marshaller t m -> MValToHsFunc t
+
+mValToHs ::
+  forall t. (Marshal t, MarshalToHs (MarshalMode t)) => MValToHsFunc t
+mValToHs = mValToHs_ (marshaller :: Marshaller t (MarshalMode t))
+
+-- | Class for 'MarshalMode's which support marshalling Haskell-to-QML.
+class (MarshalBase m) => MarshalToValRaw m where
+  mHsToVal_   :: forall t. Marshaller t m -> MHsToValFunc t
+  mHsToAlloc_ :: forall t. Marshaller t m -> MHsToAllocFunc t
+
+mHsToVal ::
+  forall t. (Marshal t, MarshalToValRaw (MarshalMode t)) => MHsToValFunc t
+mHsToVal = mHsToVal_ (marshaller :: Marshaller t (MarshalMode t))
+
+mHsToAlloc ::
+  forall t. (Marshal t, MarshalToValRaw (MarshalMode t)) => MHsToAllocFunc t
+mHsToAlloc = mHsToAlloc_ (marshaller :: Marshaller t (MarshalMode t))
+
+-- | Class for 'MarshalMode's which support marshalling Haskell-to-QML,
+-- excluding the return of void from methods.
+class (MarshalToValRaw m) => MarshalToVal m where
+
 -- | Encapsulates the functionality to needed to implement an instance of
--- 'MarshalIn' so that such instances can be defined without access to
+-- 'Marshal' so that such instances can be defined without access to
 -- implementation details.
-data InMarshaller a = InMarshaller {
-  mInFuncFld :: Ptr () -> ErrIO a,
-  mIOTypeFld :: Tagged a TypeName
-}
+data family Marshaller t m
 
-mInFunc :: (MarshalIn a) => Ptr () -> ErrIO a
-mInFunc = mInFuncFld mIn 
+-- | 'MarshalMode' for built-in data types.
+data ValBidi
 
-mIOType :: (MarshalIn a) => Tagged a TypeName
-mIOType = mIOTypeFld mIn
+data instance Marshaller t ValBidi = MValBidi {
+  mValBidi_typeName  :: !(MTypeNameFunc t),
+  mValBidi_valToHs   :: !(MValToHsFunc t),
+  mValBidi_hsToVal   :: !(MHsToValFunc t),
+  mValBidi_hsToAlloc :: !(MHsToAllocFunc t)}
 
--- | The class 'MarshalOut' allows Haskell values to be converted into QML
--- values.
-class (MarshalIn a) => MarshalOut a where
-  mOutFunc  :: Ptr () -> a -> IO ()
-  mOutAlloc :: a -> (Ptr () -> IO b) -> IO b
+instance MarshalBase ValBidi where
+  mTypeName_ = mValBidi_typeName
 
-instance MarshalOut () where
-  mOutFunc _ _ = return ()
-  mOutAlloc _ f = f nullPtr
+instance MarshalToHs ValBidi where
+  mValToHs_ = mValBidi_valToHs
 
-instance MarshalIn () where
-  mIn = InMarshaller {
-    mInFuncFld = \_ -> return (),
-    mIOTypeFld = Tagged $ TypeName ""
-  }
+instance MarshalToValRaw ValBidi where
+  mHsToVal_   = mValBidi_hsToVal
+  mHsToAlloc_ = mValBidi_hsToAlloc
+
+instance MarshalToVal ValBidi where
+
+-- | 'MarshalMode' for void in method returns.
+data ValFnRetVoid
+
+data instance Marshaller t ValFnRetVoid = MValFnRetVoid {
+  mValFnRetVoid_typeName  :: !(MTypeNameFunc t),
+  mValFnRetVoid_hsToVal   :: !(MHsToValFunc t),
+  mValFnRetVoid_hsToAlloc :: !(MHsToAllocFunc t)}
+
+instance MarshalBase ValFnRetVoid where
+  mTypeName_ = mValFnRetVoid_typeName
+
+instance MarshalToValRaw ValFnRetVoid where
+  mHsToVal_   = mValFnRetVoid_hsToVal
+  mHsToAlloc_ = mValFnRetVoid_hsToAlloc
+
+instance Marshal () where
+  type MarshalMode () = ValFnRetVoid
+  marshaller = MValFnRetVoid {
+    mValFnRetVoid_typeName = Tagged $ TypeName "",
+    mValFnRetVoid_hsToVal = \_ _ -> return (),
+    mValFnRetVoid_hsToAlloc = \_ f -> f nullPtr}
diff --git a/src/Graphics/QML/Internal/Objects.chs b/src/Graphics/QML/Internal/Objects.chs
deleted file mode 100644
--- a/src/Graphics/QML/Internal/Objects.chs
+++ /dev/null
@@ -1,143 +0,0 @@
-{-# LANGUAGE
-    ForeignFunctionInterface
-  #-}
-
-module Graphics.QML.Internal.Objects where
-
-import Foreign.C.Types
-import Foreign.Ptr
-import Foreign.ForeignPtr.Safe
-import Foreign.ForeignPtr.Unsafe
-import Foreign.StablePtr
-
-#include "hsqml.h"
-
-{#fun unsafe hsqml_get_next_class_id as ^
-  {} ->
-  `CInt' id #}
-
-type UniformFunc = Ptr () -> Ptr (Ptr ()) -> IO ()
-
-foreign import ccall "wrapper"  
-  marshalFunc :: UniformFunc -> IO (FunPtr UniformFunc)
-
-{#pointer *HsQMLClassHandle as ^ foreign newtype #}
-
-foreign import ccall "hsqml.h &hsqml_finalise_class_handle"
-  hsqmlFinaliseClassHandlePtr :: FunPtr (Ptr (HsQMLClassHandle) -> IO ())
-
-newClassHandle :: Ptr HsQMLClassHandle -> IO (Maybe HsQMLClassHandle)
-newClassHandle p =
-  if nullPtr == p
-    then return Nothing
-    else do
-      fp <- newForeignPtr hsqmlFinaliseClassHandlePtr p
-      return $ Just $ HsQMLClassHandle fp
-
-{#fun unsafe hsqml_create_class as ^
-  {id `Ptr CUInt',
-   id `Ptr CChar',
-   id `Ptr (FunPtr UniformFunc)',
-   id `Ptr (FunPtr UniformFunc)'} ->
-  `Maybe HsQMLClassHandle' newClassHandle* #}
-
-withMaybeHsQMLClassHandle ::
-    Maybe HsQMLClassHandle -> (Ptr HsQMLClassHandle -> IO b) -> IO b
-withMaybeHsQMLClassHandle (Just (HsQMLClassHandle fp)) = withForeignPtr fp
-withMaybeHsQMLClassHandle Nothing = \f -> f nullPtr
-
-withMaybeHsQMLObjectHandle ::
-    Maybe HsQMLObjectHandle -> (Ptr HsQMLObjectHandle -> IO b) -> IO b
-withMaybeHsQMLObjectHandle (Just (HsQMLObjectHandle fp)) = withForeignPtr fp
-withMaybeHsQMLObjectHandle Nothing = \f -> f nullPtr
-
-{#pointer *HsQMLObjectHandle as ^ foreign newtype #}
-
-foreign import ccall "hsqml.h &hsqml_finalise_object_handle"
-  hsqmlFinaliseObjectHandlePtr :: FunPtr (Ptr (HsQMLObjectHandle) -> IO ())
-
-newObjectHandle :: Ptr HsQMLObjectHandle -> IO HsQMLObjectHandle
-newObjectHandle p = do
-  fp <- newForeignPtr hsqmlFinaliseObjectHandlePtr p
-  return $ HsQMLObjectHandle fp
-
-isNullObjectHandle :: HsQMLObjectHandle -> Bool
-isNullObjectHandle (HsQMLObjectHandle fp) =
-  nullPtr == unsafeForeignPtrToPtr fp
-
--- | Represents an instance of the QML class which wraps the type @tt@.
-data ObjRef tt = ObjRef {
-  objHndl :: HsQMLObjectHandle
-}
-
-objToPtr :: a -> (Ptr () -> IO b) -> IO b
-objToPtr obj f = do
-  sPtr <- newStablePtr obj
-  res <- f $ castStablePtrToPtr sPtr
-  return res
-
-{#fun unsafe hsqml_create_object as ^
-  {objToPtr* `a',
-   withHsQMLClassHandle* `HsQMLClassHandle'} ->
-  `HsQMLObjectHandle' newObjectHandle* #}
-
-ptrToObj :: Ptr () -> IO a
-ptrToObj =
-  deRefStablePtr . castPtrToStablePtr
-
-{#fun unsafe hsqml_object_get_haskell as ^
-  {withHsQMLObjectHandle* `HsQMLObjectHandle'} ->
-  `a' ptrToObj* #}
-
-{#fun unsafe hsqml_object_get_pointer as ^
-  {withHsQMLObjectHandle* `HsQMLObjectHandle'} ->
-  `Ptr ()' id #}
-
-{#fun unsafe hsqml_get_object_handle as ^
-  {id `Ptr ()',
-   withMaybeHsQMLClassHandle* `Maybe HsQMLClassHandle'} ->
-  `HsQMLObjectHandle' newObjectHandle* #}
-
-ofDynamicMetaObject :: CUInt
-ofDynamicMetaObject = 0x01
-
-mfAccessPrivate, mfAccessProtected, mfAccessPublic, mfAccessMask,
-  mfMethodMethod, mfMethodSignal, mfMethodSlot, mfMethodConstructor,
-  mfMethodTypeMask, mfMethodCompatibility, mfMethodCloned, mfMethodScriptable
-  :: CUInt
-mfAccessPrivate   = 0x00
-mfAccessProtected = 0x01
-mfAccessPublic    = 0x02
-mfAccessMask      = 0x03
-mfMethodMethod      = 0x00
-mfMethodSignal      = 0x04
-mfMethodSlot        = 0x08
-mfMethodConstructor = 0x0c
-mfMethodTypeMask    = 0x0c
-mfMethodCompatibility = 0x10
-mfMethodCloned        = 0x20
-mfMethodScriptable    = 0x40
-
-pfInvalid, pfReadable, pfWritable, pfResettable, pfEnumOrFlag, pfStdCppSet,
-  pfConstant, pfFinal, pfDesignable, pfResolveDesignable, pfScriptable,
-  pfResolveScriptable, pfStored, pfResolveStored, pfEditable,
-  pfResolveEditable, pfUser, pfResolveUser, pfNotify :: CUInt
-pfInvalid           = 0x00000000
-pfReadable          = 0x00000001
-pfWritable          = 0x00000002
-pfResettable        = 0x00000004
-pfEnumOrFlag        = 0x00000008
-pfStdCppSet         = 0x00000100
-pfConstant          = 0x00000400
-pfFinal             = 0x00000800
-pfDesignable        = 0x00001000
-pfResolveDesignable = 0x00002000
-pfScriptable        = 0x00004000
-pfResolveScriptable = 0x00008000
-pfStored            = 0x00010000
-pfResolveStored     = 0x00020000
-pfEditable          = 0x00040000
-pfResolveEditable   = 0x00080000
-pfUser              = 0x00100000
-pfResolveUser       = 0x00200000
-pfNotify            = 0x00400000
diff --git a/src/Graphics/QML/Internal/Objects.hs b/src/Graphics/QML/Internal/Objects.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/QML/Internal/Objects.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE
+    ScopedTypeVariables,
+    TypeFamilies,
+    FlexibleContexts,
+    FlexibleInstances,
+    Rank2Types
+  #-}
+
+module Graphics.QML.Internal.Objects where
+
+import Graphics.QML.Internal.BindObj
+import Graphics.QML.Internal.Marshal
+
+import Data.Typeable
+import Data.Bits
+import Data.Char
+
+data MemberKind
+    = MethodMember
+    | PropertyMember
+    | SignalMember
+    deriving (Bounded, Enum, Eq)
+
+-- | Represents a named member of the QML class which wraps type @tt@.
+data Member tt = Member {
+    memberKind   :: MemberKind,
+    memberName   :: String,
+    memberType   :: TypeName,
+    memberParams :: [TypeName],
+    memberFun    :: UniformFunc,
+    memberFunAux :: Maybe UniformFunc,
+    memberKey    :: Maybe TypeRep
+}
+
+-- | Represents the API of the QML class which wraps the type @tt@.
+newtype ClassDef tt = ClassDef {
+    classMembers :: [Member tt]
+}
+
+-- | The class 'Object' allows Haskell types to expose an object-oriented
+-- interface to QML. 
+class (Typeable tt) => Object tt where
+  classDef :: ClassDef tt
+
+type MObjToHsFunc t = HsQMLObjectHandle -> IO t
+type MHsToObjFunc t = t -> IO HsQMLObjectHandle
+
+-- | Type function yielding the object type specified by a given 'MarshalMode'.
+type family ModeObj m
+
+-- | Type function yielding the object type speficied by a given marshallable
+-- type @tt@.
+type ThisObj tt = ModeObj (MarshalMode tt)
+
+-- | Class for 'MarshalMode's which support marshalling QML-to-Haskell
+-- in contexts specific to objects.
+class (MarshalBase m) => MarshalFromObj m where
+  mObjToHs_ :: forall t. Marshaller t m -> MObjToHsFunc t
+
+mObjToHs ::
+  forall t. (Marshal t, MarshalFromObj (MarshalMode t)) => MObjToHsFunc t
+mObjToHs = mObjToHs_ (marshaller :: Marshaller t (MarshalMode t))
+
+-- | Class for 'MarshalMode's which support marshalling Haskell-to-QML
+-- in contexts specific to objects.
+class (MarshalBase m) => MarshalToObj m where
+  mHsToObj_ :: forall t. Marshaller t m -> MHsToObjFunc t
+
+mHsToObj ::
+  forall t. (Marshal t, MarshalToObj (MarshalMode t)) => MHsToObjFunc t
+mHsToObj = mHsToObj_ (marshaller :: Marshaller t (MarshalMode t))
+
+-- | 'MarshalMode' for object types.
+data ValObjBidi a
+type instance ModeObj (ValObjBidi a) = a
+
+data instance Marshaller t (ValObjBidi a) = MValObjBidi {
+  mValObjBidi_typeName  :: !(MTypeNameFunc t),
+  mValObjBidi_valToHs   :: !(MValToHsFunc t),
+  mValObjBidi_hsToVal   :: !(MHsToValFunc t),
+  mValObjBidi_hsToAlloc :: !(MHsToAllocFunc t),
+  mValObjBidi_objToHs   :: !(MObjToHsFunc t),
+  mValObjBidi_hsToObj   :: !(MHsToObjFunc t)}
+
+instance MarshalBase (ValObjBidi a) where
+  mTypeName_ = mValObjBidi_typeName
+
+instance MarshalToHs (ValObjBidi a) where
+  mValToHs_ = mValObjBidi_valToHs
+
+instance MarshalToValRaw (ValObjBidi a) where
+  mHsToVal_   = mValObjBidi_hsToVal
+  mHsToAlloc_ = mValObjBidi_hsToAlloc
+
+instance MarshalToVal (ValObjBidi a) where
+
+instance MarshalToObj (ValObjBidi a) where
+  mHsToObj_ = mValObjBidi_hsToObj
+
+instance MarshalFromObj (ValObjBidi a) where
+  mObjToHs_ = mValObjBidi_objToHs
+
+-- | 'MarshalMode' for object types, operating only in the QML-to-Haskell
+-- direction.
+data ValObjToOnly a
+
+type instance ModeObj (ValObjToOnly a) = a
+
+data instance Marshaller t (ValObjToOnly a) = MValObjToOnly {
+  mValObjToOnly_typeName  :: !(MTypeNameFunc t),
+  mValObjToOnly_valToHs   :: !(MValToHsFunc t),
+  mValObjToOnly_objToHs   :: !(MObjToHsFunc t)}
+
+instance MarshalBase (ValObjToOnly a) where
+  mTypeName_ = mValObjToOnly_typeName
+
+instance MarshalToHs (ValObjToOnly a) where
+  mValToHs_ = mValObjToOnly_valToHs
+
+instance MarshalFromObj (ValObjToOnly a) where
+  mObjToHs_ = mValObjToOnly_objToHs
+
diff --git a/src/Graphics/QML/Internal/PrimValues.chs b/src/Graphics/QML/Internal/PrimValues.chs
deleted file mode 100644
--- a/src/Graphics/QML/Internal/PrimValues.chs
+++ /dev/null
@@ -1,82 +0,0 @@
-{-# LANGUAGE
-    ForeignFunctionInterface
-  #-}
-
-module Graphics.QML.Internal.PrimValues where
-
-import Foreign.C.Types
-import Foreign.C.String
-import Foreign.Ptr
-import Foreign.ForeignPtr
-import Foreign.Storable
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import System.IO.Unsafe
-
-#include "hsqml.h"
-
-cIntConv :: (Integral a, Integral b) => a -> b
-cIntConv = fromIntegral
-
---
--- String
---
-
-{#pointer *HsQMLStringHandle as ^ newtype #}
-
-{#fun unsafe hsqml_get_string_size as ^
-  {} ->
-  `Int' fromIntegral #}
-
-hsqmlStringSize :: Int
-hsqmlStringSize = unsafePerformIO $ hsqmlGetStringSize
-
-{#fun unsafe hsqml_init_string as ^
-  {id `HsQMLStringHandle'} ->
-  `()' #}
-
-{#fun unsafe hsqml_deinit_string as ^
-  {id `HsQMLStringHandle'} ->
-  `()' #}
-
-{#fun unsafe hsqml_marshal_string as ^
-  {`Int',
-   id `HsQMLStringHandle'} ->
-  `Ptr CUShort' id #}
-
-{#fun unsafe hsqml_unmarshal_string as ^
-  {id `HsQMLStringHandle',
-   id `Ptr (Ptr CUShort)'} ->
-  `Int' #}
-
---
--- URL
---
-
-{#pointer *HsQMLUrlHandle as ^ newtype #}
-
-{#fun unsafe hsqml_get_url_size as ^
-  {} ->
-  `Int' fromIntegral #}
-
-hsqmlUrlSize :: Int
-hsqmlUrlSize = unsafePerformIO $ hsqmlGetUrlSize
-
-{#fun unsafe hsqml_init_url as ^
-  {id `HsQMLUrlHandle'} ->
-  `()' #}
-
-{#fun unsafe hsqml_deinit_url as ^
-  {id `HsQMLUrlHandle'} ->
-  `()' #}
-
-{#fun unsafe hsqml_marshal_url as ^
-  {id `Ptr CChar',
-   `Int',
-   id `HsQMLUrlHandle'} ->
-  `()' #}
-
-{#fun unsafe hsqml_unmarshal_url as ^
-  {id `HsQMLUrlHandle',
-   id `Ptr (Ptr CChar)'} ->
-  `Int' #}
diff --git a/src/Graphics/QML/Marshal.hs b/src/Graphics/QML/Marshal.hs
--- a/src/Graphics/QML/Marshal.hs
+++ b/src/Graphics/QML/Marshal.hs
@@ -1,22 +1,35 @@
 {-# LANGUAGE
     ScopedTypeVariables,
+    TypeFamilies,
     TypeSynonymInstances,
     FlexibleInstances
   #-}
 
 -- | Type classs and instances for marshalling values between Haskell and QML.
 module Graphics.QML.Marshal (
-  MarshalIn (
-    mIn),
-  InMarshaller,
-  MarshalOut
+  Marshal (
+    type MarshalMode,
+    marshaller),
+  MarshalToHs,
+  MarshalToValRaw,
+  MarshalToVal,
+  MarshalFromObj,
+  MarshalToObj,
+  ValBidi,
+  ValFnRetVoid,
+  ValObjBidi,
+  ValObjToOnly,
+  ThisObj,
+  Marshaller 
 ) where
 
+import Graphics.QML.Internal.BindPrim
 import Graphics.QML.Internal.Marshal
-import Graphics.QML.Internal.PrimValues
+import Graphics.QML.Internal.Objects
 
 import Data.Maybe
 import Data.Tagged
+import Data.Int
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Foreign as T
@@ -32,88 +45,82 @@
     isUnescapedInURI)
 
 --
--- Int/int built-in type
+-- Int32/int built-in type
 --
 
-instance MarshalOut Int where
-  mOutFunc ptr int =
-    poke (castPtr ptr :: Ptr CInt) (fromIntegral int)
-  mOutAlloc num f =
-    alloca $ \(ptr :: Ptr CInt) ->
-      mOutFunc (castPtr ptr) num >> f (castPtr ptr)
-
-instance MarshalIn Int where
-  mIn = InMarshaller {
-    mInFuncFld = \ptr ->
+instance Marshal Int32 where
+  type MarshalMode Int32 = ValBidi
+  marshaller = MValBidi {
+    mValBidi_typeName = Tagged $ TypeName "int",
+    mValBidi_valToHs = \ptr ->
       errIO $ peek (castPtr ptr :: Ptr CInt) >>= return . fromIntegral,
-    mIOTypeFld = Tagged $ TypeName "int"
-  }
+    mValBidi_hsToVal = \int ptr ->
+      poke (castPtr ptr :: Ptr CInt) (fromIntegral int),
+    mValBidi_hsToAlloc = \int f ->
+      alloca $ \(ptr :: Ptr CInt) ->
+        mHsToVal int (castPtr ptr) >> f (castPtr ptr)}
 
+instance Marshal Int where
+  type MarshalMode Int = ValBidi
+  marshaller = MValBidi {
+    mValBidi_typeName = Tagged $ TypeName "int",
+    mValBidi_valToHs = fmap (fromIntegral :: Int32 -> Int) . mValToHs,
+    mValBidi_hsToVal = \int ptr -> mHsToVal (fromIntegral int :: Int32) ptr,
+    mValBidi_hsToAlloc = \int f -> mHsToAlloc (fromIntegral int :: Int32) f}
+
 --
 -- Double/double built-in type
 --
 
-instance MarshalOut Double where
-  mOutFunc ptr num =
-    poke (castPtr ptr :: Ptr CDouble) (realToFrac num)
-  mOutAlloc num f =
-    alloca $ \(ptr :: Ptr CDouble) ->
-      mOutFunc (castPtr ptr) num >> f (castPtr ptr)
-
-instance MarshalIn Double where
-  mIn = InMarshaller {
-    mInFuncFld = \ptr ->
+instance Marshal Double where
+  type MarshalMode Double = ValBidi
+  marshaller = MValBidi {
+    mValBidi_typeName = Tagged $ TypeName "double",
+    mValBidi_valToHs = \ptr ->
       errIO $ peek (castPtr ptr :: Ptr CDouble) >>= return . realToFrac,
-    mIOTypeFld = Tagged $ TypeName "double"
-  }
+    mValBidi_hsToVal = \num ptr ->
+      poke (castPtr ptr :: Ptr CDouble) (realToFrac num),
+    mValBidi_hsToAlloc = \num f ->
+      alloca $ \(ptr :: Ptr CDouble) ->
+        mHsToVal num (castPtr ptr) >> f (castPtr ptr)}
 
 --
 -- Text/QString built-in type
 --
 
-instance MarshalOut Text where
-  mOutFunc ptr txt = do
-    array <- hsqmlMarshalString
-        (T.lengthWord16 txt) (HsQMLStringHandle $ castPtr ptr)
-    T.unsafeCopyToPtr txt (castPtr array)
-  mOutAlloc txt f =
-    allocaBytes hsqmlStringSize $ \ptr -> do
-      hsqmlInitString $ HsQMLStringHandle ptr
-      mOutFunc (castPtr ptr) txt
-      ret <- f (castPtr ptr)
-      hsqmlDeinitString $ HsQMLStringHandle ptr
-      return ret
-
-instance MarshalIn Text where
-  mIn = InMarshaller {
-    mInFuncFld = \ptr -> errIO $ do
+instance Marshal Text where
+  type MarshalMode Text = ValBidi
+  marshaller = MValBidi {
+    mValBidi_typeName = Tagged $ TypeName "QString",
+    mValBidi_valToHs = \ptr -> errIO $ do
       pair <- alloca (\bufPtr -> do
         len <- hsqmlUnmarshalString (HsQMLStringHandle $ castPtr ptr) bufPtr
         buf <- peek bufPtr
         return (castPtr buf, fromIntegral len))
       uncurry T.fromPtr pair,
-    mIOTypeFld = Tagged $ TypeName "QString"
-  }
+    mValBidi_hsToVal = \txt ptr -> do
+      array <- hsqmlMarshalString
+          (T.lengthWord16 txt) (HsQMLStringHandle $ castPtr ptr)
+      T.unsafeCopyToPtr txt (castPtr array),
+    mValBidi_hsToAlloc = \txt f ->
+      allocaBytes hsqmlStringSize $ \ptr -> do
+        hsqmlInitString $ HsQMLStringHandle ptr
+        mHsToVal txt (castPtr ptr)
+        ret <- f (castPtr ptr)
+        hsqmlDeinitString $ HsQMLStringHandle ptr
+        return ret}
 
 --
 -- String/QString built-in type
 --
 
-instance MarshalOut String where
-  mOutFunc ptr str = mOutFunc ptr $ T.pack str
-  mOutAlloc txt f =
-    allocaBytes hsqmlStringSize $ \ptr -> do
-      hsqmlInitString $ HsQMLStringHandle ptr
-      mOutFunc (castPtr ptr) txt
-      ret <- f (castPtr ptr)
-      hsqmlDeinitString $ HsQMLStringHandle ptr
-      return ret
-
-instance MarshalIn String where
-  mIn = InMarshaller {
-    mInFuncFld = fmap T.unpack . mInFuncFld mIn,
-    mIOTypeFld = Tagged $ TypeName "QString"
-  }
+instance Marshal String where
+  type MarshalMode String = ValBidi
+  marshaller = MValBidi {
+    mValBidi_typeName = Tagged $ TypeName "QString",
+    mValBidi_valToHs = fmap T.unpack . mValToHs,
+    mValBidi_hsToVal = \txt ptr -> mHsToVal (T.pack txt) ptr,
+    mValBidi_hsToAlloc = \txt f -> mHsToAlloc (T.pack txt) f}
 
 --
 -- URI/QUrl built-in type
@@ -126,23 +133,11 @@
               Just $ URIAuth (f user) (f name) (f port)
           mapAuth Nothing = Nothing
 
-instance MarshalOut URI where
-  mOutFunc ptr uri =
-    let str = uriToString id (mapURIStrings
-                (escapeURIString isUnescapedInURI) uri) ""
-    in withCStringLen str (\(buf, bufLen) ->
-         hsqmlMarshalUrl buf bufLen (HsQMLUrlHandle $ castPtr ptr))
-  mOutAlloc uri f =
-    allocaBytes hsqmlUrlSize $ \ptr -> do
-      hsqmlInitUrl $ HsQMLUrlHandle ptr
-      mOutFunc (castPtr ptr) uri
-      ret <- f (castPtr ptr)
-      hsqmlDeinitUrl $ HsQMLUrlHandle ptr
-      return ret
-
-instance MarshalIn URI where
-  mIn = InMarshaller {
-    mInFuncFld = \ptr -> errIO $ do
+instance Marshal URI where
+  type MarshalMode URI = ValBidi
+  marshaller = MValBidi {
+    mValBidi_typeName = Tagged $ TypeName "QUrl",
+    mValBidi_valToHs = \ptr -> errIO $ do
       pair <- alloca (\bufPtr -> do
         len <- hsqmlUnmarshalUrl (HsQMLUrlHandle $ castPtr ptr) bufPtr
         buf <- peek bufPtr
@@ -151,5 +146,15 @@
       free $ fst pair
       return $ mapURIStrings unEscapeString $
         fromMaybe nullURI $ parseURIReference str,
-    mIOTypeFld = Tagged $ TypeName "QUrl"
-  }
+    mValBidi_hsToVal = \uri ptr ->
+      let str = uriToString id (mapURIStrings
+                  (escapeURIString isUnescapedInURI) uri) ""
+      in withCStringLen str (\(buf, bufLen) ->
+           hsqmlMarshalUrl buf bufLen (HsQMLUrlHandle $ castPtr ptr)),
+    mValBidi_hsToAlloc = \uri f ->
+      allocaBytes hsqmlUrlSize $ \ptr -> do
+        hsqmlInitUrl $ HsQMLUrlHandle ptr
+        mHsToVal uri (castPtr ptr)
+        ret <- f (castPtr ptr)
+        hsqmlDeinitUrl $ HsQMLUrlHandle ptr
+        return ret}
diff --git a/src/Graphics/QML/Objects.hs b/src/Graphics/QML/Objects.hs
--- a/src/Graphics/QML/Objects.hs
+++ b/src/Graphics/QML/Objects.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE
     ScopedTypeVariables,
     TypeFamilies,
-    FlexibleContexts
+    FlexibleContexts,
+    FlexibleInstances
   #-}
 
 -- | Facilities for defining new object types which can be marshalled between
@@ -22,33 +23,46 @@
   defPropertyRO,
   defPropertyRW,
 
+  -- * Signals
+  defSignal,
+  fireSignal,
+  SignalKey (
+    type SignalParams),
+  SignalSuffix,
+
   -- * Object References
   ObjRef,
   newObject,
   fromObjRef,
 
-  -- * Marshalling Type-classes
-  objectInMarshaller,
-  MarshalThis (
-    type ThisObj,
-    mThis),
-  objectThisMarshaller
+  -- * Dynamic Object References
+  AnyObjRef,
+  anyObjRef,
+  fromAnyObjRef,
+
+  -- * Customer Marshallers
+  objSimpleMarshaller,
+  objBidiMarshaller
 ) where
 
+import Graphics.QML.Internal.BindCore
+import Graphics.QML.Internal.BindObj
+import Graphics.QML.Internal.JobQueue
 import Graphics.QML.Internal.Marshal
 import Graphics.QML.Internal.Objects
-import Graphics.QML.Internal.Engine
 
+import Control.Concurrent.MVar
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.State
+import Control.Exception
 import Data.Bits
-import Data.Char
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe
 import Data.Tagged
 import Data.Typeable
+import Data.IORef
 import Foreign.C.Types
 import Foreign.C.String
 import Foreign.Ptr
@@ -59,392 +73,558 @@
 import Numeric
 
 --
--- ObjRef
+-- Counted Reverse List
 --
 
--- | The class 'MarshalThis' allows objects to be marshalled back into
--- Haskell as the \"this\" value for callbacks.
-class (Object (ThisObj tt)) => MarshalThis tt where
-  type ThisObj tt
-  mThis :: ThisMarshaller tt
-
--- | Encapsulates the functionality to needed to implement an instance of
--- 'MarshalThis' so that such instances can be defined without access to
--- implementation details.
-data ThisMarshaller tt = ThisMarshaller {
-  mThisFuncFld :: Ptr () -> IO tt
+data CRList a = CRList {
+  crlLen  :: !Int,
+  crlList :: [a]
 }
 
-mThisFunc :: (MarshalThis tt) => Ptr () -> IO tt
-mThisFunc = mThisFuncFld mThis
-
-instance (Object tt) => MarshalOut (ObjRef tt) where
-  mOutFunc ptr obj = do
-    objPtr <- hsqmlObjectGetPointer $ objHndl obj
-    poke (castPtr ptr) objPtr
-  mOutAlloc obj f =
-    alloca $ \(ptr :: Ptr (Ptr ())) ->
-      mOutFunc (castPtr ptr) obj >> f (castPtr ptr)
-
-instance (Object tt) => MarshalIn (ObjRef tt) where
-  mIn = InMarshaller {
-    mInFuncFld = \ptr -> MaybeT $ do
-      objPtr <- peek (castPtr ptr)
-      hndl <- hsqmlGetObjectHandle objPtr $
-        Just $ classHndl (classDefCAF :: ClassDef tt)
-      return $ if isNullObjectHandle hndl
-        then Nothing else Just $ ObjRef hndl,
-    mIOTypeFld = Tagged $ TypeName "QObject*"
-  }
+crlEmpty :: CRList a
+crlEmpty = CRList 0 []
 
-instance (Object tt) => MarshalThis (ObjRef tt) where
-  type ThisObj (ObjRef tt) = tt
-  mThis = ThisMarshaller {
-      mThisFuncFld = \ptr -> do
-      hndl <- hsqmlGetObjectHandle ptr Nothing
-      return $ ObjRef hndl
-  }
+crlAppend1 :: CRList a -> a -> CRList a
+crlAppend1 (CRList n xs) x = CRList (n+1) (x:xs)
 
-retagType :: Tagged (ObjRef tt) TypeName -> Tagged tt TypeName
-retagType = retag
+crlAppend :: CRList a -> [a] -> CRList a
+crlAppend (CRList n xs) ys = CRList n' xs'
+  where (xs', n')       = rev ys xs n
+        rev []     vs n = (vs, n)
+        rev (u:us) vs n = rev us (u:vs) (n+1)
 
--- | Provides an 'InMarshaller' which allows you to define instances of
--- 'MarshalIn' for custom object types. For example:
 --
--- @
--- instance MarshalIn MyObjectType where
---     mIn = objectInMarshaller
--- @
+-- ObjRef
 --
--- This instance would allow @MyObjectType@ to be used as a parameter type
--- in callbacks. An instance is provided for @'ObjRef' MyObjectType@ by
--- default.
-objectInMarshaller :: (Object tt) => InMarshaller tt
-objectInMarshaller =
-  InMarshaller {
-    mInFuncFld = fmap fromObjRef . mInFunc,
-    mIOTypeFld = retagType mIOType
-  }
 
--- | Provides an 'ThisMarshaller' which allows you to define instances of
--- 'MarshalThis' for custom object types. For example:
---
--- @
--- instance MarshalThis MyObjectType where
---     type (ThisObj MyObjectType) = MyObjectType
---     mIn = objectInMarshaller
--- @
---
--- This instance would allow @MyObjectType@ to be used as the \"this\" type
--- for callbacks. An instance is provided for @'ObjRef' MyObjectType@ by
--- default.
-objectThisMarshaller :: (Object tt, (ThisObj tt) ~ tt) => ThisMarshaller tt
-objectThisMarshaller =
-  ThisMarshaller {
-    mThisFuncFld = fmap fromObjRef . mThisFunc
-  }
+-- | Represents an instance of the QML class which wraps the type @tt@.
+data ObjRef tt = ObjRef {
+  objHndl :: HsQMLObjectHandle
+}
 
+instance (Object tt) => Marshal (ObjRef tt) where
+  type MarshalMode (ObjRef tt) = ValObjBidi tt
+  marshaller = MValObjBidi {
+    mValObjBidi_typeName = Tagged $ TypeName "QObject*",
+    mValObjBidi_valToHs = \ptr -> do
+      any <- mValToHs ptr
+      MaybeT $ return $ fromAnyObjRef any,
+    mValObjBidi_hsToVal = \obj ptr ->
+      mHsToVal (AnyObjRef $ objHndl obj) ptr,
+    mValObjBidi_hsToAlloc = \obj f ->
+      mHsToAlloc (AnyObjRef $ objHndl obj) f,
+    mValObjBidi_objToHs = \hndl ->
+      return $ ObjRef hndl,
+    mValObjBidi_hsToObj = \obj ->
+      return $ objHndl obj}
+
 -- | Creates an instance of a QML class given a value of the underlying Haskell 
 -- type @tt@.
 newObject :: forall tt. (Object tt) => tt -> IO (ObjRef tt)
 newObject obj = do
-  hndl <- hsqmlCreateObject obj $ classHndl (classDefCAF :: ClassDef tt)
-  return $ ObjRef hndl
+  cRec <- getClassRec (classDef :: ClassDef tt)
+  oHndl <- hsqmlCreateObject obj $ crecHndl cRec
+  return $ ObjRef oHndl
 
 -- | Returns the associated value of the underlying Haskell type @tt@ from an
 -- instance of the QML class which wraps it.
 fromObjRef :: ObjRef tt -> tt
 fromObjRef =
-    unsafePerformIO . hsqmlObjectGetHaskell . objHndl
+    unsafePerformIO . fromObjRefIO
 
+fromObjRefIO :: ObjRef tt -> IO tt
+fromObjRefIO =
+    hsqmlObjectGetHaskell . objHndl 
+
+-- | Represents an instance of a QML class which wraps an arbitrary Haskell
+-- type. Unlike 'ObjRef', an 'AnyObjRef' only carries the type of its Haskell
+-- value dynamically and does not encode it into the static type.
+data AnyObjRef = AnyObjRef {
+  anyObjHndl :: HsQMLObjectHandle
+}
+
+instance Marshal AnyObjRef where
+  type MarshalMode AnyObjRef = ValObjBidi ()
+  marshaller = MValObjBidi {
+    mValObjBidi_typeName = Tagged $ TypeName "QObject*",
+    mValObjBidi_valToHs = \ptr -> MaybeT $ do
+      objPtr <- peek (castPtr ptr)
+      hndl <- hsqmlGetObjectHandle objPtr
+      return $ if isNullObjectHandle hndl
+        then Nothing else Just $ AnyObjRef hndl,
+    mValObjBidi_hsToVal = \obj ptr -> do
+      objPtr <- hsqmlObjectGetPointer $ anyObjHndl obj
+      poke (castPtr ptr) objPtr,
+    mValObjBidi_hsToAlloc = \obj f ->
+      alloca $ \(ptr :: Ptr (Ptr ())) ->
+        flip mHsToVal (castPtr ptr) obj >> f (castPtr ptr),
+    mValObjBidi_objToHs = \hndl ->
+      return $ AnyObjRef hndl,
+    mValObjBidi_hsToObj = \obj ->
+      return $ anyObjHndl obj}
+
+-- | Upcasts an 'ObjRef' into an 'AnyObjRef'.
+anyObjRef :: ObjRef tt -> AnyObjRef
+anyObjRef (ObjRef hndl) = AnyObjRef hndl
+
+-- | Attempts to downcast an 'AnyObjRef' into an 'ObjRef' with the specific
+-- underlying Haskell type @tt@.
+fromAnyObjRef :: (Object tt) => AnyObjRef -> Maybe (ObjRef tt)
+fromAnyObjRef = unsafePerformIO . fromAnyObjRefIO
+
+fromAnyObjRefIO :: forall tt. (Object tt) => AnyObjRef -> IO (Maybe (ObjRef tt))
+fromAnyObjRefIO (AnyObjRef hndl) = do
+    let srcRep = typeOf (undefined :: tt)
+    dstRep <- hsqmlObjectGetHsTyperep hndl
+    if srcRep == dstRep
+        then return $ Just $ ObjRef hndl
+        else return Nothing
+
+-- | Provides a QML-to-Haskell 'Marshaller' which allows you to define
+-- instances of 'Marshal' for custom 'Object' types. This allows a custom types
+-- to be passed into Haskell code as method parameters without having to
+-- manually deal with 'ObjRef's.
 --
--- Object
+-- For example, an instance for 'MyObjectType' would be defined as follows:
 --
-
--- | The class 'Object' allows Haskell types to expose an object-oriented
--- interface to QML. 
-class (Typeable tt) => Object tt where
-  classDef :: ClassDef tt
+-- @
+-- instance Marshal MyObjectType where
+--     type MarshalMode MyObjectType = ValObjToOnly MyObjectType
+--     marshaller = objSimpleMarshaller
+-- @
+objSimpleMarshaller ::
+  forall obj. (Object obj) => Marshaller obj (ValObjToOnly obj)
+objSimpleMarshaller = MValObjToOnly {
+  mValObjToOnly_typeName = retag (mTypeName :: Tagged (ObjRef obj) TypeName),
+  mValObjToOnly_valToHs = \ptr -> (errIO . fromObjRefIO) =<< mValToHs ptr,
+  mValObjToOnly_objToHs = hsqmlObjectGetHaskell}
 
--- | Uninlinable version of classDef to try and ensure that class definitions
--- get stored as constant applicable forms.
-{-# NOINLINE classDefCAF #-}
-classDefCAF :: (Object tt) => ClassDef tt
-classDefCAF = classDef
+-- | Provides a bidirectional QML-to-Haskell and Haskell-to-QML 'Marshaller'
+-- which allows you to define instances of 'Marshal' for custom object types.
+-- This allows a custom type to be passed in and out of Haskell code via
+-- methods, properties, and signals, without having to manually deal with
+-- 'ObjRef's. Unlike the simple marshaller, this one must be given a function
+-- which specifies how to obtain an 'ObjRef' given a Haskell value.
+--
+-- For example, an instance for 'MyObjectType' which simply creates a new
+-- object whenever one is required would be defined as follows:
+--
+-- @
+-- instance Marshal MyObjectType where
+--     type MarshalMode MyObjectType = ValObjBidi MyObjectType
+--     marshaller = objBidiMarshaller newObject
+-- @
+objBidiMarshaller ::
+  forall obj. (Object obj) =>
+  (obj -> IO (ObjRef obj)) -> Marshaller obj (ValObjBidi obj) 
+objBidiMarshaller newFn = MValObjBidi {
+  mValObjBidi_typeName = retag (mTypeName :: Tagged (ObjRef obj) TypeName),
+  mValObjBidi_valToHs = \ptr -> (errIO . fromObjRefIO) =<< mValToHs ptr,
+  mValObjBidi_hsToVal = \obj ptr -> flip mHsToVal ptr =<< newFn obj,
+  mValObjBidi_hsToAlloc = \obj f -> flip mHsToAlloc f =<< newFn obj,
+  mValObjBidi_objToHs = hsqmlObjectGetHaskell,
+  mValObjBidi_hsToObj = fmap objHndl . newFn}
 
 --
 -- ClassDef
 --
 
--- | Represents the API of the QML class which wraps the type @tt@.
-data ClassDef tt = ClassDef {
-  classType :: TypeName,
-  classHndl :: HsQMLClassHandle
-}
-
 -- | Generates a 'ClassDef' from a list of 'Member's.
 defClass :: forall tt. (Object tt) => [Member tt] -> ClassDef tt
-defClass ms = unsafePerformIO $ do
-  let typ  = typeOf (undefined :: tt)
-      con  = typeRepTyCon typ
-      name = showString (tyConModule con) $ showChar '.' $ tyConName con
-  id <- hsqmlGetNextClassId
-  createClass (showString name $ showChar '_' $ showInt id "") ms
+defClass = ClassDef
 
-createClass :: forall tt. (Object tt) =>
-  String -> [Member tt] -> IO (ClassDef tt)
-createClass name ms = do
-  let methods = methodMembers ms
-      properties = propertyMembers ms
-      (MOCOutput metaData metaStrData) = compileClass name methods properties
-  metaDataPtr <- newArray metaData
-  metaStrDataPtr <- newArray metaStrData
-  methodsPtr <- mapM (marshalFunc . methodFunc) methods >>= newArray
-  pReads <- mapM (marshalFunc . propertyReadFunc) properties
-  pWrites <- mapM (fromMaybe (return nullFunPtr) . fmap marshalFunc .
-    propertyWriteFunc) properties
-  propertiesPtr <- newArray $ interleave pReads pWrites
+data MemoStore k v = MemoStore (MVar (Map k v)) (IORef (Map k v))
+
+newMemoStore :: IO (MemoStore k v)
+newMemoStore = do
+    let m = Map.empty
+    mr <- newMVar m
+    ir <- newIORef m
+    return $ MemoStore mr ir
+
+getFromMemoStore :: (Ord k) => MemoStore k v -> k -> IO v -> IO (Bool, v)
+getFromMemoStore (MemoStore mr ir) key fn = do
+    fstMap <- readIORef ir
+    case Map.lookup key fstMap of
+        Just val -> return (False, val)
+        Nothing  -> modifyMVar mr $ \sndMap -> do
+            case Map.lookup key sndMap of
+                Just val -> return (sndMap, (False, val))
+                Nothing  -> do
+                    val <- fn
+                    let newMap = Map.insert key val sndMap
+                    writeIORef ir newMap
+                    return (newMap, (True, val))
+
+data ClassRec = ClassRec {
+    crecHndl :: HsQMLClassHandle,
+    crecSigs :: Map TypeRep Int
+}
+
+{-# NOINLINE classRecDb #-}
+classRecDb :: MemoStore TypeRep ClassRec
+classRecDb = unsafePerformIO $ newMemoStore
+
+getClassRec :: forall tt. (Object tt) => ClassDef tt -> IO ClassRec
+getClassRec cdef = do
+    let typ = typeOf (undefined :: tt)
+    (_, val) <- getFromMemoStore classRecDb typ (createClass typ cdef)
+    return val
+
+createClass :: forall tt. (Object tt) => TypeRep -> ClassDef tt -> IO ClassRec
+createClass typRep cdef = do
   hsqmlInit
-  hndl <- hsqmlCreateClass metaDataPtr metaStrDataPtr methodsPtr propertiesPtr
-  return $ case hndl of 
-    Just hndl' -> ClassDef (TypeName name) hndl'
-    Nothing    -> error ("Failed to create QML class '"++name++"'.")
+  classId <- hsqmlGetNextClassId
+  let constrs t = typeRepTyCon t : (concatMap constrs $ typeRepArgs t)
+      name = foldr (\c s -> showString (tyConName c) .
+          showChar '_' . s) id (constrs typRep) $ showInt classId ""
+      ms = classMembers cdef
+      moc = compileClass name ms
+      sigs = filterMembers SignalMember ms
+      sigMap = Map.fromList $ flip zip [0..] $ map (fromJust . memberKey) sigs
+      maybeMarshalFunc = maybe (return nullFunPtr) marshalFunc
+  metaDataPtr <- crlToNewArray return (mData moc)
+  metaStrDataPtr <- crlToNewArray return (mStrData moc)
+  methodsPtr <- crlToNewArray maybeMarshalFunc (mFuncMethods moc)
+  propsPtr <- crlToNewArray maybeMarshalFunc (mFuncProperties moc)
+  maybeHndl <- hsqmlCreateClass
+      metaDataPtr metaStrDataPtr typRep methodsPtr propsPtr
+  case maybeHndl of
+      Just hndl -> return $ ClassRec hndl sigMap
+      Nothing -> error ("Failed to create QML class '"++name++"'.")
 
-interleave :: [a] -> [a] -> [a]
-interleave [] ys = ys
-interleave (x:xs) ys = x : ys `interleave` xs 
+crlToNewArray :: (Storable b) => (a -> IO b) -> CRList a -> IO (Ptr b)
+crlToNewArray f (CRList len lst) = do
+  ptr <- mallocArray len
+  pokeRev ptr lst len
+  return ptr
+  where pokeRev _ []     _ = return ()
+        pokeRev p (x:xs) n = do
+          let n' = n-1
+          x' <- f x
+          pokeElemOff p n' x'
+          pokeRev p xs n'
 
 --
 -- Member
 --
 
--- | Represents a named member of the QML class which wraps type @tt@.
-data Member tt
-  -- | Constructs a 'Member' from a 'Method'.
-  = MethodMember (Method tt)
-  -- | Constructs a 'Member' from a 'Property'.
-  | PropertyMember (Property tt)
-
--- | Returns the methods in a list of members.
-methodMembers :: [Member tt] -> [Method tt]
-methodMembers = mapMaybe f
-  where f (MethodMember m) = Just m
-        f _ = Nothing
-
--- | Returns the properties in a list of members.
-propertyMembers :: [Member tt] -> [Property tt]
-propertyMembers = mapMaybe f
-  where f (PropertyMember m) = Just m
-        f _ = Nothing
+filterMembers :: MemberKind -> [Member tt] -> [Member tt]
+filterMembers k ms =
+  filter (\m -> k == memberKind m) ms
 
 --
 -- Method
 --
 
--- | Represents a named method which can be invoked from QML on an object of
--- type @tt@.
-data Method tt = Method {
-  -- | Gets the name of a 'Method'.
-  methodName  :: String,
-  -- | Gets the 'TypeName's which comprise the signature of a 'Method'.
-  -- The head of the list is the return type and the tail the arguments.
-  methodTypes :: [TypeName],
-  methodFunc  :: UniformFunc
+data MethodTypeInfo = MethodTypeInfo {
+  methodParamTypes :: [TypeName],
+  methodReturnType :: TypeName
 }
 
-data CrudeMethodTypes = CrudeMethodTypes {
-    methodParamTypes :: [TypeName],
-    methodReturnType :: TypeName
-  }
-
-crudeTypesToList :: CrudeMethodTypes -> [TypeName]
-crudeTypesToList (CrudeMethodTypes p r) = r:p
+newtype MSHelp a = MSHelp a
 
 -- | Supports marshalling Haskell functions with an arbitrary number of
 -- arguments.
 class MethodSuffix a where
   mkMethodFunc  :: Int -> a -> Ptr (Ptr ()) -> ErrIO ()
-  mkMethodTypes :: Tagged a CrudeMethodTypes
+  mkMethodTypes :: Tagged a MethodTypeInfo
 
-instance (MarshalIn a, MethodSuffix b) => MethodSuffix (a -> b) where
-  mkMethodFunc n f pv = do
+instance (Marshal a, MarshalToHs (MarshalMode a), MethodSuffix (MSHelp b)) =>
+  MethodSuffix (MSHelp (a -> b)) where
+  mkMethodFunc n (MSHelp f) pv = do
     ptr <- errIO $ peekElemOff pv n
-    val <- mInFunc ptr
-    mkMethodFunc (n+1) (f val) pv
+    val <- mValToHs ptr
+    mkMethodFunc (n+1) (MSHelp $ f val) pv
     return ()
   mkMethodTypes =
-    let (CrudeMethodTypes p r) =
-          untag (mkMethodTypes :: Tagged b CrudeMethodTypes)
-        ty = untag (mIOType :: Tagged a TypeName)
-    in Tagged $ CrudeMethodTypes (ty:p) r
+    let (MethodTypeInfo p r) =
+          untag (mkMethodTypes :: Tagged (MSHelp b) MethodTypeInfo)
+        typ = untag (mTypeName :: Tagged a TypeName)
+    in Tagged $ MethodTypeInfo (typ:p) r
 
-instance (MarshalOut a) => MethodSuffix (IO a) where
-  mkMethodFunc _ f pv = errIO $ do
+instance (Marshal a, MarshalToValRaw (MarshalMode a)) =>
+  MethodSuffix (MSHelp (IO a)) where
+  mkMethodFunc _ (MSHelp f) pv = errIO $ do
     ptr <- peekElemOff pv 0
     val <- f
     if nullPtr == ptr
     then return ()
-    else mOutFunc ptr val
+    else mHsToVal val ptr
   mkMethodTypes =
-    let ty = untag (mIOType :: Tagged a TypeName)
-    in Tagged $ CrudeMethodTypes [] ty
+    let typ = untag (mTypeName :: Tagged a TypeName)
+    in Tagged $ MethodTypeInfo [] typ
 
-mkUniformFunc :: forall tt ms. (MarshalThis tt, MethodSuffix ms) =>
+mkUniformFunc :: forall tt ms.
+  (Marshal tt, MarshalFromObj (MarshalMode tt), MethodSuffix (MSHelp ms)) =>
   (tt -> ms) -> UniformFunc
 mkUniformFunc f = \pt pv -> do
-  this <- mThisFunc pt
-  runErrIO $ mkMethodFunc 1 (f this) pv
+  hndl <- hsqmlGetObjectHandle pt
+  this <- mObjToHs hndl
+  runErrIO $ mkMethodFunc 1 (MSHelp $ f this) pv
 
+newtype VoidIO = VoidIO {runVoidIO :: (IO ())}
+
+instance MethodSuffix (MSHelp VoidIO) where
+    mkMethodFunc _ (MSHelp f) pv = errIO $ runVoidIO f
+    mkMethodTypes = Tagged $ MethodTypeInfo [] (TypeName "")
+
+class IsVoidIO a
+instance (IsVoidIO b) => IsVoidIO (a -> b)
+instance IsVoidIO VoidIO
+
+mkSpecialFunc :: forall tt ms.
+    (Marshal tt, MarshalFromObj (MarshalMode tt), MethodSuffix (MSHelp ms),
+        IsVoidIO ms) => (tt -> ms) -> UniformFunc
+mkSpecialFunc f = \pt pv -> do
+    hndl <- hsqmlGetObjectHandle pt
+    this <- mObjToHs hndl
+    runErrIO $ mkMethodFunc 0 (MSHelp $ f this) pv
+
 -- | Defines a named method using a function @f@ in the IO monad.
 --
 -- The first argument to @f@ receives the \"this\" object and hence must match
 -- the type of the class on which the method is being defined. Subsequently,
 -- there may be zero or more parameter arguments followed by an optional return
--- argument in the IO monad. These argument types must be members of the
--- 'MarshalThis', 'MarshalIn', and 'MarshalOut' typeclasses respectively.
-
-defMethod ::
-  forall tt ms. (MarshalThis tt, MethodSuffix ms) =>
+-- argument in the IO monad.
+defMethod :: forall tt ms.
+  (Marshal tt, MarshalFromObj (MarshalMode tt), MethodSuffix (MSHelp ms)) =>
   String -> (tt -> ms) -> Member (ThisObj tt)
-defMethod name f = MethodMember $ Method name
-  (crudeTypesToList $ untag (mkMethodTypes :: Tagged ms CrudeMethodTypes))
-  (mkUniformFunc f)
+defMethod name f =
+  let crude = untag (mkMethodTypes :: Tagged (MSHelp ms) MethodTypeInfo)
+  in Member MethodMember
+       name
+       (methodReturnType crude)
+       (methodParamTypes crude)
+       (mkUniformFunc f)
+       Nothing
+       Nothing
 
 --
 -- Property
 --
 
--- | Represents a named property which can be accessed from QML on an object
--- of type @tt@.
-data Property tt = Property {
-  -- | Gets the name of a 'Property'.
-  propertyName :: String,
-  propertyType :: TypeName,
-  propertyReadFunc :: UniformFunc,
-  propertyWriteFunc :: Maybe UniformFunc
-}
-
 -- | Defines a named read-only property using an accessor function in the IO
 -- monad.
 defPropertyRO ::
-  forall tt tr. (MarshalThis tt, MarshalOut tr) =>
+  forall tt tr. (Marshal tt, MarshalFromObj (MarshalMode tt),
+    Marshal tr, MarshalToVal (MarshalMode tr)) =>
   String -> (tt -> IO tr) -> Member (ThisObj tt)
-defPropertyRO name g = PropertyMember $ Property name
-  (untag (mIOType :: Tagged tr TypeName))
+defPropertyRO name g = Member PropertyMember
+  name
+  (untag (mTypeName :: Tagged tr TypeName))
+  []
   (mkUniformFunc g)
   Nothing
+  Nothing
 
 -- | Defines a named read-write property using a pair of accessor and mutator
 -- functions in the IO monad.
 defPropertyRW ::
-  forall tt tr. (MarshalThis tt, MarshalOut tr) =>
+  forall tt tr. (Marshal tt, MarshalFromObj (MarshalMode tt),
+    Marshal tr, MarshalToHs (MarshalMode tr), MarshalToVal (MarshalMode tr)) =>
   String -> (tt -> IO tr) -> (tt -> tr -> IO ()) -> Member (ThisObj tt)
-defPropertyRW name g s = PropertyMember $ Property name
-  (untag (mIOType :: Tagged tr TypeName))
+defPropertyRW name g s = Member PropertyMember
+  name
+  (untag (mTypeName :: Tagged tr TypeName))
+  []
   (mkUniformFunc g)
-  (Just $ mkUniformFunc s)
+  (Just $ mkSpecialFunc (\a b -> VoidIO $ s a b))
+  Nothing
 
 --
+-- Signal
+--
+
+data SignalTypeInfo = SignalTypeInfo {
+  signalParamTypes :: [TypeName]
+}
+
+-- | Defines a named signal using a 'SignalKey'.
+defSignal ::
+  forall obj sk. (Object obj, SignalKey sk) => Tagged sk String -> Member obj
+defSignal tn =
+  let crude = untag (mkSignalTypes :: Tagged (SignalParams sk) SignalTypeInfo)
+  in Member SignalMember
+       (untag tn)
+       (TypeName "")
+       (signalParamTypes crude)
+       (\_ _ -> return ())
+       Nothing
+       (Just $ typeOf (undefined :: sk))
+
+-- | Fires a signal on an 'Object', specified using a 'SignalKey'.
+fireSignal ::
+    forall tt sk. (
+        Marshal tt, MarshalToObj (MarshalMode tt),
+        Object (ThisObj tt), SignalKey sk) =>
+    Tagged sk tt -> SignalParams sk 
+fireSignal this =
+   let start cnt = do
+           crec <- getClassRec (classDef :: ClassDef (ThisObj tt))
+           let keyRep = typeOf (undefined :: sk)
+               slotMay = Map.lookup keyRep $ crecSigs crec
+           case slotMay of
+                Just slotIdx -> postJob $ do
+                    hndl <- mHsToObj $ untag this
+                    withActiveObject hndl $ cnt $ SignalData hndl slotIdx
+                Nothing ->
+                    error ("Attempt to fire undefined signal on class '"++
+                    (typeName $ untag (mTypeName :: Tagged tt TypeName))++"'.")
+       cont ps (SignalData hndl slotIdx) =
+           withArray (nullPtr:ps) (\pptr ->
+                hsqmlFireSignal hndl slotIdx pptr)
+    in mkSignalArgs start cont
+
+data SignalData = SignalData HsQMLObjectHandle Int
+
+-- | Instances of the 'SignalKey' class identify distinct signals. The
+-- associated 'SignalParams' type specifies the signal's signature.
+class (SignalSuffix (SignalParams sk), Typeable sk) => SignalKey sk where
+  type SignalParams sk
+
+-- | Supports marshalling an arbitrary number of arguments into a QML signal.
+class SignalSuffix ss where
+    mkSignalArgs  :: forall usr.
+        ((usr -> IO ()) -> IO ()) -> ([Ptr ()] -> usr -> IO ()) -> ss
+    mkSignalTypes :: Tagged ss SignalTypeInfo
+
+instance (Marshal a, MarshalToVal (MarshalMode a), SignalSuffix b) =>
+    SignalSuffix (a -> b) where
+    mkSignalArgs start cont param =
+        mkSignalArgs start (\ps usr ->
+            mHsToAlloc param (\ptr ->
+                cont (ptr:ps) usr))
+    mkSignalTypes =
+        let (SignalTypeInfo p) =
+                untag (mkSignalTypes :: Tagged b SignalTypeInfo)
+            typ = untag (mTypeName :: Tagged a TypeName)
+        in Tagged $ SignalTypeInfo (typ:p)
+
+instance SignalSuffix (IO ()) where
+    mkSignalArgs start cont =
+        start $ cont []
+    mkSignalTypes =
+        Tagged $ SignalTypeInfo []
+
+--
 -- Meta Object Compiler
 --
 
 data MOCState = MOCState {
-  mData            :: [CUInt],
-  mDataLen         :: Int,
+  mData            :: CRList CUInt,
   mDataMethodsIdx  :: Maybe Int,
   mDataPropsIdx    :: Maybe Int,
-  mStrData         :: [CChar],
-  mStrDataLen      :: Int,
-  mStrDataMap      :: Map String CUInt
-} deriving Show
+  mStrData         :: CRList CChar,
+  mStrDataMap      :: Map String CUInt,
+  mFuncMethods     :: CRList (Maybe UniformFunc),
+  mFuncProperties  :: CRList (Maybe UniformFunc),
+  mMethodCount     :: Int,
+  mSignalCount     :: Int,
+  mPropertyCount   :: Int
+}
 
-data MOCOutput = MOCOutput [CUInt] [CChar]
+-- | Generate MOC meta-data from a class name and member list.
+compileClass :: String -> [Member tt] -> MOCState
+compileClass name ms = 
+  let enc = flip execState newMOCState $ do
+        writeInt 5                           -- Revision
+        writeString name                     -- Class name
+        writeInt 0 >> writeInt 0             -- Class info
+        writeIntegral $
+          mMethodCount enc +
+          mSignalCount enc                   -- Methods
+        writeIntegral $
+          fromMaybe 0 $ mDataMethodsIdx enc  -- Methods (data index)
+        writeIntegral $ mPropertyCount enc   -- Properties
+        writeIntegral $
+          fromMaybe 0 $ mDataPropsIdx enc    -- Properties (data index)
+        writeInt 0 >> writeInt 0             -- Enums
+        writeInt 0 >> writeInt 0             -- Constructors
+        writeInt 0                           -- Flags
+        writeIntegral $ mSignalCount enc     -- Signals
+        mapM_ writeMethod $ filterMembers SignalMember ms
+        mapM_ writeMethod $ filterMembers MethodMember ms
+        mapM_ writeProperty $ filterMembers PropertyMember ms
+        writeInt 0
+  in enc
 
 newMOCState :: MOCState
-newMOCState = MOCState [] 0 Nothing Nothing [] 0 Map.empty
+newMOCState =
+  MOCState crlEmpty Nothing Nothing crlEmpty Map.empty crlEmpty crlEmpty 0 0 0
 
 writeInt :: CUInt -> State MOCState ()
 writeInt int = do
   state <- get
-  let md    = mData state
-      mdLen = mDataLen state
-  put $ state {mData = int:md, mDataLen = mdLen+1}
+  put $ state {mData = mData state `crlAppend1` int}
   return ()
 
+writeIntegral :: (Integral a) => a -> State MOCState ()
+writeIntegral int =
+  writeInt (fromIntegral int)
+
 writeString :: String -> State MOCState ()
 writeString str = do
   state <- get
   let msd    = mStrData state
-      msdLen = mStrDataLen state
       msdMap = mStrDataMap state
   case (Map.lookup str msdMap) of
     Just idx -> writeInt idx
     Nothing  -> do
-      let idx = fromIntegral msdLen
-          msd' = 0 : (map castCharToCChar (reverse str) ++ msd)
-          msdLen' = msdLen + length str + 1
-          msdMap' = Map.insert str idx msdMap
+      let idx = crlLen msd
+          msd' = msd `crlAppend` (map castCharToCChar str) `crlAppend1` 0
+          msdMap' = Map.insert str (fromIntegral idx) msdMap
       put $ state {
         mStrData = msd',
-        mStrDataLen = msdLen',
         mStrDataMap = msdMap'}
-      writeInt idx
+      writeIntegral idx
 
-writeMethod :: Method tt -> State MOCState ()
+writeMethod :: Member tt -> State MOCState ()
 writeMethod m = do
-  idx <- get >>= return . mDataLen
+  idx <- get >>= return . crlLen . mData
   writeString $ methodSignature m
   writeString $ methodParameters m
-  writeString $ typeName $ head $ methodTypes m
+  writeString $ typeName $ memberType m
   writeString ""
-  writeInt (mfAccessPublic .|. mfMethodScriptable)
+  let (mc,sc,flags) = case memberKind m of
+        SignalMember -> (0,1,mfMethodSignal)
+        _            -> (1,0,0)
+  writeInt (mfAccessPublic .|. mfMethodScriptable .|. flags)
   state <- get
-  put $ state {mDataMethodsIdx = mplus (mDataMethodsIdx state) (Just idx)}
+  put $ state {
+    mDataMethodsIdx = mplus (mDataMethodsIdx state) (Just idx),
+    mMethodCount = mc + (mMethodCount state),
+    mSignalCount = sc + (mSignalCount state),
+    mFuncMethods = mFuncMethods state `crlAppend1` (Just $ memberFun m)}
   return ()
 
-writeProperty :: Property tt -> State MOCState ()
+writeProperty :: Member tt -> State MOCState ()
 writeProperty p = do
-  idx <- get >>= return . mDataLen
-  writeString $ propertyName p
-  writeString $ typeName $ propertyType p
+  idx <- get >>= return . crlLen . mData
+  writeString $ memberName p
+  writeString $ typeName $ memberType p
   writeInt (pfReadable .|. pfScriptable .|.
-    if (isJust $ propertyWriteFunc p) then pfWritable else 0)
+    if (isJust $ memberFunAux p) then pfWritable else 0)
   state <- get
-  put $ state {mDataPropsIdx = mplus (mDataPropsIdx state) (Just idx)}
+  put $ state {
+    mDataPropsIdx = mplus (mDataPropsIdx state) (Just idx),
+    mPropertyCount = 1 + (mPropertyCount state),
+    mFuncProperties = mFuncProperties state
+      `crlAppend1` (Just $ memberFun p) `crlAppend1` memberFunAux p
+  }
   return ()
 
-compileClass :: String -> [Method tt] -> [Property tt] -> MOCOutput
-compileClass name ms ps = 
-  let enc = flip execState newMOCState $ do
-        writeInt 5                           -- Revision
-        writeString name                     -- Class name
-        writeInt 0 >> writeInt 0             -- Class info
-        writeInt $ fromIntegral $ length ms  -- Methods
-        writeInt $ fromIntegral $
-          fromMaybe 0 $ mDataMethodsIdx enc  -- Methods (data index)
-        writeInt $ fromIntegral $ length ps  -- Properties
-        writeInt $ fromIntegral $
-          fromMaybe 0 $ mDataPropsIdx enc    -- Properties (data index)
-        writeInt 0 >> writeInt 0             -- Enums
-        writeInt 0 >> writeInt 0             -- Constructors
-        writeInt 0                           -- Flags
-        writeInt 0                           -- Signals        
-        mapM_ writeMethod ms
-        mapM_ writeProperty ps
-        writeInt 0
-  in MOCOutput (reverse $ mData enc) (reverse $ mStrData enc)
-
 foldr0 :: (a -> a -> a) -> a -> [a] -> a
 foldr0 _ x [] = x
 foldr0 f _ xs = foldr1 f xs
 
-methodSignature :: Method tt -> String
+methodSignature :: Member tt -> String
 methodSignature method =
-  let paramTypes = tail $ methodTypes method
-  in (showString (methodName method) . showChar '(' .
+  let paramTypes = memberParams method
+  in (showString (memberName method) . showChar '(' .
        foldr0 (\l r -> l . showChar ',' . r) id
          (map (showString . typeName) paramTypes) . showChar ')') ""
 
-methodParameters :: Method tt -> String
+methodParameters :: Member tt -> String
 methodParameters method =
-  replicate (flip (-) 2 $ length $ methodTypes method) ','
+  replicate (flip (-) 1 $ length $ memberParams method) ','
diff --git a/test/Graphics/QML/Test/Framework.hs b/test/Graphics/QML/Test/Framework.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/Framework.hs
@@ -0,0 +1,277 @@
+{-# LANGUAGE ExistentialQuantification,
+             ScopedTypeVariables,
+             FlexibleInstances,
+             DeriveDataTypeable,
+             TypeFamilies #-}
+
+module Graphics.QML.Test.Framework where
+
+import Graphics.QML.Objects
+import Graphics.QML.Marshal
+import Graphics.QML.Test.MayGen
+import Graphics.QML.Test.ScriptDSL (Prog)
+import qualified Graphics.QML.Test.ScriptDSL as S
+
+import Test.QuickCheck.Gen
+import Test.QuickCheck.Arbitrary
+import Data.List (mapAccumR)
+import Data.Maybe
+import Data.Monoid
+import Data.Proxy
+import Data.Typeable
+import Data.IORef
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+
+import Data.Int
+import Data.Text (Text)
+import qualified Data.Text as T
+import Network.URI
+
+data TestType = forall a. (TestAction a) => TestType (Proxy a)
+
+instance Eq TestType where
+    (==) (TestType a) (TestType b) = typeOf a == typeOf b
+
+instance Show TestType where
+    showsPrec d (TestType p) =
+        showParen (d > 10) $ showString "TestType (Proxy :: " .
+            shows (typeOf p) . showString ")"
+
+newtype Serial = Serial Int deriving (Show, Eq)
+
+badSerial :: Serial
+badSerial = Serial (-1)
+
+data TestEnv = TestEnv {
+    envSerial :: Serial,
+    envHs     :: IntMap (TestType, Serial),
+    envJs     :: IntMap (TestType, Serial)
+} deriving Show
+
+newTestEnv :: TestType -> TestEnv
+newTestEnv tt =
+    TestEnv (Serial 1) IntMap.empty (IntMap.singleton 0 (tt, Serial 0))
+
+testEnvStep :: TestEnv -> TestEnv
+testEnvStep (TestEnv (Serial s) h j) =
+    TestEnv (Serial $ s+1) h j
+
+testEnvSerial :: (Serial -> TestEnv -> TestEnv) -> TestEnv -> TestEnv
+testEnvSerial f env = f (envSerial env) env
+
+testEnvSetJ :: Int -> TestType -> Serial -> TestEnv -> TestEnv
+testEnvSetJ n tt js (TestEnv s h j) =
+    TestEnv s h (IntMap.insert n (tt,js) j)
+
+testEnvIsaJ :: Int -> TestType -> TestEnv -> Bool
+testEnvIsaJ n tt env =
+    case IntMap.lookup n $ envJs env of
+        Just (tt', _) -> tt' == tt
+        _             -> False
+
+testEnvNextJ :: TestEnv -> Int
+testEnvNextJ = (+1) . fst . IntMap.findMax . envJs
+
+testEnvListJ :: TestType -> TestEnv -> [Int]
+testEnvListJ tt env =
+    map fst $ filter (\(_,(tt',_)) ->
+        tt' == tt) $ IntMap.toList $ envJs env
+
+data TestBox = forall a. (TestAction a) => TestBox Int a
+
+instance Show TestBox where
+    showsPrec d (TestBox n a) =
+        showParen (d > 10) $ showString "TestBox " . shows n .
+            showString " " . showsPrec 11 a
+
+testBoxType :: TestBox -> TestType
+testBoxType (TestBox _ a) =
+    TestType $ mkProxy a
+    where mkProxy = const Proxy :: a -> Proxy a
+
+class (Typeable a, Show a) => TestAction a where
+    legalActionIn  :: a -> TestEnv -> Bool
+    nextActionsFor :: TestEnv -> MayGen a
+    updateEnvRaw   :: a -> TestEnv -> TestEnv
+    actionRemote   :: a -> Int -> Prog
+    mockObjDef     :: [Member (MockObj a)]
+
+legalAction :: TestEnv -> TestBox -> Bool
+legalAction env tb@(TestBox n a) =
+    (fmap fst $ IntMap.lookup n $ envJs env) == Just (testBoxType tb) &&
+        legalActionIn a env
+
+nextActions :: TestEnv -> Gen TestBox
+nextActions env =
+    oneof $ mapMaybe (uncurry f) $ IntMap.toList $ envJs env
+    where f n ((TestType pxy), _) =
+              (mayGen $ fmap (TestBox n . flip asProxyTypeOf pxy) $
+                  nextActionsFor env)
+
+updateEnv :: TestBox -> TestEnv -> TestEnv
+updateEnv (TestBox _ a) = updateEnvRaw a
+
+showTestCode :: [TestBox] -> ShowS
+showTestCode xs =
+    let f (TestBox n a) = actionRemote a n
+    in S.showProg $ mconcat $ map f xs ++ [S.end]
+
+newtype TestBoxSrc a = TestBoxSrc { srcTestBoxes :: [TestBox]} deriving Show
+
+genTestBoxes :: Int -> TestEnv -> Gen [TestBox]
+genTestBoxes 0 _ = return []
+genTestBoxes len env = do
+    x <- nextActions env
+    xs <- genTestBoxes (len-1) (updateEnv x env)
+    return (x:xs)
+
+partitions :: [a] -> [([a],[a])]
+partitions xs =
+    ([],xs) : case xs of
+        []    -> []
+        x:xs' -> map (\(hs,ts) -> (x:hs,ts)) $ partitions xs'
+
+partitions1 :: [a] -> [([a],a,[a])]
+partitions1 xs =
+    mapMaybe f $ partitions xs
+    where f (_,[]) = Nothing
+          f (as,(b:cs)) = Just (as,b,cs)
+
+pruneTestBoxes :: TestEnv -> [TestBox] -> [TestBox]
+pruneTestBoxes env xs =
+    catMaybes $ snd $ mapAccumR f env xs
+    where f e x | legalAction e x = (updateEnv x e, Just x)
+                | otherwise       = (e, Nothing)
+
+shrinkHelper :: TestEnv -> [TestBox] -> [TestBox] -> [TestBox]
+shrinkHelper env xs ys =
+    let env' = foldr updateEnv env xs
+        ys'  = pruneTestBoxes env' ys
+    in xs ++ ys'
+
+instance (TestAction a) => Arbitrary (TestBoxSrc a) where
+    arbitrary =
+        fmap TestBoxSrc $ sized $ \sz ->
+            genTestBoxes sz $ newTestEnv $ TestType (Proxy :: Proxy a)
+    shrink (TestBoxSrc xs) =
+        map (\(a,_,b) -> TestBoxSrc $ shrinkHelper env a b) $ partitions1 xs
+        where env = newTestEnv $ TestType (Proxy :: Proxy a)
+
+mockFromSrc :: forall a. (TestAction a) => TestBoxSrc a -> IO (MockObj a)
+mockFromSrc (TestBoxSrc ts) = do 
+    statusRef <- newIORef $ TestStatus ts Nothing
+        (newTestEnv $ TestType (Proxy :: Proxy a)) IntMap.empty
+    return $ MockObj (Serial 0) statusRef
+
+data TestFault
+    = TOverAction
+    | TUnderAction
+    | TBadAction
+    | TBadActionType
+    | TBadActionCtor
+    | TBadActionSlot
+    | TBadActionData
+    | TTimeout
+    | TInvalid
+    deriving Show
+
+newtype Anything = Anything () deriving Show
+
+data TestStatus = TestStatus {
+    testList  :: [TestBox],
+    testFault :: Maybe TestFault,
+    testEnv   :: TestEnv,
+    testObjs  :: IntMap Anything
+} deriving Show
+
+testSerial :: TestStatus -> Serial
+testSerial = envSerial . testEnv
+
+data MockObj a = MockObj {
+    mockSerial :: Serial,
+    mockStatus :: IORef TestStatus
+} deriving Typeable
+
+mockGetStatus :: MockObj a -> IO TestStatus
+mockGetStatus (MockObj _ statusRef) = readIORef statusRef
+
+class MakeDefault a where
+    makeDef :: IO a
+
+instance (TestAction a) => MakeDefault (ObjRef (MockObj a)) where
+    makeDef = do
+        statusRef <- newIORef $ TestStatus [] (Just TInvalid)
+            (TestEnv badSerial IntMap.empty IntMap.empty) IntMap.empty
+        newObject $ MockObj badSerial statusRef
+
+instance MakeDefault () where
+    makeDef = return ()
+
+instance MakeDefault Int32 where
+    makeDef = return 0
+
+instance MakeDefault Double where
+    makeDef = return (0/0)
+
+instance MakeDefault [a] where
+    makeDef = return []
+
+instance MakeDefault Text where
+    makeDef = return T.empty
+
+instance MakeDefault URI where
+    makeDef = return $ URI "" Nothing "" "" ""
+
+expectAction :: (TestAction a, MakeDefault b) =>
+    MockObj a -> (a -> IO (Either TestFault b)) -> IO b
+expectAction mock pred = do
+    status <- readIORef $ mockStatus mock
+    res <- case status of
+        TestStatus (b:_) Nothing env _ -> case b of
+            TestBox _ a -> case cast a of
+                Just a' -> pred a' >>= return . fmap ((,) (updateEnvRaw a' env))
+                _       -> return $ Left TBadActionType
+        TestStatus [] Nothing _ _       -> return $ Left TOverAction
+        TestStatus _ (Just f) _ _       -> return $ Left f
+    case res of
+        Left f  -> do
+            let (TestStatus bs _ env objs) = status
+            writeIORef (mockStatus mock) $ TestStatus bs (Just f) env objs
+            makeDef
+        Right (env', v) -> do
+            let (TestStatus (_:bs) _ _ objs) = status
+            writeIORef (mockStatus mock) $ TestStatus bs Nothing env' objs
+            return v
+
+expectActionRef :: (TestAction a, MakeDefault b) =>
+    ObjRef (MockObj a) -> (a -> IO (Either TestFault b)) -> IO b
+expectActionRef ref pred = expectAction (fromObjRef ref) pred
+
+badAction :: (MakeDefault b) => MockObj a -> IO b
+badAction mock = do
+    status <- readIORef $ mockStatus mock
+    writeIORef (mockStatus mock) $ status {testFault = Just TBadAction} 
+    makeDef
+
+forkMockObj :: (TestAction b) => MockObj a -> IO (ObjRef (MockObj b))
+forkMockObj m = do
+    status <- mockGetStatus m
+    newObject $ MockObj (testSerial status) $ mockStatus m
+
+checkMockObj :: forall a b. (TestAction b) =>
+    MockObj a -> MockObj b -> Int -> IO (Either TestFault ())
+checkMockObj m v w = do
+    status <- mockGetStatus m
+    case IntMap.lookup w $ envJs $ testEnv status of
+        Just entry -> if entry == (TestType (Proxy :: Proxy b), mockSerial v)
+                      then return $ Right ()
+                      else return $ Left TBadActionData
+        _          -> return $ Left TBadActionSlot
+
+instance (TestAction a) => Object (MockObj a) where
+    classDef = defClass mockObjDef
+
+instance (TestAction a) => Marshal (MockObj a) where
+    type MarshalMode (MockObj a) = ValObjToOnly (MockObj a)
+    marshaller = objSimpleMarshaller
diff --git a/test/Graphics/QML/Test/GenURI.hs b/test/Graphics/QML/Test/GenURI.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/GenURI.hs
@@ -0,0 +1,51 @@
+module Graphics.QML.Test.GenURI where
+
+import Test.QuickCheck.Gen
+import Network.URI
+import Numeric
+
+capSize :: Int -> Gen a -> Gen a
+capSize cap g = sized (\s -> if s > cap then resize cap g else resize s g)
+
+uriGen :: Gen URI
+uriGen = capSize 35 $ do
+    let slists  = fmap (:[])
+        listxyz = fmap concat . sequence
+        listxs  = fmap concat . listOf
+        listxs1 = fmap concat . listOf1
+        lower   = elements $ slists $ enumFromTo 'a' 'z'
+        upper   = elements $ slists $ enumFromTo 'A' 'Z'
+        digit   = elements $ slists "01234567989"
+        mark    = elements $ slists "-_.!~*'()"
+        sextra  = elements $ slists "+-."
+        rextra  = elements $ slists "$,;:@&=+"
+        dash    = return "-"
+        dot     = return "."
+        alpha   = oneof [lower, upper]
+        alphnum = oneof [lower, upper, digit]
+        dchar   = oneof [lower, digit]
+        dchar2  = frequency [(9,lower), (5,digit), (1,dash)]
+        unres   = frequency [(9,alphnum), (1,mark)]
+        escNum  = oneof [choose (0,31), choose (128,255)] :: Gen Int
+        pad     = \n x -> replicate (n - length x) '0' ++ x
+        escape  = fmap (('%':) . pad 2 . flip showHex "") escNum
+        scheme  = listxyz [alpha, listxs $ frequency [
+            (9,alphnum), (1,sextra)]]
+        dpart1  = listxyz [
+                      frequency [(9,dchar), (1,listxyz [dchar, dot, dchar])],
+                      listxs $ frequency [
+                          (9,dchar2), (1,listxyz [dchar, dot, dchar]),
+                          (1,listxyz [dchar, dot, dchar, dot, dchar])],
+                      dchar, dot]
+        dpart2  = oneof [lower, listxyz [lower, listxs dchar2, dchar]]
+        regName = flip suchThat (\x -> length x < 255) $ listxyz [
+            frequency [(9,dpart1), (1,return "")],
+            dpart2, oneof [dot, return ""]]
+        segment = fmap ('/':) $ listxs $ frequency [
+            (9,unres), (1,escape), (1,rextra)]
+        path   = listxs1 segment
+    schemeStr <- scheme
+    regNameStr <- regName
+    pathStr <- path
+    return $
+        URI (schemeStr++":") (Just $ URIAuth "" regNameStr "") pathStr "" ""
diff --git a/test/Graphics/QML/Test/Harness.hs b/test/Graphics/QML/Test/Harness.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/Harness.hs
@@ -0,0 +1,75 @@
+module Graphics.QML.Test.Harness where
+
+import Graphics.QML.Test.Framework
+
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
+import Test.QuickCheck.Test
+
+import Graphics.QML
+import Data.IORef
+import Data.Proxy
+import Data.Typeable
+import Data.Maybe
+import System.IO
+import System.Directory
+
+qmlPrelude :: String
+qmlPrelude = unlines [
+    "import Qt 4.7",
+    "Rectangle {",
+    "    id: page;",
+    "    width: 100; height: 100;",
+    "    color: 'green';",
+    "    Component.onCompleted: {"]
+
+qmlPostscript :: String
+qmlPostscript = unlines [
+    "    }",
+    "}"]
+
+finishTest :: MockObj a -> IO ()
+finishTest mock = do
+    let statusRef = mockStatus mock
+    status <- readIORef statusRef
+    let status' = case status of
+            TestStatus (_:_) Nothing _ _ -> status {
+                testFault = Just TUnderAction}
+            _                            -> status
+    writeIORef statusRef status'
+
+runTest :: (TestAction a) => TestBoxSrc a -> IO TestStatus
+runTest src = do
+    let js = showTestCode (srcTestBoxes src) ""
+    tmpDir <- getTemporaryDirectory
+    (qmlPath, hndl) <- openTempFile tmpDir "test1-.qml"
+    hPutStr hndl (qmlPrelude ++ js ++ qmlPostscript)
+    hClose hndl
+    mock <- mockFromSrc src
+    go <- newObject mock
+    runEngineLoop defaultEngineConfig {
+        initialURL = filePathToURI qmlPath,
+        initialWindowState = HideWindow,
+        contextObject = Just $ anyObjRef go}
+    removeFile qmlPath
+    finishTest mock
+    status <- readIORef (mockStatus mock)
+    if isJust $ testFault status
+        then putStrLn $ show status
+        else return ()
+    return status
+
+testProperty :: (TestAction a) => TestBoxSrc a -> Property
+testProperty src = monadicIO $ do
+    status <- run $ runTest src
+    assert $ isNothing $ testFault status
+    return ()
+
+checkProperty :: TestType -> IO Bool
+checkProperty (TestType pxy) = do
+    putStrLn $ "Checking " ++ show (typeOf $ asProxyTypeOf undefined pxy)
+    r <- quickCheckResult $ testProperty . constrainSrc pxy
+    return $ isSuccess r
+
+constrainSrc :: (TestAction a) => Proxy a -> TestBoxSrc a -> TestBoxSrc a
+constrainSrc = flip const
diff --git a/test/Graphics/QML/Test/MayGen.hs b/test/Graphics/QML/Test/MayGen.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/MayGen.hs
@@ -0,0 +1,33 @@
+module Graphics.QML.Test.MayGen where
+
+import Test.QuickCheck.Gen
+import Control.Applicative
+import Data.Maybe
+
+-- I wanted so badly to write a Monad instance for MayGen, but actually
+-- Applicative captures the legal operations perfectly.
+
+newtype MayGen a = MayGen {mayGen :: Maybe (Gen a)}
+
+instance Functor MayGen where
+    fmap f (MayGen v) = MayGen $ (fmap . fmap) f v
+
+instance Applicative MayGen where
+    pure = MayGen . Just . return
+    (MayGen mf) <*> (MayGen v) = MayGen $ liftA2 (<*>) mf v
+
+noGen :: MayGen a
+noGen = MayGen Nothing
+
+fromGen :: Gen a -> MayGen a
+fromGen = MayGen . Just
+
+mayElements :: [a] -> MayGen a
+mayElements [] = noGen
+mayElements xs = fromGen $ elements xs
+
+mayOneof :: [MayGen a] -> MayGen a
+mayOneof xs =
+    case mapMaybe mayGen xs of
+        []  -> noGen
+        xs' -> fromGen $ oneof xs'
diff --git a/test/Graphics/QML/Test/MixedTest.hs b/test/Graphics/QML/Test/MixedTest.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/MixedTest.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}
+
+module Graphics.QML.Test.MixedTest where
+
+import Graphics.QML.Objects
+import Graphics.QML.Test.Framework
+import Graphics.QML.Test.MayGen
+import qualified Graphics.QML.Test.ScriptDSL as S
+
+import Test.QuickCheck.Gen
+import Control.Applicative
+import Data.Typeable
+import Data.Proxy
+
+data ObjectA
+    = OANewB Int
+    | OACheckB Int
+    deriving (Show, Typeable)
+
+objectAType :: TestType
+objectAType = TestType (Proxy :: Proxy ObjectA)
+
+data ObjectB
+    = OBNewA Int
+    | OBCheckA Int
+    deriving (Show, Typeable)
+
+objectBType :: TestType
+objectBType = TestType (Proxy :: Proxy ObjectB)
+
+instance TestAction ObjectA where
+    legalActionIn (OANewB n) env = testEnvIsaJ n objectBType env
+    legalActionIn _ _ = True
+    nextActionsFor env = mayOneof [
+        OANewB <$> (fromGen $ choose (1, testEnvNextJ env)),
+        OACheckB <$> mayElements (filter (/= 0) $ testEnvListJ objectBType env)]
+    updateEnvRaw (OANewB n) = testEnvStep . testEnvSerial (\s ->
+        testEnvSetJ n objectBType s)
+    updateEnvRaw _ = testEnvStep
+    actionRemote (OANewB v) n =
+        S.saveVar v $ S.var n `S.dot` "newB" `S.call` []
+    actionRemote (OACheckB v) n =
+        S.eval $ S.var n `S.dot` "checkB" `S.call` [S.var v]
+    mockObjDef = [
+        defMethod "newB" $ \m -> expectAction m $ \a -> case a of
+            OANewB _ -> do
+                obj <- forkMockObj m
+                return $ Right (obj :: ObjRef (MockObj ObjectB))
+            _        -> return $ Left TBadActionCtor,
+        defMethod "checkB" $ \m v -> expectAction m $ \a -> case a of
+            OACheckB w -> checkMockObj m (v :: MockObj ObjectB) w
+            _          -> return $ Left TBadActionCtor]
+
+instance TestAction ObjectB where
+    legalActionIn (OBNewA n) env = testEnvIsaJ n objectAType env
+    legalActionIn _ _ = True
+    nextActionsFor env = mayOneof [
+        OBNewA <$> (fromGen $ choose (1, testEnvNextJ env)),
+        OBCheckA <$> mayElements (filter (/= 0) $ testEnvListJ objectAType env)]
+    updateEnvRaw (OBNewA n) = testEnvStep . testEnvSerial (\s ->
+        testEnvSetJ n objectAType s)
+    updateEnvRaw _ = testEnvStep
+    actionRemote (OBNewA v) n =
+        S.saveVar v $ S.var n `S.dot` "newA" `S.call` []
+    actionRemote (OBCheckA v) n =
+        S.eval $ S.var n `S.dot` "checkA" `S.call` [S.var v]
+    mockObjDef = [
+        defMethod "newA" $ \m -> expectAction m $ \a -> case a of
+            OBNewA _ -> do
+                obj <- forkMockObj m
+                return $ Right (obj :: ObjRef (MockObj ObjectA))
+            _        -> return $ Left TBadActionCtor,
+        defMethod "checkA" $ \m v -> expectAction m $ \a -> case a of
+            OBCheckA w -> checkMockObj m (v :: MockObj ObjectA) w
+            _          -> return $ Left TBadActionCtor]
diff --git a/test/Graphics/QML/Test/ScriptDSL.hs b/test/Graphics/QML/Test/ScriptDSL.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/ScriptDSL.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module Graphics.QML.Test.ScriptDSL where
+
+import Data.Char
+import Data.Int
+import Data.List
+import Data.Monoid
+import Data.Text (Text)
+import qualified Data.Text as T
+import Network.URI
+import Numeric
+
+data Expr = Global | Expr {unExpr :: ShowS}
+
+data Prog = Prog ShowS ShowS
+
+instance Monoid Prog where
+    mempty = Prog id id
+    mappend (Prog a1 b1) (Prog a2 b2) = Prog (a1 . a2) (b2 . b1)
+
+showProg :: Prog -> ShowS
+showProg (Prog a b) = a . b
+
+class Literal a where
+    literal :: a -> Expr
+
+instance Literal Int where
+    literal x = Expr $ shows x
+
+instance Literal Int32 where
+    literal x = Expr $ shows x
+
+instance Literal Double where
+    literal x | isNaN x                 = Expr $ showString "(0/0)"
+              | isInfinite x && (x < 0) = Expr $ showString "(-1/0)"
+              | isInfinite x            = Expr $ showString "(1/0)"
+              | isNegativeZero x        = Expr $ showString "-0"
+              | otherwise               = Expr $ shows x
+
+instance Literal [Char] where
+    literal [] = Expr $ showString "\"\""
+    literal cs =
+        Expr (showChar '"' . (foldr1 (.) $ map f cs) . showChar '"')
+        where f '\"' = showString "\\\""
+              f '\\' = showString "\\\\"
+              f c | ord c < 32 = hexEsc c
+                  | ord c > 127 = hexEsc c
+                  | otherwise  = showChar c
+              hexEsc c = let h = showHex (ord c)
+                         in showString "\\u" .  showString (
+                                replicate (4 - (length $ h "")) '0') . h
+
+instance Literal Text where
+    literal = literal . T.unpack
+
+instance Literal URI where
+    literal = literal . ($ "") . uriToString id
+
+var :: Int -> Expr
+var 0 = Global
+var n = Expr (showChar 'x' . shows n)
+
+sym :: String -> Expr
+sym name = Expr $ showString name
+
+dot :: Expr -> String -> Expr
+dot Global     m = Expr $ showString m
+dot (Expr lhs) m = Expr (lhs . showChar '.' . showString m)
+
+call :: Expr -> [Expr] -> Expr
+call (Expr f) ps = Expr (
+    f . showChar '(' . (
+        foldr1 (.) $ (id:) $ intersperse (showChar ',') $ map unExpr ps) .
+    showChar ')')
+call _ _ = error "cannot call the context object"
+
+binOp :: String -> Expr -> Expr -> Expr
+binOp op (Expr lhs) (Expr rhs) = Expr (
+    showChar '(' . lhs . showString op . rhs . showChar ')')
+binOp _ _ _ = error "cannot operate on the context object"
+
+eq :: Expr -> Expr -> Expr
+eq = binOp " == "
+
+neq :: Expr -> Expr -> Expr
+neq = binOp " != "
+
+eval :: Expr -> Prog
+eval (Expr ex) = Prog (ex . showString ";\n") id
+eval _ = error "cannot eval the context object"
+
+set :: Expr -> Expr -> Prog
+set (Expr lhs) (Expr rhs) =
+    Prog (lhs . showString " = " . rhs . showString ";\n") id
+set _ _ = error "cannot set the context object"
+
+saveVar :: Int -> Expr -> Prog
+saveVar v (Expr rhs) =
+    Prog (showString "var x" . shows v . showString " = " .
+        rhs . showString ";\n") id
+saveVar _ _ = error "cannot save the context object"
+
+assert :: Expr -> Prog
+assert (Expr ex) =
+    Prog (showString "if (!" . ex .
+        showString ") {window.close(); throw -1;}\n") id
+assert _ = error "cannot assert the context object"
+
+connect :: Expr -> Expr -> Prog
+connect sig fn = eval $ sig `dot` "connect" `call` [fn]
+
+disconnect :: Expr -> Expr -> Prog
+disconnect sig fn = eval $ sig `dot` "disconnect" `call` [fn]
+
+makeCont :: [String] -> Prog -> Prog -> Prog
+makeCont args (Prog a1 b1) (Prog a2 b2) =
+    Prog (showString "var cont = function(" . farg . showString ") {\n" . a2)
+        (b2 . showString "};\n" . a1 . b1)
+    where farg = foldr1 (.) $ (id:) $ intersperse (showChar ',') $
+                     map showString args
+
+contVar :: Expr
+contVar = sym "cont"
+
+callee :: Expr
+callee = sym "arguments.callee"
+
+end :: Prog
+end = Prog (showString "window.close();\n") id
diff --git a/test/Graphics/QML/Test/SignalTest.hs b/test/Graphics/QML/Test/SignalTest.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/SignalTest.hs
@@ -0,0 +1,195 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeFamilies #-}
+
+module Graphics.QML.Test.SignalTest where
+
+import Graphics.QML.Objects
+import Graphics.QML.Test.Framework
+import Graphics.QML.Test.MayGen
+import Graphics.QML.Test.GenURI
+import Graphics.QML.Test.TestObject
+import Graphics.QML.Test.ScriptDSL (Expr, Prog)
+import qualified Graphics.QML.Test.ScriptDSL as S
+
+import Test.QuickCheck.Arbitrary
+import Control.Applicative
+import Data.Monoid
+import Data.Tagged
+import Data.Typeable
+
+import Data.Int
+import Data.Text (Text)
+import qualified Data.Text as T
+import Network.URI
+
+data SignalTest1
+    = ST1TrivialMethod
+    | ST1FireNoArgs
+    | ST1FireInt Int32
+    | ST1FireThreeInts Int32 Int32 Int32
+    | ST1FireDouble Double
+    | ST1FireString String
+    | ST1FireText Text
+    | ST1FireURI URI
+    | ST1FireObject Int
+    | ST1CheckObject Int
+    deriving (Show, Typeable)
+
+data NoArgsSignal deriving Typeable
+
+instance SignalKey NoArgsSignal where
+    type SignalParams NoArgsSignal = IO ()
+
+data IntSignal deriving Typeable
+
+instance SignalKey IntSignal where
+    type SignalParams IntSignal = Int32 -> IO ()
+
+data ThreeIntsSignal deriving Typeable
+
+instance SignalKey ThreeIntsSignal where
+    type SignalParams ThreeIntsSignal = Int32 -> Int32 -> Int32 -> IO ()
+
+data DoubleSignal deriving Typeable
+
+instance SignalKey DoubleSignal where
+    type SignalParams DoubleSignal = Double -> IO ()
+
+data StringSignal deriving Typeable
+
+instance SignalKey StringSignal where
+    type SignalParams StringSignal = String -> IO ()
+
+data TextSignal deriving Typeable
+
+instance SignalKey TextSignal where
+    type SignalParams TextSignal = Text -> IO ()
+
+data URISignal deriving Typeable
+
+instance SignalKey URISignal where
+    type SignalParams URISignal = URI -> IO ()
+
+data ObjectSignal deriving Typeable
+
+instance SignalKey ObjectSignal where
+    type SignalParams ObjectSignal = ObjRef (MockObj TestObject) -> IO ()
+
+chainSignal :: Int -> [String] -> String -> String -> Prog
+chainSignal n args sig fn = S.makeCont args
+    ((S.connect (S.var n `S.dot` sig) S.contVar) `mappend` 
+     (S.eval $ (S.var n) `S.dot` fn `S.call` []))
+    (S.disconnect (S.var n `S.dot` sig) S.callee)
+
+testSignal :: Int -> String -> String -> Expr -> Prog
+testSignal n sig fn v =
+    chainSignal n ["arg"] sig fn `mappend`
+    (S.assert $ S.sym "arg" `S.eq` v)
+
+instance TestAction SignalTest1 where
+    legalActionIn _ _ = True
+    nextActionsFor env = mayOneof [
+        pure ST1TrivialMethod,
+        pure ST1FireNoArgs,
+        ST1FireInt <$> fromGen arbitrary,
+        ST1FireThreeInts <$>
+            fromGen arbitrary <*> fromGen arbitrary <*> fromGen arbitrary,
+        ST1FireDouble <$> fromGen arbitrary,
+        ST1FireString <$> fromGen arbitrary,
+        ST1FireText . T.pack <$> fromGen arbitrary,
+        ST1FireURI <$> fromGen uriGen,
+        pure . ST1FireObject $ testEnvNextJ env,
+        ST1CheckObject <$> mayElements (testEnvListJ testObjectType env)]
+    updateEnvRaw (ST1FireObject n) = testEnvStep . testEnvSerial (\s ->
+        testEnvSetJ n testObjectType s)
+    updateEnvRaw _ = testEnvStep
+    actionRemote ST1TrivialMethod n =
+        S.eval $ (S.var n) `S.dot` "trivialMethod" `S.call` []
+    actionRemote ST1FireNoArgs n =
+        chainSignal n [] "noArgsSignal" "fireNoArgs"
+    actionRemote (ST1FireInt v) n =
+        testSignal n "intSignal" "fireInt" $ S.literal v
+    actionRemote (ST1FireThreeInts v1 v2 v3) n =
+        chainSignal n ["arg1","arg2","arg3"]
+            "threeIntsSignal" "fireThreeInts" `mappend`
+        (S.assert $ S.sym "arg1" `S.eq` S.literal v1) `mappend`
+        (S.assert $ S.sym "arg2" `S.eq` S.literal v2) `mappend`
+        (S.assert $ S.sym "arg3" `S.eq` S.literal v3)
+    actionRemote (ST1FireDouble v) n =
+        testSignal n "doubleSignal" "fireDouble" $ S.literal v
+    actionRemote (ST1FireString v) n =
+        testSignal n "stringSignal" "fireString" $ S.literal v
+    actionRemote (ST1FireText v) n =
+        testSignal n "textSignal" "fireText" $ S.literal v
+    actionRemote (ST1FireURI v) n =
+        testSignal n "uriSignal" "fireURI" $ S.literal v
+    actionRemote (ST1FireObject v) n =
+        chainSignal n ["obj"] "objectSignal" "fireObject" `mappend`
+        (S.saveVar v $ S.sym "obj")
+    actionRemote (ST1CheckObject v) n =
+        S.eval $ (S.var n) `S.dot` "checkObject" `S.call` [S.var v]
+    mockObjDef = [
+        defMethod "trivialMethod" $ \m -> expectAction m $ \a -> case a of
+            ST1TrivialMethod -> return $ Right ()
+            _                -> return $ Left TBadActionCtor,
+        defMethod "fireNoArgs" $ \m -> (expectActionRef m $ \a -> case a of
+            ST1FireNoArgs -> do
+                fireSignal (Tagged m
+                    :: Tagged NoArgsSignal (ObjRef (MockObj SignalTest1)))
+                return $ Right ()
+            _             -> return $ Left TBadActionCtor),
+        defSignal (Tagged "noArgsSignal" :: Tagged NoArgsSignal String), 
+        defMethod "fireInt" $ \m -> (expectActionRef m $ \a -> case a of
+            ST1FireInt v -> do
+                fireSignal (Tagged m
+                    :: Tagged IntSignal (ObjRef (MockObj SignalTest1))) v
+                return $ Right ()
+            _            -> return $ Left TBadActionCtor),
+        defSignal (Tagged "intSignal" :: Tagged IntSignal String),
+        defMethod "fireThreeInts" $ \m -> (expectActionRef m $ \a -> case a of
+            ST1FireThreeInts v1 v2 v3 -> do
+                fireSignal (Tagged m
+                    :: Tagged ThreeIntsSignal (ObjRef (MockObj SignalTest1)))
+                    v1 v2 v3
+                return $ Right ()
+            _                         -> return $ Left TBadActionCtor),
+        defSignal (Tagged "threeIntsSignal" ::
+            Tagged ThreeIntsSignal String),
+        defMethod "fireDouble" $ \m -> (expectActionRef m $ \a -> case a of
+            ST1FireDouble v -> do
+                fireSignal (Tagged m
+                    :: Tagged DoubleSignal (ObjRef (MockObj SignalTest1))) v
+                return $ Right ()
+            _               -> return $ Left TBadActionCtor),
+        defSignal (Tagged "doubleSignal" :: Tagged DoubleSignal String),
+        defMethod "fireString" $ \m -> (expectActionRef m $ \a -> case a of
+            ST1FireString v -> do
+                fireSignal (Tagged m
+                    :: Tagged StringSignal (ObjRef (MockObj SignalTest1))) v
+                return $ Right ()
+            _               -> return $ Left TBadActionCtor),
+        defSignal (Tagged "stringSignal" :: Tagged StringSignal String),
+        defMethod "fireText" $ \m -> (expectActionRef m $ \a -> case a of
+            ST1FireText v -> do
+                fireSignal (Tagged m
+                    :: Tagged TextSignal (ObjRef (MockObj SignalTest1))) v
+                return $ Right ()
+            _             -> return $ Left TBadActionCtor),
+        defSignal (Tagged "textSignal" :: Tagged TextSignal String),
+        defMethod "fireURI" $ \m -> (expectActionRef m $ \a -> case a of
+            ST1FireURI v -> do
+                fireSignal (Tagged m
+                    :: Tagged URISignal (ObjRef (MockObj SignalTest1))) v
+                return $ Right ()
+            _            -> return $ Left TBadActionCtor),
+        defSignal (Tagged "uriSignal" :: Tagged URISignal String),
+        defMethod "fireObject" $ \m -> (expectActionRef m $ \a -> case a of
+            ST1FireObject _ -> do
+                (Right obj) <- getTestObject $ fromObjRef m
+                fireSignal (Tagged m
+                    :: Tagged ObjectSignal (ObjRef (MockObj SignalTest1))) obj
+                return $ Right ()
+            _               -> return $ Left TBadActionCtor),
+        defSignal (Tagged "objectSignal" :: Tagged ObjectSignal String),
+        defMethod "checkObject" $ \m v -> expectAction m $ \a -> case a of
+            ST1CheckObject w -> setTestObject m v w
+            _                -> return $ Left TBadActionCtor]
diff --git a/test/Graphics/QML/Test/SimpleTest.hs b/test/Graphics/QML/Test/SimpleTest.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/SimpleTest.hs
@@ -0,0 +1,259 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}
+
+module Graphics.QML.Test.SimpleTest where
+
+import Graphics.QML.Objects
+import Graphics.QML.Test.Framework
+import Graphics.QML.Test.MayGen
+import Graphics.QML.Test.GenURI
+import Graphics.QML.Test.TestObject
+import Graphics.QML.Test.ScriptDSL (Expr, Prog)
+import qualified Graphics.QML.Test.ScriptDSL as S
+
+import Test.QuickCheck.Arbitrary
+import Control.Applicative
+import Data.Typeable
+
+import Data.Int
+import Data.Text (Text)
+import qualified Data.Text as T
+import Network.URI
+
+makeCall :: Int -> String -> [Expr] -> Prog
+makeCall n name es = S.eval $ S.var n `S.dot` name `S.call` es
+
+saveCall :: Int -> Int -> String -> [Expr] -> Prog
+saveCall v n name es = S.saveVar v $ S.var n `S.dot` name `S.call` es
+
+testCall :: Int -> String -> [Expr] -> Expr -> Prog
+testCall n name es r = S.assert $ S.eq (S.var n `S.dot` name `S.call` es) r
+
+setProp :: Int -> String -> Expr -> Prog
+setProp n name ex = S.set (S.var n `S.dot` name) ex
+
+saveProp :: Int -> Int -> String -> Prog
+saveProp v n name = S.saveVar v $ S.var n `S.dot` name
+
+testProp :: Int -> String -> Expr -> Prog
+testProp n name r = S.assert $ S.eq (S.var n `S.dot` name) r
+
+checkArg :: (Show a, Eq a) => a -> a -> IO (Either TestFault ())
+checkArg v w = return $
+    if v == w then Right () else Left TBadActionData
+
+data SimpleMethods
+    = SMTrivial
+    | SMTernary Int32 Int32 Int32 Int32
+    | SMGetInt Int32
+    | SMSetInt Int32
+    | SMGetDouble Double
+    | SMSetDouble Double
+    | SMGetString String
+    | SMSetString String
+    | SMGetText Text
+    | SMSetText Text
+    | SMGetURI URI
+    | SMSetURI URI
+    | SMGetObject Int
+    | SMSetObject Int
+    deriving (Show, Typeable)
+
+instance TestAction SimpleMethods where
+    legalActionIn (SMSetObject n) env = testEnvIsaJ n testObjectType env
+    legalActionIn _ _ = True
+    nextActionsFor env = mayOneof [
+        pure SMTrivial,
+        SMTernary <$> 
+            fromGen arbitrary <*> fromGen arbitrary <*>
+            fromGen arbitrary <*> fromGen arbitrary,
+        SMGetInt <$> fromGen arbitrary,
+        SMSetInt <$> fromGen arbitrary,
+        SMGetDouble <$> fromGen arbitrary,
+        SMSetDouble <$> fromGen arbitrary,
+        SMGetString <$> fromGen arbitrary,
+        SMSetString <$> fromGen arbitrary,
+        SMGetText . T.pack <$> fromGen arbitrary,
+        SMSetText . T.pack <$> fromGen arbitrary,
+        SMGetURI <$> fromGen uriGen,
+        SMSetURI <$> fromGen uriGen,
+        pure . SMGetObject $ testEnvNextJ env,
+        SMSetObject <$> mayElements (testEnvListJ testObjectType env)]
+    updateEnvRaw (SMGetObject n) = testEnvStep . testEnvSerial (\s ->
+        testEnvSetJ n testObjectType s)
+    updateEnvRaw _ = testEnvStep
+    actionRemote SMTrivial n = makeCall n "trivial" []
+    actionRemote (SMTernary v1 v2 v3 v4) n = testCall n "ternary" [
+        S.literal v1, S.literal v2, S.literal v3] $ S.literal v4
+    actionRemote (SMGetInt v) n = testCall n "getInt" [] $ S.literal v
+    actionRemote (SMSetInt v) n = makeCall n "setInt" [S.literal v]
+    actionRemote (SMGetDouble v) n = testCall n "getDouble" [] $ S.literal v
+    actionRemote (SMSetDouble v) n = makeCall n "setDouble" [S.literal v]
+    actionRemote (SMGetString v) n = testCall n "getString" [] $ S.literal v
+    actionRemote (SMSetString v) n = makeCall n "setString" [S.literal v]
+    actionRemote (SMGetText v) n = testCall n "getText" [] $ S.literal v
+    actionRemote (SMSetText v) n = makeCall n "setText" [S.literal v]
+    actionRemote (SMGetURI v) n = testCall n "getURI" [] $ S.literal v
+    actionRemote (SMSetURI v) n = makeCall n "setURI" [S.literal v]
+    actionRemote (SMGetObject v) n = saveCall v n "getObject" []
+    actionRemote (SMSetObject v) n = makeCall n "setObject" [S.var v]
+    mockObjDef = [
+        defMethod "trivial" $ \m -> expectAction m $ \a -> case a of
+            SMTrivial -> return $ Right ()
+            _         -> return $ Left TBadActionCtor,
+        defMethod "ternary" $ \m v1 v2 v3 -> expectAction m $ \a -> case a of
+            SMTernary w1 w2 w3 w4 ->
+                (fmap . fmap) (const w4) $ checkArg (v1,v2,v3) (w1,w2,w3)
+            _          -> return $ Left TBadActionCtor,
+        defMethod "getInt" $ \m -> expectAction m $ \a -> case a of
+            SMGetInt v -> return $ Right v
+            _          -> return $ Left TBadActionCtor,
+        defMethod "setInt" $ \m v -> expectAction m $ \a -> case a of
+            SMSetInt w -> checkArg v w
+            _          -> return $ Left TBadActionCtor,
+        defMethod "getDouble" $ \m -> expectAction m $ \a -> case a of
+            SMGetDouble v -> return $ Right v
+            _             -> return $ Left TBadActionCtor,
+        defMethod "setDouble" $ \m v -> expectAction m $ \a -> case a of
+            SMSetDouble w -> checkArg v w
+            _             -> return $ Left TBadActionCtor,
+        defMethod "getString" $ \m -> expectAction m $ \a -> case a of
+            SMGetString v -> return $ Right v
+            _             -> return $ Left TBadActionCtor,
+        defMethod "setString" $ \m v -> expectAction m $ \a -> case a of
+            SMSetString w -> checkArg v w
+            _             -> return $ Left TBadActionCtor,
+        defMethod "getText" $ \m -> expectAction m $ \a -> case a of
+            SMGetText v -> return $ Right v
+            _           -> return $ Left TBadActionCtor,
+        defMethod "setText" $ \m v -> expectAction m $ \a -> case a of
+            SMSetText w -> checkArg v w
+            _           -> return $ Left TBadActionCtor,
+        defMethod "getURI" $ \m -> expectAction m $ \a -> case a of
+            SMGetURI v -> return $ Right v
+            _          -> return $ Left TBadActionCtor,
+        defMethod "setURI" $ \m v -> expectAction m $ \a -> case a of
+            SMSetURI w -> checkArg v w
+            _          -> return $ Left TBadActionCtor,
+        defMethod "getObject" $ \m -> expectAction m $ \a -> case a of
+            SMGetObject _ -> getTestObject m
+            _             -> return $ Left TBadActionCtor,
+        defMethod "setObject" $ \m v -> expectAction m $ \a -> case a of
+            SMSetObject w -> setTestObject m v w
+            _             -> return $ Left TBadActionCtor]
+
+data SimpleProperties
+    = SPGetIntRO Int32
+    | SPGetInt Int32
+    | SPSetInt Int32
+    | SPGetDouble Double
+    | SPSetDouble Double
+    | SPGetString String
+    | SPSetString String
+    | SPGetText Text
+    | SPSetText Text
+    | SPGetURI URI
+    | SPSetURI URI
+    | SPGetObject Int
+    | SPSetObject Int
+    deriving (Show, Typeable)
+
+instance TestAction SimpleProperties where
+    legalActionIn (SPSetObject n) env = testEnvIsaJ n testObjectType env
+    legalActionIn _ _ = True
+    nextActionsFor env = mayOneof [
+        SPGetIntRO <$> fromGen arbitrary,
+        SPGetInt <$> fromGen arbitrary,
+        SPSetInt <$> fromGen arbitrary,
+        SPGetDouble <$> fromGen arbitrary,
+        SPSetDouble <$> fromGen arbitrary,
+        SPGetString <$> fromGen arbitrary,
+        SPSetString <$> fromGen arbitrary,
+        SPGetText . T.pack <$> fromGen arbitrary,
+        SPSetText . T.pack <$> fromGen arbitrary,
+        SPGetURI <$> fromGen uriGen,
+        SPSetURI <$> fromGen uriGen,
+        pure . SPGetObject $ testEnvNextJ env,
+        SPSetObject <$> mayElements (testEnvListJ testObjectType env)]
+    updateEnvRaw (SPGetObject n) = testEnvStep . testEnvSerial (\s ->
+        testEnvSetJ n testObjectType s)
+    updateEnvRaw _ = testEnvStep
+    actionRemote (SPGetIntRO v) n = testProp n "propIntRO" $ S.literal v
+    actionRemote (SPGetInt v) n = testProp n "propIntR" $ S.literal v
+    actionRemote (SPSetInt v) n = setProp n "propIntW" $ S.literal v
+    actionRemote (SPGetDouble v) n = testProp n "propDoubleR" $ S.literal v
+    actionRemote (SPSetDouble v) n = setProp n "propDoubleW" $ S.literal v
+    actionRemote (SPGetString v) n = testProp n "propStringR" $ S.literal v
+    actionRemote (SPSetString v) n = setProp n "propStringW" $ S.literal v
+    actionRemote (SPGetText v) n = testProp n "propTextR" $ S.literal v
+    actionRemote (SPSetText v) n = setProp n "propTextW" $ S.literal v
+    actionRemote (SPGetURI v) n = testProp n "propURIR" $ S.literal v
+    actionRemote (SPSetURI v) n = setProp n "propURIW" $ S.literal v
+    actionRemote (SPGetObject v) n = saveProp v n "propObjectR"
+    actionRemote (SPSetObject v) n = setProp n "propObjectW" $ S.var v
+    mockObjDef = [
+        -- There are seperate properties for testing accessors and mutators
+        -- becasue QML produces spurious reads when writing.
+        defPropertyRO "propIntRO"
+            (\m -> expectAction m $ \a -> case a of
+                SPGetIntRO v -> return $ Right v
+                _            -> return $ Left TBadActionCtor),
+        defPropertyRW "propIntR"
+            (\m -> expectAction m $ \a -> case a of
+                SPGetInt v -> return $ Right v
+                _          -> return $ Left TBadActionCtor)
+            (\m _ -> badAction m),
+        defPropertyRW "propIntW"
+            (\_ -> makeDef)
+            (\m v -> expectAction m $ \a -> case a of
+                SPSetInt w -> checkArg v w
+                _          -> return $ Left TBadActionCtor),
+        defPropertyRW "propDoubleR"
+            (\m -> expectAction m $ \a -> case a of
+                SPGetDouble v -> return $ Right v
+                _             -> return $ Left TBadActionCtor)
+            (\m _ -> badAction m),
+        defPropertyRW "propDoubleW"
+            (\_ -> makeDef)
+            (\m v -> expectAction m $ \a -> case a of
+                SPSetDouble w -> checkArg v w
+                _             -> return $ Left TBadActionCtor),
+        defPropertyRW "propStringR"
+            (\m -> expectAction m $ \a -> case a of
+                SPGetString v -> return $ Right v
+                _             -> return $ Left TBadActionCtor)
+            (\m _ -> badAction m),
+        defPropertyRW "propStringW"
+            (\_ -> makeDef)
+            (\m v -> expectAction m $ \a -> case a of
+                SPSetString w -> checkArg v w
+                _             -> return $ Left TBadActionCtor),
+        defPropertyRW "propTextR"
+            (\m -> expectAction m $ \a -> case a of
+                SPGetText v -> return $ Right v
+                _           -> return $ Left TBadActionCtor)
+            (\m _ -> badAction m),
+        defPropertyRW "propTextW"
+            (\_ -> makeDef)
+            (\m v -> expectAction m $ \a -> case a of
+                SPSetText w -> checkArg v w
+                _           -> return $ Left TBadActionCtor),
+        defPropertyRW "propURIR"
+            (\m -> expectAction m $ \a -> case a of
+                SPGetURI v -> return $ Right v
+                _          -> return $ Left TBadActionCtor)
+            (\m _ -> badAction m),
+        defPropertyRW "propURIW"
+            (\_ -> makeDef)
+            (\m v -> expectAction m $ \a -> case a of
+                SPSetURI w -> checkArg v w
+                _          -> return $ Left TBadActionCtor),
+        defPropertyRW "propObjectR"
+            (\m -> expectAction m $ \a -> case a of
+                SPGetObject _ -> getTestObject m
+                _             -> return $ Left TBadActionCtor)
+            (\m _ -> badAction m),
+        defPropertyRW "propObjectW"
+            (\_ -> makeDef)
+            (\m v -> expectAction m $ \a -> case a of
+                SPSetObject w -> setTestObject m (fromObjRef v) w
+                _             -> return $ Left TBadActionCtor)]
diff --git a/test/Graphics/QML/Test/TestObject.hs b/test/Graphics/QML/Test/TestObject.hs
new file mode 100644
--- /dev/null
+++ b/test/Graphics/QML/Test/TestObject.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}
+
+module Graphics.QML.Test.TestObject where
+
+import Graphics.QML.Objects
+import Graphics.QML.Test.Framework
+import Graphics.QML.Test.MayGen
+
+import Data.Typeable
+import Data.Proxy
+
+data TestObject deriving Typeable
+
+testObjectType :: TestType
+testObjectType = TestType (Proxy :: Proxy TestObject)
+
+getTestObject ::
+    MockObj a -> IO (Either TestFault (ObjRef (MockObj TestObject)))
+getTestObject = fmap Right . forkMockObj
+
+setTestObject ::
+    MockObj a -> MockObj TestObject -> Int -> IO (Either TestFault ())
+setTestObject = checkMockObj
+
+instance Show TestObject where
+    showsPrec _ = error "TestObject has no actions."
+
+instance TestAction TestObject where
+    legalActionIn _ _ = error "TestObject has no actions."
+    nextActionsFor _ = noGen
+    updateEnvRaw _ e = e
+    actionRemote _ _ = error "TestObject has no actions."
+    mockObjDef = []
diff --git a/test/Test1.hs b/test/Test1.hs
--- a/test/Test1.hs
+++ b/test/Test1.hs
@@ -1,148 +1,22 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, TypeFamilies #-}
 
 module Main where
 
-import Graphics.QML
-import Control.Monad
-import Data.IORef
-import Data.List
-import Data.Maybe
-import Data.Typeable
-import Network.URI
+import Graphics.QML.Test.Framework
+import Graphics.QML.Test.Harness
+import Graphics.QML.Test.SimpleTest
+import Graphics.QML.Test.SignalTest
+import Graphics.QML.Test.MixedTest
+import Data.Proxy
 import System.Exit
-import System.IO
-import System.Directory
 
-data HarnessObject = HarnessObject {
-    globalState :: IORef [String]
-} deriving Typeable
-
-markTaskComplete :: HarnessObject -> String -> IO ()
-markTaskComplete go task = do
-    let ref = globalState go
-    list <- readIORef ref
-    if elem task list
-    then do
-        putStrLn (
-            showString "Completed task '" .
-            showString task $ showString "'." [])
-        writeIORef ref $ delete task list
-    else do
-        putStrLn (showString "Unexpected task '" .
-            showString task $ showString "' completed." [])
-        writeIORef ref $ ("unexpected_" ++ task) : list
-
-testInt :: Int
-testInt = 8888
-
-testDouble :: Double
-testDouble = 0.25
-
-testString :: String
-testString = "我係QuickBrownFox"
-
-testURI :: URI
-testURI =
-    URI "http:" (Just $ URIAuth "" "www.example.com" "")
-        "/with space" "" "#test"
-
-data TestObject = TestObject deriving (Eq, Typeable)
-
-instance Object TestObject where
-    classDef = defClass []
-
-instance MarshalIn TestObject where
-    mIn = objectInMarshaller
-
-instance Object HarnessObject where
-    classDef = defClass [
-        defMethod "getInt" (\go -> do
-            markTaskComplete (fromObjRef go) "getInt"
-            return testInt),
-        defMethod "setInt" (\go i -> do
-            markTaskComplete (fromObjRef go) "setInt"
-            if (i == testInt)
-            then markTaskComplete (fromObjRef go) "setIntCorrect"
-            else return ()),
-        defMethod "getDouble" (\go -> do
-            markTaskComplete (fromObjRef go) "getDouble"
-            return testDouble),
-        defMethod "setDouble" (\go i -> do
-            markTaskComplete (fromObjRef go) "setDouble"
-            if (i == testDouble)
-            then markTaskComplete (fromObjRef go) "setDoubleCorrect"
-            else return ()),
-        defMethod "getString" (\go -> do
-            markTaskComplete (fromObjRef go) "getString"
-            return testString),
-        defMethod "setString" (\go i -> do
-            markTaskComplete (fromObjRef go) "setString"
-            if (i == testString)
-            then markTaskComplete (fromObjRef go) "setStringCorrect"
-            else return ()),
-        defMethod "getURI" (\go -> do
-            markTaskComplete (fromObjRef go) "getURI"
-            return testURI),
-        defMethod "setURI" (\go i -> do
-            markTaskComplete (fromObjRef go) "setURI"
-            if (i == testURI)
-            then markTaskComplete (fromObjRef go) "setURICorrect"
-            else return ()),
-        defMethod "getObject" (\go -> do
-            markTaskComplete (fromObjRef go) "getObject"
-            newObject TestObject),
-        defMethod "setObject" (\go i -> do
-            markTaskComplete (fromObjRef go) "setObject"
-            if (i == TestObject)
-            then markTaskComplete (fromObjRef go) "setObjectCorrect"
-            else return ())]
-
-testScript :: String
-testScript = unlines [
-    "import Qt 4.7",
-    "Rectangle {",
-    "    id: page;",
-    "    width: 100; height: 100;",
-    "    color: 'green';",
-    "    Component.onCompleted: {",
-    "        var intVar = getInt();",
-    "        setInt(intVar);",
-    "        var dblVar = getDouble();",
-    "        setDouble(dblVar);",
-    "        var strVar = getString();",
-    "        setString(strVar);",
-    "        var uriVar = getURI();",
-    "        setURI(uriVar);",
-    "        var objVar = getObject();",
-    "        setObject(objVar);",
-    "        window.close();",
-    "    }",
-    "}"]
-
-testTasks :: [String]
-testTasks = [
-    "getInt", "setInt", "setIntCorrect",
-    "getDouble", "setDouble", "setDoubleCorrect",
-    "getString", "setString", "setStringCorrect",
-    "getURI", "setURI", "setURICorrect",
-    "getObject", "setObject", "setObjectCorrect"]
-
 main :: IO ()
 main = do
-    tmpDir <- getTemporaryDirectory
-    (qmlPath, hndl) <- openTempFile tmpDir "test1-.qml"
-    hPutStr hndl testScript
-    hClose hndl
-    list <- newIORef testTasks
-    go <- newObject $ HarnessObject list
-    createEngine defaultEngineConfig {
-        initialURL = filePathToURI qmlPath,
-        contextObject = Just go}
-    runEngines
-    removeFile qmlPath
-    ts <- readIORef list
-    forM_ ts (\t -> putStrLn (
-        showString "Incomplete task '" . showString t $ showString "'." []))
-    if null ts
+    rs <- sequence [
+        checkProperty $ TestType (Proxy :: Proxy SimpleMethods),
+        checkProperty $ TestType (Proxy :: Proxy SimpleProperties),
+        checkProperty $ TestType (Proxy :: Proxy SignalTest1),
+        checkProperty $ TestType (Proxy :: Proxy ObjectA)]
+    if and rs
     then exitSuccess
     else exitFailure