diff --git a/src/Web/Promise.purs b/src/Web/Promise.purs index 2642976..d39042f 100644 --- a/src/Web/Promise.purs +++ b/src/Web/Promise.purs @@ -8,17 +8,23 @@ import Prelude import Effect (Effect) import Effect.Uncurried (mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2) -import Web.Promise.Internal (Promise, reject, resolve) +import Web.Promise.Internal (Promise, reject) import Web.Promise.Internal as P import Web.Promise.Rejection (Rejection) type Executor a = (a -> Effect Unit) -> (Rejection -> Effect Unit) -> Effect Unit -new :: forall a. Executor a -> Effect (Promise a) +class Flatten :: Type -> Type -> Constraint +class Flatten a b | a -> b + +instance flattenPromise :: Flatten a b => Flatten (Promise a) b +else instance flattenDone :: Flatten a a + +new :: forall a b. Flatten a b => Executor a -> Effect (Promise b) new k = runEffectFn1 P.new $ mkEffectFn2 \onResolve onReject -> k (runEffectFn1 onResolve) (runEffectFn1 onReject) -then_ :: forall a b. (a -> Effect (Promise b)) -> Promise a -> Effect (Promise b) +then_ :: forall a b c. Flatten b c => (a -> Effect (Promise b)) -> Promise a -> Effect (Promise c) then_ k p = runEffectFn2 P.then_ (mkEffectFn1 k) p catch :: forall a b. (Rejection -> Effect (Promise b)) -> Promise a -> Effect (Promise b) @@ -27,6 +33,9 @@ catch k p = runEffectFn2 P.catch (mkEffectFn1 k) p finally :: forall a. (Effect (Promise Unit)) -> Promise a -> Effect (Promise a) finally = runEffectFn2 P.finally +resolve :: forall a b. Flatten a b => a -> Promise b +resolve = P.resolve + all :: forall a. Array (Promise a) -> Effect (Promise (Array a)) all = runEffectFn1 P.all diff --git a/src/Web/Promise/Internal.purs b/src/Web/Promise/Internal.purs index e1b71a8..e421fa8 100644 --- a/src/Web/Promise/Internal.purs +++ b/src/Web/Promise/Internal.purs @@ -10,15 +10,15 @@ foreign import data Promise :: Type -> Type type role Promise representational -foreign import new :: forall a. EffectFn1 (EffectFn2 (EffectFn1 a Unit) (EffectFn1 Rejection Unit) Unit) (Promise a) +foreign import new :: forall a b. EffectFn1 (EffectFn2 (EffectFn1 a Unit) (EffectFn1 Rejection Unit) Unit) (Promise b) -foreign import then_ :: forall a b. EffectFn2 (EffectFn1 a (Promise b)) (Promise a) (Promise b) +foreign import then_ :: forall a b c. EffectFn2 (EffectFn1 a (Promise b)) (Promise a) (Promise c) foreign import catch :: forall a b. EffectFn2 (EffectFn1 Rejection (Promise b)) (Promise a) (Promise b) foreign import finally :: forall a. EffectFn2 (Effect (Promise Unit)) (Promise a) (Promise a) -foreign import resolve :: forall a. a -> Promise a +foreign import resolve :: forall a b. a -> Promise b foreign import reject :: forall a. Rejection -> Promise a diff --git a/src/Web/Promise/Lazy.purs b/src/Web/Promise/Lazy.purs index c0288a6..5933e6d 100644 --- a/src/Web/Promise/Lazy.purs +++ b/src/Web/Promise/Lazy.purs @@ -6,13 +6,16 @@ import Data.Newtype (class Newtype) import Data.Traversable (traverse) import Effect (Effect) import Effect.Class (class MonadEffect) -import Effect.Uncurried (mkEffectFn1, runEffectFn1, runEffectFn2) -import Web.Promise (Rejection) +import Effect.Uncurried (mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2) +import Web.Promise (Executor, Rejection) import Web.Promise.Internal as P +-- | A trivial box that adds a layer between promises to prevent automatic flattening. +data Box a = Box a + -- | A pure `Promise` that has not been executed yet. This type can be used -- | with `do` syntax. -newtype LazyPromise a = LazyPromise (Effect (P.Promise a)) +newtype LazyPromise a = LazyPromise (Effect (P.Promise (Box a))) derive instance newtypeLazyPromise :: Newtype (LazyPromise a) _ @@ -23,17 +26,21 @@ instance applyLazyPromise :: Apply LazyPromise where apply = ap instance applicativeLazyPromise :: Applicative LazyPromise where - pure = LazyPromise <<< pure <<< P.resolve + pure = LazyPromise <<< pure <<< P.resolve <<< Box instance bindLazyPromise :: Bind LazyPromise where bind (LazyPromise p) k = LazyPromise do p' <- p - runEffectFn2 P.then_ (mkEffectFn1 \a -> let (LazyPromise b) = k a in b) p' + runEffectFn2 P.then_ (mkEffectFn1 \(Box a) -> let (LazyPromise b) = k a in b) p' instance monadLazyPromise :: Monad LazyPromise instance monadEffectLazyPromise :: MonadEffect LazyPromise where - liftEffect = LazyPromise <<< map P.resolve + liftEffect = LazyPromise <<< map (P.resolve <<< Box) + +new :: forall a. Executor a -> LazyPromise a +new k = LazyPromise $ runEffectFn1 P.new $ mkEffectFn2 \onResolve onReject -> + k (runEffectFn1 onResolve <<< Box) (runEffectFn1 onReject) catch :: forall a b. (Rejection -> LazyPromise b) -> LazyPromise a -> LazyPromise b catch k (LazyPromise p) = LazyPromise do @@ -43,14 +50,21 @@ catch k (LazyPromise p) = LazyPromise do finally :: forall a. LazyPromise Unit -> LazyPromise a -> LazyPromise a finally (LazyPromise p1) (LazyPromise p2) = LazyPromise do p2' <- p2 - runEffectFn2 P.finally p1 p2' + runEffectFn2 P.finally finalize p2' + where + finalize = do + p1' <- p1 + runEffectFn2 P.then_ (mkEffectFn1 \(Box a) -> pure (P.resolve a)) p1' all :: forall a. Array (LazyPromise a) -> LazyPromise (Array a) all as = LazyPromise do as' <- traverse (\(LazyPromise a) -> a) as - runEffectFn1 P.all as' + as'' <- runEffectFn1 P.all as' + runEffectFn2 P.then_ rebox as'' + where + rebox = mkEffectFn1 \bs -> pure (P.resolve (Box (map (\(Box b) -> b) bs))) race :: forall a. Array (LazyPromise a) -> LazyPromise a race as = LazyPromise do as' <- traverse (\(LazyPromise a) -> a) as - runEffectFn1 P.race as' \ No newline at end of file + runEffectFn1 P.race as'