Merge pull request #23 from purescript-contrib/topic/promise-refactoring

Topic/promise refactoring

Author: ethul

MODULE.md

@@ -381,7 +381,7 @@
 
     data Http :: *
 
-    type HttpResponse e r a b c d = HttpEff e (Promise (Response r a b c d) (Response r a b c d))
+    type HttpResponse e r a b c d = HttpEff e (Promise I.ForeignResponse (Response r a b c d))
 
     type Response r a b c d = { statusText :: String, config :: Config a b c d, headers :: [String] -> String, status :: Status, "data" :: D.HttpData r }
 
@@ -681,37 +681,30 @@
 
     data Promise :: * -> * -> *
 
+    type PromiseEC e a b = ErrorT a (ContT Unit (Eff e)) b
 
-### Type Class Instances
-
-    instance applicativePromise :: Applicative (Promise a)
-
-    instance applyPromise :: Apply (Promise a)
-
-    instance bifunctorPromise :: Bifunctor Promise
-
-    instance bindPromise :: Bind (Promise a)
 
-    instance functorPromise :: Functor (Promise a)
+### Values
 
-    instance monadPromise :: Monad (Promise a)
+    catch :: forall a b c d. (a -> Promise c d) -> Promise a b -> Promise c d
 
+    finally :: forall e r a b. Eff e r -> Promise a b -> Promise a b
 
-### Values
+    liftPromiseEC :: forall e a b. (Error a) => Eff e (Promise a b) -> PromiseEC e a b
 
-    catch' :: forall a b c d. (a -> Promise c d) -> Promise a b -> Promise c d
+    runPromiseEC :: forall e a b. PromiseEC e a b -> (Either a b -> Eff e Unit) -> Eff e Unit
 
-    finally' :: forall e r a b. Eff e r -> Promise a b -> Promise a b
+    then1 :: forall a b c. (b -> Promise a c) -> Promise a b -> Promise a c
 
-    pureReject :: forall a b. a -> Promise a b
+    then1' :: forall a b c. (b -> c) -> Promise a b -> Promise a c
 
-    pureResolve :: forall a b. b -> Promise a b
+    then2 :: forall a b c d. (b -> Promise c d) -> (a -> Promise c d) -> Promise a b -> Promise c d
 
-    then' :: forall a b c. (b -> Promise a c) -> Promise a b -> Promise a c
+    then2' :: forall a b c d. (b -> d) -> (a -> c) -> Promise a b -> Promise c d
 
-    then'' :: forall a b c d. (b -> Promise c d) -> (a -> Promise c d) -> Promise a b -> Promise c d
+    then3 :: forall e s t a b c d. (b -> Promise c d) -> (a -> Promise c d) -> (s -> Eff e t) -> Promise a b -> Promise c d
 
