Various small improments and changes.

10 files changed, 121 insertions, 164 deletions

diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux
index 84def78d1..5412e5342 100644
--- a/stdlib/source/lux/control/concurrency/frp.lux
+++ b/stdlib/source/lux/control/concurrency/frp.lux
@@ -1,14 +1,16 @@
 (.module:
   [lux (#- Source)
+   ["." io (#+ IO io)]
    [control
+    [predicate (#+ Predicate)]
+    [equivalence (#+ Equivalence)]
     [functor (#+ Functor)]
     [apply (#+ Apply)]
-    ["." monad (#+ do Monad)]
-    [predicate (#+ Predicate)]
-    [equivalence (#+ Equivalence)]]
-   ["." io (#+ IO)]
+    ["." monad (#+ Monad do)]
+    ["ex" exception (#+ exception:)]]
    [data
     [maybe ("maybe/." functor)]
+    ["." error (#+ Error)]
     [collection
      [list ("list/." monoid)]]]
    [type (#+ :share)
@@ -21,10 +23,12 @@
   {#.doc "An asynchronous channel to distribute values."}
   (Promise (Maybe [a (Channel a)])))
 
+(exception: #export channel-is-already-closed)
+
 (signature: #export (Source a)
-  (: (IO Bit)
+  (: (IO (Error Any))
      close)
-  (: (-> a (IO Bit))
+  (: (-> a (IO (Error Any)))
      feed))
 
 (def: (source resolve)
@@ -40,13 +44,13 @@
             stopped? (current #.None)]
            (if stopped?
              ## I closed the source.
-             (wrap true)
+             (wrap (ex.return []))
              ## Someone else interacted with the source.
              (do @
                [latter (atom.read source)]
                (if (is? current latter)
                  ## Someone else closed the source.
-                 (wrap true)
+                 (wrap (ex.throw channel-is-already-closed []))
                  ## Someone else fed the source while I was closing it.
                  (recur [])))))))
      
@@ -63,13 +67,15 @@
             fed? (current (#.Some [value next]))]
            (if fed?
              ## I fed the source.
-             (atom.compare-and-swap current resolve-next source)
+             (do @
+               [_ (atom.compare-and-swap current resolve-next source)]
+               (wrap (ex.return [])))
              ## Someone else interacted with the source.
              (do @
                [latter (atom.read source)]
                (if (is? current latter)
                  ## Someone else closed the source while I was feeding it.
-                 (wrap false)
+                 (wrap (ex.throw channel-is-already-closed []))
                  ## Someone else fed the source.
                  (recur []))))))))))
 
@@ -80,18 +86,18 @@
 
 (def: #export (listen listener channel)
   (All [a] (-> (-> a (IO Any)) (Channel a) (IO Any)))
-  (io.io (exec (: (Promise Any)
-                  (loop [channel channel]
-                    (do promise.monad
-                      [cons channel]
-                      (case cons
-                        (#.Some [head tail])
-                        (exec (io.run (listener head))
-                          (recur tail))
-                        
-                        #.None
-                        (wrap [])))))
-           [])))
+  (io (exec (: (Promise Any)
+               (loop [channel channel]
+                 (do promise.monad
+                   [cons channel]
+                   (case cons
+                     (#.Some [head tail])
+                     (exec (io.run (listener head))
+                       (recur tail))
+                     
+                     #.None
+                     (wrap [])))))
+        [])))
 
 (structure: #export functor (Functor Channel)
   (def: (map f)
@@ -190,7 +196,7 @@
 
 (def: #export (periodic milli-seconds)
   (-> Nat (Channel Any))
-  (poll milli-seconds (io.io [])))
+  (poll milli-seconds (io [])))
 
 (def: #export (iterate f init)
   (All [a] (-> (-> a (Promise (Maybe a))) a (Channel a)))
diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux
index 244951139..72fe34bcb 100644
--- a/stdlib/source/lux/control/concurrency/promise.lux
+++ b/stdlib/source/lux/control/concurrency/promise.lux
@@ -21,26 +21,27 @@
   (type: #export (Resolver a)
     (-> a (IO Bit)))
 
-  (def: (resolver (^:representation promise))
+  (def: (resolver promise)
     {#.doc "Sets an promise's value if it has not been done yet."}
     (All [a] (-> (Promise a) (Resolver a)))
     (function (resolve value)
-      (do io.monad
-        [(^@ old [_value _observers]) (atom.read promise)]
-        (case _value
-          (#.Some _)
-          (wrap #0)
-
-          #.None
-          (do @
-            [#let [new [(#.Some value) #.None]]
-             succeeded? (atom.compare-and-swap old new promise)]
-            (if succeeded?
-              (do @
-                [_ (monad.map @ (function (_ f) (f value))
-                              _observers)]
-                (wrap #1))
-              (resolve value)))))))
+      (let [promise (:representation promise)]
+        (do io.monad
+          [(^@ old [_value _observers]) (atom.read promise)]
+          (case _value
+            (#.Some _)
+            (wrap #0)
+
+            #.None
+            (do @
+              [#let [new [(#.Some value) #.None]]
+               succeeded? (atom.compare-and-swap old new promise)]
+              (if succeeded?
+                (do @
+                  [_ (monad.map @ (function (_ f) (f value))
+                                _observers)]
+                  (wrap #1))
+                (resolve value))))))))
 
   (def: #export (resolved value)
     (All [a] (-> a (Promise a)))
@@ -51,16 +52,18 @@
     (let [promise (:abstraction (atom [#.None (list)]))]
       [promise (..resolver promise)]))
 
-  (def: #export (poll (^:representation promise))
+  (def: #export poll
     {#.doc "Polls a promise's value."}
     (All [a] (-> (Promise a) (Maybe a)))
-    (|> (atom.read promise)
-        io.run
-        product.left))
+    (|>> :representation
+         atom.read
+         io.run
+         product.left))
 
-  (def: #export (await f (^:representation promise))
+  (def: #export (await f promise)
     (All [a] (-> (-> a (IO Any)) (Promise a) (IO Any)))
-    (let [(^@ old [_value _observers]) (io.run (atom.read promise))]
+    (let [promise (:representation promise)
+          (^@ old [_value _observers]) (io.run (atom.read promise))]
       (case _value
         (#.Some value)
         (f value)
diff --git a/stdlib/source/lux/control/identity.lux b/stdlib/source/lux/control/identity.lux
deleted file mode 100644
index ff79bedca..000000000
--- a/stdlib/source/lux/control/identity.lux
+++ /dev/null
@@ -1,60 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [equivalence (#+ Equivalence)]
-    [security
-     [capability (#+ Capability)]]]
-   [type
-    abstract]])
-
-(abstract: #export (ID code entity storage)
-  {#.doc "A value that uniquely identifies an entity in some foreign data storage (such as a database)."}
-
-  code
-
-  (structure: #export (equivalence Equivalence<code>)
-    (All [code entity storage]
-      (-> (Equivalence code)
-          (Equivalence (ID code entity storage))))
-    (def: (= reference sample)
-      (:: Equivalence<code> =
-          (:representation reference)
-          (:representation sample))))
-
-  (type: #export (Can-Identify code storage)
-    (All [entity]
-      (Capability code
-                  (ID code entity storage))))
-
-  (type: #export (Can-Anonymize code storage)
-    (All [entity]
-      (Capability (ID code entity storage)
-                  code)))
-
-  (type: #export (Service code)
-    (Ex [storage]
-      [(Can-Identify code storage)
-       (Can-Anonymize code storage)]))
-
-  (def: Service<_>
-    (All [code storage] (Service code storage))
-    [(|>> :abstraction)
-     (|>> :representation)])
-
-  (type: #export (Context code scope storage)
-    (-> (Service code storage)
-        (scope storage)))
-
-  (def: #export (service _)
-    (All [code]
-      (Ex [storage]
-        (-> Any (Service code storage))))
-    ..Service<_>)
-
-  (def: #export (with-identity context)
-    (All [code scope]
-      (Ex [storage]
-        (-> (Context code scope storage)
-            (scope storage))))
-    (context ..Service<_>))
-  )
diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux
index 09421e4ee..914a141ab 100644
--- a/stdlib/source/lux/control/security/capability.lux
+++ b/stdlib/source/lux/control/security/capability.lux
@@ -1,8 +1,11 @@
 (.module:
   [lux #*
+   ["." io (#+ IO)]
    [control
     [monad (#+ do)]
-    ["p" parser]]
+    ["p" parser]
+    [concurrency
+     ["." promise (#+ Promise)]]]
    [data
     [text
      format]
@@ -23,7 +26,7 @@
 
   (-> input output)
 
-  (def: default-forge
+  (def: forge
     (All [brand input output]
       (-> (-> input output)
           (Capability brand input output)))
@@ -54,6 +57,12 @@
                        (All [(~+ (list/map code.local-identifier vars))]
                          (-> (-> (~ input) (~ output))
                              (~ capability)))
-                       (~! ..default-forge)))
+                       (~! ..forge)))
                   ))))
+
+  (def: #export (async capability)
+    (All [brand input output]
+      (-> (Capability brand input (IO output))
+          (Capability brand input (Promise output))))
+    (..forge (|>> ((:representation capability)) promise.future)))
   )
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index d4dc36ad0..e06948838 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -5,7 +5,7 @@
     ["." monad (#+ Monad do)]
     [equivalence (#+ Equivalence)]
     codec
-    ["p" parser ("parser/." monad)]
+    ["p" parser (#+ Parser) ("parser/." monad)]
     ["ex" exception (#+ exception:)]]
    [data
     ["." bit]
@@ -51,7 +51,7 @@
 
 (type: #export (Reader a)
   {#.doc "JSON reader."}
-  (p.Parser (List JSON) a))
+  (Parser (List JSON) a))
 
 (syntax: #export (json token)
   {#.doc (doc "A simple way to produce JSON literals."
diff --git a/stdlib/source/lux/world/net/http.lux b/stdlib/source/lux/world/net/http.lux
index e84472710..d3bbf5a37 100644
--- a/stdlib/source/lux/world/net/http.lux
+++ b/stdlib/source/lux/world/net/http.lux
@@ -5,6 +5,7 @@
      [promise (#+ Promise)]
      [frp (#+ Channel)]]]
    [data
+    [error (#+ Error)]
     [format
      [context (#+ Context)]]]
    [world
@@ -72,3 +73,6 @@
 
 (type: #export Server
   (-> Request (Promise Response)))
+
+(type: #export Client
+  (-> [Method URL Context Data] (Promise (Error Response))))
diff --git a/stdlib/source/lux/world/net/http/request.lux b/stdlib/source/lux/world/net/http/request.lux
index ad8a2e450..b8c4b6b4e 100644
--- a/stdlib/source/lux/world/net/http/request.lux
+++ b/stdlib/source/lux/world/net/http/request.lux
@@ -48,16 +48,17 @@
 
 (def: failure (//response.bad-request ""))
 
-(def: #export (json server)
-  (-> (-> JSON Server) Server)
+(def: #export (json reader server)
+  (All [a] (-> (json.Reader a) (-> a Server) Server))
   (function (_ (^@ request [identification protocol resource message]))
     (do promise.monad
       [?raw (read-text-body (get@ #//.body message))]
       (case (do error.monad
-              [raw ?raw]
-              (:: json.codec decode raw))
-        (#error.Success content)
-        (server content request)
+              [raw ?raw
+               content (:: json.codec decode raw)]
+              (json.run content reader))
+        (#error.Success input)
+        (server input request)
         
         (#error.Failure error)
         (promise.resolved ..failure)))))
diff --git a/stdlib/source/lux/world/service/crud.lux b/stdlib/source/lux/world/service/crud.lux
index f27bda2a3..8e1e99277 100644
--- a/stdlib/source/lux/world/service/crud.lux
+++ b/stdlib/source/lux/world/service/crud.lux
@@ -1,36 +1,33 @@
 (.module:
   [lux #*
    [control
-    [identity (#+ ID)]
     [security
-     [capability (#+ Capability)]]]
+     ["!" capability (#+ capability:)]]]
    [data
     ["." error (#+ Error)]]
    [time
     ["." instant (#+ Instant)]]])
 
+(type: #export ID Nat)
+
 (type: #export Time
   {#created Instant
    #updated Instant})
 
-(type: #export (Can-Create ! code entity storage)
-  (Capability [Instant entity]
-              (! (Error (ID code entity storage)))))
+(capability: #export (Can-Create ! entity)
+  (can-create [Instant entity] (! (Error ID))))
 
-(type: #export (Can-Retrieve ! code entity storage)
-  (Capability (ID code entity storage)
-              (! (Error [Time entity]))))
+(capability: #export (Can-Retrieve ! entity)
+  (can-retrieve ID (! (Error [Time entity]))))
 
-(type: #export (Can-Update ! code entity storage)
-  (Capability [(ID code entity storage) Instant entity]
-              (! (Error Any))))
+(capability: #export (Can-Update ! entity)
+  (can-update [ID Instant entity] (! (Error Any))))
 
-(type: #export (Can-Delete ! code entity storage)
-  (Capability (ID code entity storage)
-              (! (Error Any))))
+(capability: #export (Can-Delete ! entity)
+  (can-delete ID (! (Error Any))))
 
-(type: #export (CRUD ! code entity storage)
-  [(Can-Create ! code entity storage)
-   (Can-Retrieve ! code entity storage)
-   (Can-Update ! code entity storage)
-   (Can-Delete ! code entity storage)])
+(type: #export (CRUD ! entity)
+  {#can-create (Can-Create ! entity)
+   #can-retrieve (Can-Retrieve ! entity)
+   #can-update (Can-Update ! entity)
+   #can-delete (Can-Delete ! entity)})
diff --git a/stdlib/source/lux/world/service/inventory.lux b/stdlib/source/lux/world/service/inventory.lux
index 00b20e71a..0e3fae6be 100644
--- a/stdlib/source/lux/world/service/inventory.lux
+++ b/stdlib/source/lux/world/service/inventory.lux
@@ -1,34 +1,31 @@
 (.module:
   [lux #*
    [control
-    [identity (#+ ID)]
     [security
-     [capability (#+ Capability)]]]
+     ["!" capability (#+ capability:)]]]
    [data
     [error (#+ Error)]]])
 
-(with-expansions [<vars> (as-is ! $ @ owner property)
-                  <owner> (as-is (ID @ owner $))
-                  <property> (as-is (ID @ property $))]
-  (type: #export (Can-Own <vars>)
-    (Capability [<owner> <property>]
-                (! (Error Any))))
+(type: #export ID Nat)
 
-  (type: #export (Can-Disown <vars>)
-    (Capability [<owner> <property>]
-                (! (Error Any))))
+(type: #export Ownership
+  {#owner ID
+   #property ID})
 
-  (type: #export (Can-Check <vars>)
-    (Capability [<owner> <property>]
-                (! (Error Bit))))
+(capability: #export (Can-Own !)
+  (can-own Ownership (! (Error Any))))
 
-  (type: #export (Can-List <vars>)
-    (Capability <owner>
-                (! (Error (List <property>)))))
+(capability: #export (Can-Disown !)
+  (can-disown Ownership (! (Error Any))))
 
-  (type: #export (Inventory <vars>)
-    [(Can-Own <vars>)
-     (Can-Disown <vars>)
-     (Can-Check <vars>)
-     (Can-List <vars>)])
-  )
+(capability: #export (Can-Check !)
+  (can-check Ownership (! (Error Bit))))
+
+(capability: #export (Can-List-Property !)
+  (can-list-property ID (! (Error (List ID)))))
+
+(type: #export (Inventory !)
+  {#can-own (Can-Own !)
+   #can-disown (Can-Disown !)
+   #can-check (Can-Check !)
+   #can-list-property (Can-List-Property !)})
diff --git a/stdlib/source/lux/world/service/mail.lux b/stdlib/source/lux/world/service/mail.lux
index 115afb5e3..ce5eb91b3 100644
--- a/stdlib/source/lux/world/service/mail.lux
+++ b/stdlib/source/lux/world/service/mail.lux
@@ -4,15 +4,15 @@
     [concurrency
      [frp (#+ Channel)]]
     [security
-     [capability (#+ Capability)]]]
+     ["!" capability (#+ capability:)]]]
    [data
     [error (#+ Error)]]])
 
-(type: #export (Can-Send ! address message)
-  (Capability [address message] (! (Error Any))))
+(capability: #export (Can-Send ! address message)
+  (can-send [address message] (! (Error Any))))
 
-(type: #export (Can-Subscribe ! address message)
-  (Capability [address] (! (Error (Channel message)))))
+(capability: #export (Can-Subscribe ! address message)
+  (can-subscribe [address] (! (Error (Channel message)))))
 
 (type: #export (Service ! address message)
   {#can-send (Can-Send ! address message)