From 205e5d4c5ef772b18a1d95d872fe2c578b9c7b32 Mon Sep 17 00:00:00 2001
From: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
Date: Wed, 16 Aug 2017 11:56:16 +1200
Subject: [PATCH] Update promise handling code for jsffi

---
 Common.hs               |  4 +++-
 domconv-webkit-jsffi.hs | 14 ++++++++++++--
 2 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/Common.hs b/Common.hs
index 207f19b..6731ce0 100644
--- a/Common.hs
+++ b/Common.hs
@@ -1063,7 +1063,9 @@ tyRet' _ _ ffi (I.TyApply _ (I.TyInteger LongLong)) _ | ffi = mkTIdent "Double"
 tyRet' _ _ _ (I.TyApply _ (I.TyInteger _)) _ = mkTIdent "Int"
 tyRet' _ _ _ (I.TyObject) _ = mkTIdent "GObject"
 tyRet' _ _ _ (I.TyAny) _ = mkTIdent "JSVal"
-tyRet' pname enums ffi (I.TyPromise t) ext = tyRet' pname enums ffi t ext
+tyRet' pname enums True (I.TyPromise I.TyVoid) ext = mkTIdent "JSVal"
+tyRet' pname enums True (I.TyPromise t) ext = H.HsTyTuple [mkTIdent "JSVal", tyRet' pname enums True t ext]
+tyRet' pname enums False (I.TyPromise t) ext = tyRet' pname enums False t ext
 tyRet' pname enums ffi (I.TySum t) ext = mkTIdent (sumType t)
 tyRet' pname enums ffi (I.TyRecord (I.TyName a _) (I.TyName b _)) ext = H.HsTyApp (H.HsTyApp (mkTIdent "Record") (mkTIdent $ typeFor a)) (mkTIdent $ typeFor b)
 --tyRet' _ enums True (I.TyOptional (I.TyInteger LongLong)) _ = H.HsTyApp (mkTIdent "Nullable") (mkTIdent "Double")
diff --git a/domconv-webkit-jsffi.hs b/domconv-webkit-jsffi.hs
index eeb17d8..ca85a6d 100644
--- a/domconv-webkit-jsffi.hs
+++ b/domconv-webkit-jsffi.hs
@@ -1376,7 +1376,17 @@ returnType _ (I.TyOptional _) _ _ e =
 --            _ -> error "Issue with wrapType?")
 --          (H.HsQVarOp (mkSymbol "<$>"))
 --          (H.HsParen e)
-returnType enums (I.TyPromise t) ext wrapType e = returnType enums t ext wrapType e
+returnType enums (I.TyPromise I.TyVoid) ext wrapType e =
+        H.HsInfixApp
+          (H.HsParen e)
+          (H.HsQVarOp (mkSymbol ">>="))
+          (mkVar "maybeThrowPromiseRejected")
+returnType enums (I.TyPromise t) ext wrapType e =
+        returnType enums t ext wrapType $
+            H.HsInfixApp
+              (H.HsParen e)
+              (H.HsQVarOp (mkSymbol ">>="))
+              (mkVar "checkPromiseResult")
 --returnType _ (I.TySum _) _ _ e =
 --        H.HsInfixApp
 --          (H.HsParen e)
@@ -1391,7 +1401,7 @@ returnType _ _ _ _ e = e
 
 jsReturn :: I.Type -> JExpr -> String
 jsReturn (I.TyName "Bool" Nothing) e = show $ renderJs [jmacroE| `(e)`?1:0 |]
-jsReturn (I.TyPromise _) e = show $ renderJs [jmacro| `(e)`.then($c); |]
+jsReturn (I.TyPromise _) e = show (renderJs [jmacroE| `(e)` |]) <> ".then(function(s) { $c(null, s);}, function(e) { $c(e, null);});"
 jsReturn _ e = show $ renderJs e
 
 gtkName s =