Added more services.

4 files changed, 99 insertions, 19 deletions

diff --git a/stdlib/source/lux/macro/poly/equivalence.lux b/stdlib/source/lux/macro/poly/equivalence.lux
index edb1f8dfc..4b5b80e13 100644
--- a/stdlib/source/lux/macro/poly/equivalence.lux
+++ b/stdlib/source/lux/macro/poly/equivalence.lux
@@ -40,7 +40,7 @@
          inputT poly.peek
          #let [@Equivalence (: (-> Type Code)
                                (function (_ type)
-                                 (` (eq.Equivalence (~ (poly.to-code *env* type))))))]]
+                                 (` ((~! eq.Equivalence) (~ (poly.to-code *env* type))))))]]
         ($_ p.either
             ## Basic types
             (~~ (do-template [<matcher> <eq>]
@@ -50,12 +50,12 @@
                                  <eq>))))]
 
                   [(poly.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)]
-                  [(poly.sub Bit)     bit.Equivalence<Bit>]
-                  [(poly.sub Nat)     number.Equivalence<Nat>]
-                  [(poly.sub Int)     number.Equivalence<Int>]
-                  [(poly.sub Rev)     number.Equivalence<Rev>]
-                  [(poly.sub Frac)    number.Equivalence<Frac>]
-                  [(poly.sub Text)    text.Equivalence<Text>]))
+                  [(poly.sub Bit)     (~! bit.Equivalence<Bit>)]
+                  [(poly.sub Nat)     (~! number.Equivalence<Nat>)]
+                  [(poly.sub Int)     (~! number.Equivalence<Int>)]
+                  [(poly.sub Rev)     (~! number.Equivalence<Rev>)]
+                  [(poly.sub Frac)    (~! number.Equivalence<Frac>)]
+                  [(poly.sub Text)    (~! text.Equivalence<Text>)]))
             ## Composite types
             (~~ (do-template [<name> <eq>]
                   [(do @
@@ -64,13 +64,13 @@
                      (wrap (` (: (~ (@Equivalence inputT))
                                  (<eq> (~ argC))))))]
 
-                  [.Maybe      maybe.Equivalence<Maybe>]
-                  [.List       list.Equivalence<List>]
-                  [row.Row     row.Equivalence<Row>]
-                  [array.Array array.Equivalence<Array>]
-                  [queue.Queue queue.Equivalence<Queue>]
-                  [set.Set     set.Equivalence<Set>]
-                  [rose.Tree   rose.Equivalence<Tree>]
+                  [.Maybe      (~! maybe.Equivalence<Maybe>)]
+                  [.List       (~! list.Equivalence<List>)]
+                  [row.Row     (~! row.Equivalence<Row>)]
+                  [array.Array (~! array.Equivalence<Array>)]
+                  [queue.Queue (~! queue.Equivalence<Queue>)]
+                  [set.Set     (~! set.Equivalence<Set>)]
+                  [rose.Tree   (~! rose.Equivalence<Tree>)]
                   ))
             (do @
               [[_ _ valC] (poly.apply ($_ p.and
@@ -78,7 +78,7 @@
                                           poly.any
                                           Equivalence<?>))]
               (wrap (` (: (~ (@Equivalence inputT))
-                          (dict.Equivalence<Dictionary> (~ valC))))))
+                          ((~! dict.Equivalence<Dictionary>) (~ valC))))))
             ## Models
             (~~ (do-template [<type> <eq>]
                   [(do @
@@ -129,8 +129,8 @@
               [[g!self bodyC] (poly.recursive Equivalence<?>)
                #let [g!_ (code.local-identifier "_____________")]]
               (wrap (` (: (~ (@Equivalence inputT))
-                          (eq.rec (.function ((~ g!_) (~ g!self))
-                                    (~ bodyC)))))))
+                          ((~! eq.rec) (.function ((~ g!_) (~ g!self))
+                                         (~ bodyC)))))))
             poly.recursive-self
             ## Type applications
             (do @
@@ -142,8 +142,8 @@
             (do @
               [[funcC varsC bodyC] (poly.polymorphic Equivalence<?>)]
               (wrap (` (: (All [(~+ varsC)]
-                            (-> (~+ (list/map (|>> (~) eq.Equivalence (`)) varsC))
-                                (eq.Equivalence ((~ (poly.to-code *env* inputT)) (~+ varsC)))))
+                            (-> (~+ (list/map (|>> (~) ((~! eq.Equivalence)) (`)) varsC))
+                                ((~! eq.Equivalence) ((~ (poly.to-code *env* inputT)) (~+ varsC)))))
                           (function ((~ funcC) (~+ varsC))
                             (~ bodyC))))))
             poly.recursive-call
diff --git a/stdlib/source/lux/world/service/authentication.lux b/stdlib/source/lux/world/service/authentication.lux
new file mode 100644
index 000000000..2cd35f7dd
--- /dev/null
+++ b/stdlib/source/lux/world/service/authentication.lux
@@ -0,0 +1,25 @@
+(.module:
+  [lux #*
+   [control
+    [security
+     [capability (#+ Capability)]]]
+   [data
+    [error (#+ Error)]]])
+
+(type: #export (Can-Register ! account secret value)
+  (Capability [account secret value] (! (Error Any))))
+
+(type: #export (Can-Authenticate ! account secret value)
+  (Capability [account secret] (! (Error value))))
+
+(type: #export (Can-Reset ! account secret)
+  (Capability [account secret] (! (Error Any))))
+
+(type: #export (Can-Forget ! account)
+  (Capability [account] (! (Error Any))))
+
+(type: #export (Service ! account secret value)
+  {#can-register (Can-Register ! account secret value)
+   #can-authenticate (Can-Authenticate ! account secret value)
+   #can-reset (Can-Reset ! account secret)
+   #can-forget (Can-Forget ! account)})
diff --git a/stdlib/source/lux/world/service/journal.lux b/stdlib/source/lux/world/service/journal.lux
new file mode 100644
index 000000000..aa151fdab
--- /dev/null
+++ b/stdlib/source/lux/world/service/journal.lux
@@ -0,0 +1,36 @@
+(.module:
+  [lux #*
+   [control
+    [security
+     [capability (#+ Capability)]]]
+   [data
+    [error (#+ Error)]]
+   [time
+    [instant (#+ Instant)]]
+   [macro
+    [poly (#+ derived:)
+     [equivalence (#+ Equivalence<?>)]]]])
+
+(type: #export Entry
+  {#what  Text
+   #why   Text
+   #how   Text
+   #who   (List Text)
+   #where Text
+   #when  Instant})
+
+(derived: #export (Equivalence<?> Entry))
+
+(type: #export (Can-Write !)
+  (Capability Entry (! (Error Any))))
+
+(type: #export Range
+  {#from Instant
+   #to Instant})
+
+(type: #export (Can-Read !)
+  (Capability Range (! (Error (List Entry)))))
+
+(type: #export (Service !)
+  {#can-write (Can-Write !)
+   #can-read (Can-Read !)})
diff --git a/stdlib/source/lux/world/service/mail.lux b/stdlib/source/lux/world/service/mail.lux
new file mode 100644
index 000000000..115afb5e3
--- /dev/null
+++ b/stdlib/source/lux/world/service/mail.lux
@@ -0,0 +1,19 @@
+(.module:
+  [lux #*
+   [control
+    [concurrency
+     [frp (#+ Channel)]]
+    [security
+     [capability (#+ Capability)]]]
+   [data
+    [error (#+ Error)]]])
+
+(type: #export (Can-Send ! address message)
+  (Capability [address message] (! (Error Any))))
+
+(type: #export (Can-Subscribe ! address message)
+  (Capability [address] (! (Error (Channel message)))))
+
+(type: #export (Service ! address message)
+  {#can-send (Can-Send ! address message)
+   #can-subscribe (Can-Subscribe ! address message)})