Make use of purescript-web-promise

Author: garyb

bower.json

@@ -16,7 +16,8 @@
   ],
   "dependencies": {
     "purescript-aff": "^7.0.0",
-    "purescript-foreign": "^7.0.0"
+    "purescript-foreign": "^7.0.0",
+    "purescript-web-promise": "purescript-web/purescript-web-promise#^3.1.0"
   },
   "devDependencies": {
     "purescript-assert": "^6.0.0",

src/Control/Promise.js

@@ -1,38 +1,32 @@
-module Control.Promise (fromAff, toAff, toAff', toAffE, Promise()) where
+module Control.Promise
+  ( module Control.Promise
+  , module Web.Promise
+  ) where
 
 import Prelude
 
 import Control.Alt ((<|>))
 import Control.Monad.Except (runExcept)
-import Data.Either (Either(..), either)
+import Data.Either (Either(..), either, hush)
+import Data.Maybe (fromMaybe')
 import Effect (Effect)
 import Effect.Aff (Aff, makeAff, runAff_)
 import Effect.Class (liftEffect)
 import Effect.Exception (Error, error)
-import Effect.Uncurried (EffectFn1, mkEffectFn1)
-import Foreign (Foreign, readString, unsafeReadTagged)
-
--- | Type of JavaScript Promises (with particular return type)
--- | Effects are not traced in the Promise type, as they form part of the Effect that
--- | results in the promise.
-foreign import data Promise :: Type -> Type
-
-type role Promise representational
-
-foreign import promise :: forall a b.
-  ((a -> Effect Unit) -> (b -> Effect Unit) -> Effect Unit) -> Effect (Promise a)
-foreign import thenImpl :: forall a b.
-  Promise a -> (EffectFn1 Foreign b) -> (EffectFn1 a b) -> Effect Unit
+import Foreign (readString, unsafeToForeign)
+import Web.Promise (Promise, Rejection)
+import Web.Promise as Promise
+import Web.Promise.Rejection as Rejection
 
 -- | Convert an Aff into a Promise.
-fromAff :: forall a. Aff a -> Effect (Promise a)
-fromAff aff = promise (\succ err -> runAff_ (either err succ) aff)
+fromAff :: forall a. Promise.Flatten a a ⇒ Aff a -> Effect (Promise a)
+fromAff aff = Promise.new (\succ err -> runAff_ (either (err <<< Rejection.fromError) succ) aff)
 
-coerce :: Foreign -> Error
-coerce fn =
-  either (\_ -> error "Promise failed, couldn't extract JS Error or String")
-         identity
-         (runExcept ((unsafeReadTagged "Error" fn) <|> (error <$> readString fn)))
+coerce :: Rejection -> Error
+coerce rej =
+  fromMaybe'
+    (\_ → error "Promise failed, couldn't extract JS Error or String")
+    (Rejection.toError rej <|> map error (hush (runExcept (readString (unsafeToForeign rej)))))
 
 -- | Convert a Promise into an Aff.
 -- | When the promise rejects, we attempt to
@@ -44,12 +38,13 @@ toAff = toAff' coerce
 -- | Convert a Promise into an Aff with custom Error coercion.
 -- | When the promise rejects, we attempt to coerce the error value into an
 -- | actual JavaScript Error object using the provided function.
-toAff' :: forall a. (Foreign -> Error) -> Promise a -> Aff a
-toAff' customCoerce p = makeAff
-  (\cb -> mempty <$ thenImpl
-    p
-    (mkEffectFn1 $ cb <<< Left <<< customCoerce)
-    (mkEffectFn1 $ cb <<< Right))
+toAff' :: forall a. (Rejection -> Error) -> Promise a -> Aff a
+toAff' customCoerce p = makeAff \cb →
+  mempty <$
+    Promise.thenOrCatch
+      (\a -> Promise.resolve <$> cb (Right a))
+      (\e -> Promise.resolve <$> cb (Left (customCoerce e)))
+      p
 
 -- | Utility to convert an Effect returning a Promise into an Aff (i.e. the inverse of fromAff)
 toAffE :: forall a. Effect (Promise a) -> Aff a

src/Control/Promise.purs

@@ -3,9 +3,9 @@ module Test.Main where
 import Prelude
 
 import Control.Alt ((<|>))
-import Control.Monad.Reader.Trans (runReaderT)
-import Control.Monad.Reader.Class (class MonadReader, ask, local)
 import Control.Monad.Except (runExcept)
+import Control.Monad.Reader.Class (class MonadReader, ask, local)
+import Control.Monad.Reader.Trans (runReaderT)
 import Control.Promise (Promise)
 import Control.Promise as Promise
 import Data.Either (either)
@@ -17,7 +17,7 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Console (log)
 import Effect.Exception (error, message)
-import Foreign (readString, unsafeFromForeign)
+import Foreign (readString, unsafeToForeign)
 import Foreign.Index (readProp)
 import Test.Assert as Assert
 
@@ -86,8 +86,8 @@ main = launchAff_ $ flip runReaderT "" do
         assert "round-trip result for toAffE is 123" $ res == 123
     test "error" do
       promise <- liftEffect $ Promise.fromAff $ throwError $ error "err123"
-      res <- attempt $ Promise.toAff promise
+      res <- attempt $ Promise.toAff (promise :: Promise Unit)
       shouldEqual "err123" $ either message (const "-") res
   where
     errorCodeCoerce v = either (\_ -> error "fail") error $
-                          (runExcept $ readProp "code" (unsafeFromForeign v) >>= readString)
+                          (runExcept $ readProp "code" (unsafeToForeign v) >>= readString)