From 700f82c940794684cbce9535274f6d7ea3f9c692 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 3 Feb 2019 03:20:44 -0400 Subject: Added branding to capabilities to better differentiate between capabilities that share the same inputs and outputs. --- lux-mode/lux-mode.el | 4 +- stdlib/source/lux/control/security/capability.lux | 51 ++++++++++-- stdlib/source/lux/macro/syntax/common/reader.lux | 2 +- stdlib/source/lux/world/file.lux | 94 ++++++++++++----------- 4 files changed, 95 insertions(+), 56 deletions(-) diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 46d0e77fe..53aecac83 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -250,6 +250,7 @@ Called by `imenu--generic-function'." (type//unit (altRE "unit:" "scale:")) (type//poly (altRE "poly:" "derived:")) (type//dynamic (altRE ":dynamic" ":check")) + (type//capability (altRE "capability:")) ;; Data (data//record (altRE "get@" "set@" "update@")) (data//signature (altRE "signature:" "structure:" "open:" "structure" "::")) @@ -275,7 +276,8 @@ Called by `imenu--generic-function'." type//abstract type//unit type//poly - type//dynamic)) + type//dynamic + type//capability)) (data (altRE data//record data//signature data//implicit 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)]]] [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)] @@ -19,6 +19,8 @@ [time ["." instant (#+ Instant)] ["." duration]] + [macro + ["." template]] [world ["." binary (#+ Binary)]] ["." io (#+ IO) ("io/." Functor)] @@ -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 [ ] - [(type: #export ( !) - (Capability (! (Error ))))] +(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 [ ] @@ -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 [] - [(def: (!.forge - (|>> (!.use (:: file )) promise.future)))] - - [size] [last-modified] [can-execute?] [content] - [modify] [over-write] - [append] - [delete])) - - (def: move (!.forge + (~~ (do-template [ +] + [(with-expansions [ (template.splice +)] + (do-template [] + [(def: ( (|>> (!.use (:: file )) promise.future)))] + + ))] + + [..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 [ ] - [(def: (!.forge + [(def: (..can-query (|>> (!.use (:: directory )) (io/map (error/map (list/map ))) 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 [ ] - [(def: (!.forge + [(def: (..can-open (|>> (!.use (:: system )) (io/map (error/map )) 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 [ ] [(def: - (!.forge + (..can-modify (function ( data) (do io.Monad [stream (FileOutputStream::new (java/io/File::new path) ) @@ -245,7 +247,7 @@ )) (def: content - (!.forge + (..can-query (function (content _) (do io.Monad [#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 map .nat))))) (def: last-modified - (!.forge + (..can-query (function (last-modified _) (|> path java/io/File::new @@ -275,14 +277,14 @@ (:: io.Monad 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 [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 [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 [ ] [(def: - (!.forge + (..can-query (function ( _) (do io.Monad [?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 [ ] [(def: - (!.forge + (..can-open (function ( path) (do io.Monad [#let [file (java/io/File::new path)] -- cgit v1.2.3