-    then''' :: forall e s t a b c d. (b -> Promise c d) -> (a -> Promise c d) -> (s -> Eff e t) -> Promise a b -> Promise c d
+    then3' :: forall e s t a b c d. (b -> d) -> (a -> c) -> (s -> Eff e t) -> Promise a b -> Promise c d
 
 
 ## Module Angular.Q
@@ -897,6 +890,11 @@
     data ForeignResponse :: *
 
 
+### Type Class Instances
+
+    instance errorForeignResponse :: Error ForeignResponse
+
+
 ### Values
 
     foreignConfig :: forall e. HttpEff e ForeignConfig
@@ -1025,42 +1023,4 @@
     writeRequestData :: forall a. RequestData a -> ForeignRequestData
 
 
-## Module Angular.Promise.Eff
-
-### Types
-
-    newtype PromiseEff e f a b where
-      PromiseEff :: Promise (Eff e a) (Eff f b) -> PromiseEff e f a b
-
-
-### Type Class Instances
-
-    instance applicativePromiseEff :: Applicative (PromiseEff e f a)
-
-    instance applyPromise :: Apply (PromiseEff e f a)
-
-    instance bifunctorPromise :: Bifunctor (PromiseEff e f)
-
-    instance bindPromiseEff :: Bind (PromiseEff e f a)
-
-    instance functorPromiseEff :: Functor (PromiseEff e f a)
-
-
-### Values
-
-    liftPromiseEff :: forall e f a b. Eff e a -> Eff f b -> PromiseEff e f a b
-
-    liftPromiseEff' :: forall e f a b. Eff f b -> PromiseEff e f a b
-
-    promiseEff :: forall e f a b. Promise a b -> PromiseEff e f a b
-
-    promiseEff' :: forall e f a b. Promise a (Eff f b) -> PromiseEff e f a b
-
-    promiseEff'' :: forall e f a b. Promise (Eff e a) b -> PromiseEff e f a b
-
-    runPromiseEff :: forall e f a b. PromiseEff e f a b -> Promise (Eff e a) (Eff f b)
-
-    unsafeRunPromiseEff :: forall e f a b. PromiseEff e f a b -> Promise a b
-
-
 

bower.json

@@ -17,11 +17,11 @@
     "dist"
   ],
   "dependencies": {
-    "purescript-bifunctors": "0.0.6",
     "purescript-either": "0.1.3",
     "purescript-exceptions": "0.2.1",
     "purescript-foldable-traversable": "0.1.4",
     "purescript-maybe": "0.2.1",
+    "purescript-transformers": "0.3.0",
     "purescript-tuples": "0.2.1",
     "purescript-simple-dom": "git://github.com/aktowns/purescript-simple-dom.git"
   },

examples/Backend/Main.purs

@@ -0,0 +1,29 @@
+module Backend.Main where
+
+import Control.Monad.Eff
+import Data.Either (either)
+
+import Angular.Http (Http(), get)
+import Angular.Module (controller, ngmodule')
+import Angular.Promise (liftPromiseEC, runPromiseEC)
+import Angular.This (extendThis)
+
+mainctrl http this = extendThis { text: ""
+                                , submit: submit } this
+  where
+    url = "http://localhost:9501/examples/Backend/main.html"
+    submit a = runPromiseEC (liftPromiseEC $ get url http)
+                            (either (\e -> extendThis { value: "Failed to get" ++ url } this)
+                                    (\a -> extendThis { value: a."data" } this))
+
+main = do
+  m <- ngmodule' "backend" []
+  controller "Main" mainctrl' m
+
+foreign import mainctrl'
+  """
+  /*@ngInject*/function mainctrl$prime($http) {
+    var impl = mainctrl($http)(this);
+    return impl.apply(this, []);
+  }
+  """ :: forall e a. Http -> Eff e Unit

examples/Backend/main.html

@@ -0,0 +1,30 @@
+<!doctype html>
+<html class="no-js"
+      lang=""
+      ng-app="backend">
+  <head>
+    <meta charset="utf-8">
+    <meta http-equiv="X-UA-Compatible"
+          content="IE=edge">
+    <title>Backend</title>
+    <meta name="description"
+          content="">
+    <meta name="viewport"
+          content="width=device-width, initial-scale=1">
+    <link rel="stylesheet"
+          href="../../bower_components/angular/angular-csp.css">
+  </head>
+  <body ng-controller="Main as mainctrl">
+    <form ng-submit="mainctrl.submit(mainctrl.text)()"
+          novalidate>
+      <button type="submit">
+        Submit
+      </button>
+    </form>
+    <code ng-cloak>
+      {{mainctrl.value.value0}}
+    </code>
+    <script src="../../bower_components/angular/angular.js"></script>
+    <script src="../../dist/backend.js"></script>
+  </body>
+</html>

gulpfile.js

@@ -13,14 +13,23 @@ var gulp = require('gulp')
           'src/**/*.purs'
         ],
         examples: {
-          todomvc: 'examples/Todomvc/**/*.purs'
+          todomvc: {
+            src: 'examples/Todomvc/**/*.purs',
+            options: {
+              main: 'Todomvc.Main',
+              output: 'todomvc.js'
+            }
+          },
+          backend: {
+            src: 'examples/Backend/**/*.purs',
+            options: {
+              main: 'Backend.Main',
+              output: 'backend.js'
+            }
+          }
         },
         dest: 'dist',
-        docs: 'MODULE.md',
-        options: {
-          main: 'Todomvc.Main',
-          output: 'todomvc.js'
-        }
+        docs: 'MODULE.md'
       },
       nstatic: {
         root: '.',
@@ -55,9 +64,19 @@ gulp.task('clean', function(){
 
 gulp.task('todomvc', ['clean'], function(){
   return (
-    gulp.src([config.purescript.examples.todomvc].concat(config.purescript.src)).
+    gulp.src([config.purescript.examples.todomvc.src].concat(config.purescript.src)).
     pipe(plumber()).
-    pipe(purescript.psc(config.purescript.options)).
+    pipe(purescript.psc(config.purescript.examples.todomvc.options)).
+    on('error', error).
+    pipe(gulp.dest(config.purescript.dest))
+  );
+});
+
+gulp.task('backend', ['clean'], function(){
+  return (
+    gulp.src([config.purescript.examples.backend.src].concat(config.purescript.src)).
+    pipe(plumber()).
+    pipe(purescript.psc(config.purescript.examples.backend.options)).
     on('error', error).
     pipe(gulp.dest(config.purescript.dest))
   );
@@ -96,7 +115,12 @@ gulp.task('watch', function(cb){
 });
 
 gulp.task('watch.todomvc', function(cb){
-  gulp.watch([config.purescript.examples.todomvc].concat(config.purescript.src), ['todomvc']);
+  gulp.watch([config.purescript.examples.todomvc.src].concat(config.purescript.src), ['todomvc']);
+  server(cb);
+});
+
+gulp.task('watch.backend', function(cb){
+  gulp.watch([config.purescript.examples.backend.src].concat(config.purescript.src), ['backend']);
   server(cb);
 });
 

src/Angular/Http.purs

@@ -19,7 +19,6 @@ module Angular.Http
  , put'
  ) where
 
-import Data.Bifunctor
 import Data.Either
 import Data.Function
 import Data.Maybe
@@ -30,11 +29,11 @@ import qualified Data.DOM.Simple.Ajax as D
 import Angular.Cache (Cache())
 import qualified Angular.Http.Internal as I
 import Angular.Http.Types
-import Angular.Promise (Promise())
+import Angular.Promise (Promise(), then1')
 
 foreign import data Http :: *
 
-type HttpResponse e r a b c d = HttpEff e (Promise (Response r a b c d) (Response r a b c d))
+type HttpResponse e r a b c d = HttpEff e (Promise I.ForeignResponse (Response r a b c d))
 
 type ForeignHttpResponse e = HttpEff e (Promise I.ForeignResponse I.ForeignResponse)
 
@@ -78,7 +77,7 @@ config = { method: D.GET
          , responseType: D.Default }
 
 http :: forall e r a b c d. Config a b c d -> Http -> HttpResponse e r a b c d
-http c h = (bimap foreignResponse foreignResponse) <$> (foreignConfig c >>= runFn2 httpFn h)
+http c h = (then1' foreignResponse) <$> (foreignConfig c >>= runFn2 httpFn h)
 
 get :: forall e r a b c d. D.Url -> Http -> HttpResponse e r a b c d
 get u = runHttpFn' D.GET u config
@@ -120,13 +119,13 @@ runHttpFn' :: forall e r a b c d. D.HttpMethod -> D.Url -> Config a b c d -> Htt
 runHttpFn' m u c h = do
   conf <- foreignConfig c
   res <- runFn4 httpFn' (show m) u conf h
-  return $ bimap foreignResponse foreignResponse res
+  return $ then1' foreignResponse res
 
 runHttpFn'' :: forall e r a b c d. D.HttpMethod -> D.Url -> RequestData b -> Config a b c d -> Http -> HttpResponse e r a b c d
 runHttpFn'' m u d c h = do
   conf <- foreignConfig c
   res <- runFn5 httpFn'' (show m) u (writeRequestData d) conf h
-  return $ bimap foreignResponse foreignResponse res
+  return $ then1' foreignResponse res
 
 foreignConfig :: forall e a b c d. Config a b c d -> HttpEff e I.ForeignConfig
 foreignConfig conf = do

src/Angular/Http/Internal.purs

@@ -32,6 +32,7 @@ module Angular.Http.Internal
   ) where
 
 import Control.Monad.Eff
+import Control.Monad.Error
 import Data.Either
 import Data.Foldable (for_)
 import Data.Function
@@ -47,6 +48,18 @@ foreign import data ForeignConfig :: *
 
 foreign import data ForeignResponse :: *
 
+foreign import unimplementedForeignResponse
+  """
+    function unimplementedForeignResponse(){
+      return {
+      };
+    }
+  """ :: ForeignResponse
+
+instance errorForeignResponse :: Error ForeignResponse where
+  noMsg = unimplementedForeignResponse
+  strMsg = \_ -> unimplementedForeignResponse
+
 setConfigMethod :: forall e. D.HttpMethod -> ForeignConfig -> HttpEff e Unit
 setConfigMethod m = runFn3 setConfigPropFn "method" (show m)