Added branding to capabilities to better differentiate between capabilities that share the same inputs and outputs.

3 files changed, 92 insertions, 55 deletions

diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux
index 5de65a17e..847dbf714 100644
--- a/stdlib/source/lux/control/security/capability.lux
+++ b/stdlib/source/lux/control/security/capability.lux
@@ -1,23 +1,58 @@
 (.module:
   [lux #*
+   [control
+    [monad (#+ do)]
+    ["p" parser]]
+   [data
+    [text
+     format]
+    [collection
+     [list ("list/." Functor<List>)]]]
    [type
-    abstract]])
+    abstract]
+   ["." macro
+    ["." code]
+    ["s" syntax (#+ syntax:)
+     [common
+      ["." reader]
+      ["." writer]]]]])
 
-(abstract: #export (Capability input output)
+(abstract: #export (Capability brand input output)
   {#.doc (doc "Represents the capability to perform an operation."
               "This operation is assumed to have security implications.")}
 
   (-> input output)
 
-  (def: #export forge
-    (All [input output]
+  (def: default-forge
+    (All [brand input output]
       (-> (-> input output)
-          (Capability input output)))
+          (Capability brand input output)))
     (|>> :abstraction))
 
   (def: #export (use capability input)
-    (All [input output]
-      (-> (Capability input output)
+    (All [brand input output]
+      (-> (Capability brand input output)
           input
           output))
-    ((:representation capability) input)))
+    ((:representation capability) input))
+
+  (syntax: #export (capability: {export reader.export}
+                     {declaration reader.declaration}
+                     {annotations (p.maybe reader.annotations)}
+                     {[forge input output] (s.form ($_ p.and s.local-identifier s.any s.any))})
+    (do @
+      [this-module macro.current-module-name
+       #let [[name vars] declaration]
+       g!brand (:: @ map (|>> %code code.text)
+                   (macro.gensym (format (%name [this-module name]))))
+       #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]]
+      (wrap (list (` (type: (~+ (writer.export export))
+                       (~ (writer.declaration declaration))
+                       (~ capability)))
+                  (` (def: (~ (code.local-identifier forge))
+                       (All [(~+ (list/map code.local-identifier vars))]
+                         (-> (-> (~ input) (~ output))
+                             (~ capability)))
+                       (~! ..default-forge)))
+                  ))))
+  )
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index af3b584b8..bbbe3f6d7 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -29,7 +29,7 @@
   (p.either (p.and s.local-identifier
                    (parser/wrap (list)))
             (s.form (p.and s.local-identifier
-                           (p.many s.local-identifier)))))
+                           (p.some s.local-identifier)))))
 
 ## Annotations
 (def: #export annotations
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 148934436..78556b742 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -7,7 +7,7 @@
      ["." promise (#+ Promise)]]
     [security
      ["." integrity (#+ Dirty)]
-     ["!" capability (#+ Capability)]]]
+     ["!" capability (#+ capability:)]]]
    [data
     ["." maybe]
     ["." error (#+ Error) ("error/." Functor<Error>)]
@@ -19,6 +19,8 @@
    [time
     ["." instant (#+ Instant)]
     ["." duration]]
+   [macro
+    ["." template]]
    [world
     ["." binary (#+ Binary)]]
    ["." io (#+ IO) ("io/." Functor<IO>)]
@@ -29,22 +31,17 @@
 
 (type: #export Path Text)
 
-(type: #export (Can-Open ! capability)
-  (Capability Path (! (Error (capability !)))))
+(capability: #export (Can-Open ! capability)
+  (can-open Path (! (Error (capability !)))))
 
-(do-template [<capability> <input> <output>]
-  [(type: #export (<capability> !)
-     (Capability <input> (! (Error <output>))))]
+(capability: #export (Can-Query ! o)
+  (can-query [] (! (Error o))))
 
-  [Can-Edit   [Binary] Any]
-  [Can-Delete []       Any]
-  )
-
-(type: #export (Can-Query ! o)
-  (Capability [] (! (Error o))))
+(capability: #export (Can-Modify ! i)
+  (can-modify [i] (! (Error Any))))
 
-(type: #export (Can-Modify ! i)
-  (Capability [i] (! (Error Any))))
+(capability: #export (Can-Delete !)
+  (can-delete [] (! (Error Any))))
 
 (`` (signature: #export (File !)
       (~~ (do-template [<name> <output>]
@@ -66,11 +63,9 @@
 
             [modify     Instant]
             [over-write Binary]
+            [append     Binary]
             ))
 
-      (: (Can-Edit !)
-         append)
-
       (: (Can-Delete !)
          delete)
       ))
@@ -103,43 +98,50 @@
 (def: (async-file file)
   (-> (File IO) (File Promise))
   (`` (structure
-       (~~ (do-template [<name>]
-             [(def: <name> (!.forge
-                            (|>> (!.use (:: file <name>)) promise.future)))]
-
-             [size] [last-modified] [can-execute?] [content]
-             [modify] [over-write]
-             [append]
-             [delete]))
-
-       (def: move (!.forge
+       (~~ (do-template [<forge> <name>+]
+             [(with-expansions [<rows> (template.splice <name>+)]
+                (do-template [<name>]
+                  [(def: <name> (<forge> (|>> (!.use (:: file <name>)) promise.future)))]
+
+                  <rows>))]
+
+             [..can-query
+              [[size] [last-modified] [can-execute?] [content]]]
+             
+             [..can-modify
+              [[modify] [over-write] [append]]]
+             
+             [..can-delete
+              [[delete]]]))
+
+       (def: move (..can-open
                    (|>> (!.use (:: file move)) (io/map (error/map async-file)) promise.future))))))
 
 (def: (async-directory directory)
   (-> (Directory IO) (Directory Promise))
   (`` (structure (~~ (do-template [<name> <async>]
-                       [(def: <name> (!.forge
+                       [(def: <name> (..can-query
                                       (|>> (!.use (:: directory <name>))
                                            (io/map (error/map (list/map <async>)))
                                            promise.future)))]
 
-                       [files       async-file]
+                       [files       ..async-file]
                        [directories async-directory]))
 
-                 (def: discard (!.forge
+                 (def: discard (..can-delete
                                 (|>> (!.use (:: directory discard)) promise.future))))))
 
 (def: #export (async system)
   (-> (System IO) (System Promise))
   (`` (structure
        (~~ (do-template [<name> <async>]
-             [(def: <name> (!.forge
+             [(def: <name> (..can-open
                             (|>> (!.use (:: system <name>)) (io/map (error/map <async>)) promise.future)))]
 
-             [file             async-file]
-             [create-file      async-file]
-             [directory        async-directory]
-             [create-directory async-directory]))
+             [file             ..async-file]
+             [create-file      ..async-file]
+             [directory        ..async-directory]
+             [create-directory ..async-directory]))
 
        (def: separator (:: system separator)))))
 
@@ -232,7 +234,7 @@
 
                    (~~ (do-template [<name> <flag>]
                          [(def: <name>
-                            (!.forge
+                            (..can-modify
                              (function (<name> data)
                                (do io.Monad<Process>
                                  [stream (FileOutputStream::new (java/io/File::new path) <flag>)
@@ -245,7 +247,7 @@
                          ))
 
                    (def: content
-                     (!.forge
+                     (..can-query
                       (function (content _)
                         (do io.Monad<Process>
                           [#let [file (java/io/File::new path)]
@@ -259,7 +261,7 @@
                             (io.io (ex.throw cannot-read-all-data path)))))))
 
                    (def: size
-                     (!.forge
+                     (..can-query
                       (function (size _)
                         (|> path
                             java/io/File::new
@@ -267,7 +269,7 @@
                             (:: io.Monad<Process> map .nat)))))
 
                    (def: last-modified
-                     (!.forge
+                     (..can-query
                       (function (last-modified _)
                         (|> path
                             java/io/File::new
@@ -275,14 +277,14 @@
                             (:: io.Monad<Process> map (|>> duration.from-millis instant.absolute))))))
 
                    (def: can-execute?
-                     (!.forge
+                     (..can-query
                       (function (can-execute? _)
                         (|> path
                             java/io/File::new
                             java/io/File::canExecute))))
 
                    (def: move
-                     (!.forge
+                     (..can-open
                       (function (move destination)
                         (do io.Monad<IO>
                           [outcome (java/io/File::renameTo (java/io/File::new destination)
@@ -295,7 +297,7 @@
                             (io.throw cannot-move [destination path]))))))
 
                    (def: modify
-                     (!.forge
+                     (..can-modify
                       (function (modify time-stamp)
                         (do io.Monad<IO>
                           [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis)
@@ -308,7 +310,7 @@
                             (io.throw cannot-modify [time-stamp path]))))))
 
                    (def: delete
-                     (!.forge
+                     (..can-delete
                       (function (delete _)
                         (!delete path cannot-delete-file)))))
 
@@ -317,7 +319,7 @@
 
                    (~~ (do-template [<name> <method> <capability>]
                          [(def: <name>
-                            (!.forge
+                            (..can-query
                              (function (<name> _)
                                (do io.Monad<Process>
                                  [?children (java/io/File::listFiles (java/io/File::new path))]
@@ -337,14 +339,14 @@
                          ))
 
                    (def: discard
-                     (!.forge
+                     (..can-delete
                       (function (discard _)
                         (!delete path cannot-discard-directory)))))
 
                  (structure: #export _ (System IO)
                    (~~ (do-template [<name> <method> <capability> <exception>]
                          [(def: <name>
-                            (!.forge
+                            (..can-open
                              (function (<name> path)
                                (do io.Monad<IO>
                                  [#let [file (java/io/File::new path)]