Initial commit

Author: natefaubion

.gitignore

@@ -0,0 +1,9 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2020 Awake Security
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

README.md

@@ -0,0 +1 @@
+# purescript-web-promise

bower.json

@@ -0,0 +1,30 @@
+{
+  "name": "purescript-web-encoding",
+  "homepage": "https://github.com/purescript-web/purescript-web-promise",
+  "license": "MIT",
+  "repository": {
+    "type": "git",
+    "url": "git://github.com/purescript-web/purescript-web-promise.git"
+  },
+  "ignore": [
+    "**/.*",
+    "bower_components",
+    "node_modules",
+    "output",
+    "bower.json",
+    "package.json"
+  ],
+  "ignore": [
+    "**/.*",
+    "node_modules",
+    "bower_components",
+    "output"
+  ],
+  "dependencies": {
+    "purescript-prelude": "^4.0.0",
+    "purescript-effect": "^2.0.0",
+    "purescript-maybe": "^4.0.0",
+    "purescript-functions": "^4.0.0",
+    "purescript-exceptions": "^4.0.0"
+  }
+}

src/Web/Promise.purs

@@ -0,0 +1,34 @@
+module Web.Promise
+  ( module Web.Promise
+  , module Web.Promise.Internal
+  , module Web.Promise.Rejection
+  ) where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Uncurried (mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2)
+import Web.Promise.Internal (Promise, reject, resolve)
+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)
+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_ k p = runEffectFn2 P.then_ (mkEffectFn1 k) p
+
+catch :: forall a b. (Rejection -> Effect (Promise b)) -> Promise a -> Effect (Promise b)
+catch k p = runEffectFn2 P.catch (mkEffectFn1 k) p
+
+finally :: forall a. (Effect (Promise Unit)) -> Promise a -> Effect (Promise a)
+finally = runEffectFn2 P.finally
+
+all :: forall a. Array (Promise a) -> Effect (Promise (Array a))
+all = runEffectFn1 P.all
+
+race :: forall a. Array (Promise a) -> Effect (Promise a)
+race = runEffectFn1 P.race

src/Web/Promise/Internal.js

@@ -0,0 +1,20 @@
+exports.new = function(k) {
+  return new Promise(k);
+};
+
+exports.then_ = function(k, p) {
+  return p.then(k);
+};
+
+exports.catch  = function(k, p) {
+  return p.catch(k);
+};
+
+exports.finally = function(k, p) {
+  return p.finally(k);
+};
+
+exports.resolve = Promise.resolve;
+exports.reject = Promise.reject;
+exports.all = Promise.all;
+exports.race = Promise.race;

src/Web/Promise/Internal.purs

@@ -0,0 +1,25 @@
+module Web.Promise.Internal where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Uncurried (EffectFn1, EffectFn2)
+import Web.Promise.Rejection (Rejection)
+
+foreign import data Promise :: Type -> Type
+
+foreign import new :: forall a. EffectFn1 (EffectFn2 (EffectFn1 a Unit) (EffectFn1 Rejection Unit) Unit) (Promise a)
+
+foreign import then_ :: forall a b. EffectFn2 (EffectFn1 a (Promise b)) (Promise a) (Promise b)
+
+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 reject :: forall a. Rejection -> Promise a
+
+foreign import all :: forall a. EffectFn1 (Array (Promise a)) (Promise (Array a))
+
+foreign import race :: forall a. EffectFn1 (Array (Promise a)) (Promise a)

src/Web/Promise/Lazy.purs

@@ -0,0 +1,56 @@
+module Web.Promise.Lazy where
+
+import Prelude
+
+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 Web.Promise.Internal as P
+
+-- | 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))
+
+derive instance newtypeLazyPromise :: Newtype (LazyPromise a) _
+
+instance functorLazyPromise :: Functor LazyPromise where
+  map = liftM1
+
+instance applyLazyPromise :: Apply LazyPromise where
+  apply = ap
+
+instance applicativeLazyPromise :: Applicative LazyPromise where
+  pure = LazyPromise <<< pure <<< P.resolve
+
+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'
+
+instance monadLazyPromise :: Monad LazyPromise
+
+instance monadEffectLazyPromise :: MonadEffect LazyPromise where
+  liftEffect = LazyPromise <<< map P.resolve
+
+catch :: forall a b. (Rejection -> LazyPromise b) -> LazyPromise a -> LazyPromise b
+catch k (LazyPromise p) = LazyPromise do
+  p' <- p
+  runEffectFn2 P.catch (mkEffectFn1 \a -> let (LazyPromise b) = k a in b) p'
+
+finally :: forall a. LazyPromise Unit -> LazyPromise a -> LazyPromise a
+finally (LazyPromise p1) (LazyPromise p2) = LazyPromise do
+  p2' <- p2
+  runEffectFn2 P.finally p1 p2'
+
+all :: forall a. Array (LazyPromise a) -> LazyPromise (Array a)
+all as = LazyPromise do
+  as' <- traverse (\(LazyPromise a) -> a) as
+  runEffectFn1 P.all as'
+
+race :: forall a. Array (LazyPromise a) -> LazyPromise a
+race as = LazyPromise do
+  as' <- traverse (\(LazyPromise a) -> a) as
+  runEffectFn1 P.race as'

src/Web/Promise/Rejection.js

@@ -0,0 +1,10 @@
+exports.fromError = function(a) {
+  return a;
+};
+
+exports._toError = function(just, nothing, rej) {
+  if (rej instanceof Error) {
+    return just(ref);
+  }
+  return nothing;
+};

src/Web/Promise/Rejection.purs

@@ -0,0 +1,18 @@
+module Web.Promise.Rejection
+  ( Rejection
+  , fromError
+  , toError
+  ) where
+
+import Data.Function.Uncurried (Fn3, runFn3)
+import Data.Maybe (Maybe(..))
+import Effect.Exception (Error)
+
+foreign import data Rejection :: Type
+
+foreign import fromError :: Error -> Rejection
+
+foreign import _toError :: Fn3 (forall a. a -> Maybe a) (forall a. Maybe a) Rejection (Maybe Error)
+
+toError :: Rejection -> Maybe Error
+toError = runFn3 _toError Just Nothing