aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/control/security/policy.lux18
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux40
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux18
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/jvm.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/scheme.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux4
-rw-r--r--stdlib/source/lux/world/console.lux143
-rw-r--r--stdlib/source/lux/world/file.lux1781
-rw-r--r--stdlib/source/lux/world/file/watch.lux18
-rw-r--r--stdlib/source/lux/world/net.lux15
-rw-r--r--stdlib/source/lux/world/net/http/client.lux5
-rw-r--r--stdlib/source/lux/world/net/http/status.lux106
-rw-r--r--stdlib/source/lux/world/shell.lux237
-rw-r--r--stdlib/source/program/aedifex.lux11
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux10
-rw-r--r--stdlib/source/program/aedifex/command/build.lux29
-rw-r--r--stdlib/source/program/aedifex/command/clean.lux12
-rw-r--r--stdlib/source/program/aedifex/command/install.lux4
-rw-r--r--stdlib/source/program/aedifex/command/pom.lux4
-rw-r--r--stdlib/source/program/aedifex/command/test.lux15
-rw-r--r--stdlib/source/program/aedifex/dependency/deployment.lux28
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux6
-rw-r--r--stdlib/source/program/aedifex/dependency/status.lux6
-rw-r--r--stdlib/source/program/aedifex/input.lux10
-rw-r--r--stdlib/source/program/aedifex/metadata.lux24
-rw-r--r--stdlib/source/program/aedifex/package.lux14
-rw-r--r--stdlib/source/program/aedifex/repository.lux10
-rw-r--r--stdlib/source/program/aedifex/repository/local.lux10
-rw-r--r--stdlib/source/program/aedifex/repository/remote.lux152
-rw-r--r--stdlib/source/program/compositor.lux20
-rw-r--r--stdlib/source/program/compositor/export.lux6
-rw-r--r--stdlib/source/program/compositor/import.lux6
-rw-r--r--stdlib/source/spec/lux/world/console.lux70
-rw-r--r--stdlib/source/spec/lux/world/shell.lux95
-rw-r--r--stdlib/source/test/aedifex.lux2
-rw-r--r--stdlib/source/test/aedifex/command/auto.lux10
-rw-r--r--stdlib/source/test/aedifex/command/build.lux16
-rw-r--r--stdlib/source/test/aedifex/command/clean.lux8
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux6
-rw-r--r--stdlib/source/test/aedifex/command/deps.lux2
-rw-r--r--stdlib/source/test/aedifex/command/install.lux4
-rw-r--r--stdlib/source/test/aedifex/command/pom.lux8
-rw-r--r--stdlib/source/test/aedifex/command/test.lux22
-rw-r--r--stdlib/source/test/aedifex/command/version.lux14
-rw-r--r--stdlib/source/test/aedifex/dependency/deployment.lux203
-rw-r--r--stdlib/source/test/aedifex/dependency/resolution.lux120
-rw-r--r--stdlib/source/test/aedifex/input.lux6
-rw-r--r--stdlib/source/test/aedifex/package.lux47
-rw-r--r--stdlib/source/test/aedifex/repository.lux18
-rw-r--r--stdlib/source/test/aedifex/repository/remote.lux130
-rw-r--r--stdlib/source/test/lux/control/security/policy.lux17
-rw-r--r--stdlib/source/test/lux/world.lux4
-rw-r--r--stdlib/source/test/lux/world/console.lux16
-rw-r--r--stdlib/source/test/lux/world/file.lux6
-rw-r--r--stdlib/source/test/lux/world/file/watch.lux12
-rw-r--r--stdlib/source/test/lux/world/net/http/status.lux119
-rw-r--r--stdlib/source/test/lux/world/shell.lux67
58 files changed, 1937 insertions, 1861 deletions
diff --git a/stdlib/source/lux/control/security/policy.lux b/stdlib/source/lux/control/security/policy.lux
index 25afafd5e..1d3c0e43e 100644
--- a/stdlib/source/lux/control/security/policy.lux
+++ b/stdlib/source/lux/control/security/policy.lux
@@ -5,20 +5,18 @@
[apply (#+ Apply)]
[monad (#+ Monad)]]
[type
- abstract]]
- [//
- ["!" capability (#+ capability:)]])
+ abstract]])
(abstract: #export (Policy brand value label)
value
- (capability: #export (Can_Upgrade brand label value)
+ (type: #export (Can_Upgrade brand label value)
{#.doc (doc "Represents the capacity to 'upgrade' a value.")}
- (can_upgrade value (Policy brand value label)))
+ (-> value (Policy brand value label)))
- (capability: #export (Can_Downgrade brand label value)
+ (type: #export (Can_Downgrade brand label value)
{#.doc (doc "Represents the capacity to 'downgrade' a value.")}
- (can_downgrade (Policy brand value label) value))
+ (-> (Policy brand value label) value))
(type: #export (Privilege brand label)
{#.doc (doc "Represents the privilege to both 'upgrade' and 'downgrade' a value.")}
@@ -27,8 +25,8 @@
(def: privilege
Privilege
- {#can_upgrade (..can_upgrade (|>> :abstraction))
- #can_downgrade (..can_downgrade (|>> :representation))})
+ {#can_upgrade (|>> :abstraction)
+ #can_downgrade (|>> :representation)})
(type: #export (Delegation brand from to)
{#.doc (doc "Represents the act of delegating policy capacities.")}
@@ -41,7 +39,7 @@
(All [brand from to]
(-> (Can_Downgrade brand from) (Can_Upgrade brand to)
(Delegation brand from to)))
- (|>> (!.use downgrade) (!.use upgrade)))
+ (|>> downgrade upgrade))
(type: #export (Context brand scope label)
{#.doc (doc "A computational context with an associated policy privilege.")}
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux
index f429b0442..659dc0799 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux
@@ -4,9 +4,7 @@
[monad (#+ do)]]
[control
["." io (#+ IO)]
- ["." try (#+ Try)]
- [security
- ["!" capability]]]
+ ["." try (#+ Try)]]
[data
[binary (#+ Binary)]
[text
@@ -23,7 +21,7 @@
[outcome (do (try.with @)
[file (: (IO (Try (File IO)))
(file.get-file io.monad file.default file-path))]
- (!.use (\ file over-write) bytecode))]
+ (\ file over-write bytecode))]
(wrap (case outcome
(#try.Success definition)
file-path
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index e611f9f47..2006fcd79 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -9,10 +9,8 @@
["." exception (#+ exception:)]
[concurrency
["." promise (#+ Promise) ("#\." monad)]]
- [security
- ["!" capability (#+ capability:)]]
["<>" parser
- ["<b>" binary (#+ Parser)]]]
+ ["<.>" binary (#+ Parser)]]]
[data
[binary (#+ Binary)]
["." product]
@@ -100,7 +98,7 @@
(do !
[_ (file.get_directory ! system (..unversioned_lux_archive system static))
_ (file.get_directory ! system (..versioned_lux_archive system static))
- outcome (!.use (\ system create_directory) module)]
+ outcome (\ system create_directory module)]
(case outcome
(#try.Success output)
(wrap (#try.Success []))
@@ -116,7 +114,7 @@
[artifact (: (Promise (Try (File Promise)))
(file.get_file promise.monad system
(..artifact system static module_id artifact_id)))]
- (!.use (\ artifact over_write) content)))
+ (\ artifact over_write content)))
(def: #export (enable system static)
(-> (file.System Promise) Static (Promise (Try Any)))
@@ -138,7 +136,7 @@
(do (try.with promise.monad)
[file (: (Promise (Try (File Promise)))
(file.get_file promise.monad system (..general_descriptor system static)))]
- (!.use (\ file over_write) (archive.export ///.version archive))))
+ (\ file over_write (archive.export ///.version archive))))
(def: module_descriptor_file
"module_descriptor")
@@ -155,7 +153,7 @@
[file (: (Promise (Try (File Promise)))
(file.get_file promise.monad system
(..module_descriptor system static module_id)))]
- (!.use (\ file over_write) content)))
+ (\ file over_write content)))
(def: (read_module_descriptor system static module_id)
(-> (file.System Promise) Static archive.ID (Promise (Try Binary)))
@@ -163,7 +161,7 @@
[file (: (Promise (Try (File Promise)))
(file.get_file promise.monad system
(..module_descriptor system static module_id)))]
- (!.use (\ file content) [])))
+ (\ file content [])))
(def: parser
(Parser [Descriptor (Document .Module)])
@@ -189,19 +187,19 @@
(def: (cached_artifacts system static module_id)
(-> (file.System Promise) Static archive.ID (Promise (Try (Dictionary Text Binary))))
(do {! (try.with promise.monad)}
- [module_dir (!.use (\ system directory) (..module system static module_id))
- cached_files (!.use (\ module_dir files) [])]
+ [module_dir (\ system directory (..module system static module_id))
+ cached_files (\ module_dir files [])]
(|> cached_files
(list\map (function (_ file)
- [(file.name system (!.use (\ file path) []))
- (!.use (\ file path) [])]))
+ [(file.name system (\ file path))
+ (\ file path)]))
(list.filter (|>> product.left (text\= ..module_descriptor_file) not))
(monad.map ! (function (_ [name path])
(do !
[file (: (Promise (Try (File Promise)))
- (!.use (\ system file) path))
+ (\ system file path))
data (: (Promise (Try Binary))
- (!.use (\ file content) []))]
+ (\ file content []))]
(wrap [name data]))))
(\ ! map (dictionary.from_list text.hash)))))
@@ -338,12 +336,12 @@
(def: (purge! system static [module_name module_id])
(-> (file.System Promise) Static [Module archive.ID] (Promise (Try Any)))
(do {! (try.with promise.monad)}
- [cache (!.use (\ system directory) [(..module system static module_id)])
- artifacts (!.use (\ cache files) [])
+ [cache (\ system directory (..module system static module_id))
+ artifacts (\ cache files [])
_ (monad.map ! (function (_ artifact)
- (!.use (\ artifact delete) []))
+ (\ artifact delete []))
artifacts)]
- (!.use (\ cache discard) [])))
+ (\ cache discard [])))
(def: (valid_cache? expected actual)
(-> Descriptor Input Bit)
@@ -398,7 +396,7 @@
(monad.map ! (function (_ [module_name module_id])
(do !
[data (..read_module_descriptor system static module_id)
- [descriptor document] (promise\wrap (<b>.run ..parser data))]
+ [descriptor document] (promise\wrap (<binary>.run ..parser data))]
(if (text\= archive.runtime_module module_name)
(wrap [true
[module_name [module_id [descriptor document (: Output row.empty)]]]])
@@ -451,11 +449,11 @@
(-> (generation.Host expression directive) (file.System Promise) Static Import (List Context)
(Promise (Try [Archive .Lux Bundles]))))
(do promise.monad
- [file (!.use (\ system file) (..general_descriptor system static))]
+ [file (\ system file (..general_descriptor system static))]
(case file
(#try.Success file)
(do (try.with promise.monad)
- [binary (!.use (\ file content) [])
+ [binary (\ file content [])
archive (promise\wrap (archive.import ///.version binary))]
(..load_every_reserved_module host_environment system static import contexts archive))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index 33f201571..788be9fed 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -7,8 +7,6 @@
[control
["." try (#+ Try)]
["." exception (#+ exception:)]
- [security
- ["!" capability]]
[concurrency
["." promise (#+ Promise) ("#\." monad)]]]
[data
@@ -62,7 +60,7 @@
(#.Cons context contexts')
(do promise.monad
[#let [path (format (..path system context module) extension)]
- file (!.use (\ system file) [path])]
+ file (\ system file [path])]
(case file
(#try.Success file)
(wrap (#try.Success [path file]))
@@ -84,13 +82,13 @@
(case outcome
(#try.Success [path file])
(do (try.with !)
- [data (!.use (\ file content) [])]
+ [data (\ file content [])]
(wrap [path data]))
(#try.Failure _)
(do (try.with !)
[[path file] (..find_source_file system importer contexts module ..lux_extension)
- data (!.use (\ file content) [])]
+ data (\ file content [])]
(wrap [path data])))))
(def: (find_library_source_file importer import partial_host_extension module)
@@ -159,23 +157,23 @@
(def: (enumerate_context system context enumeration)
(-> (file.System Promise) Context Enumeration (Promise (Try Enumeration)))
(do {! (try.with promise.monad)}
- [directory (!.use (\ system directory) [context])]
+ [directory (\ system directory context)]
(loop [directory directory
enumeration enumeration]
(do !
- [files (!.use (\ directory files) [])
+ [files (\ directory files [])
enumeration (monad.fold ! (function (_ file enumeration)
- (let [path (!.use (\ file path) [])]
+ (let [path (\ file path)]
(if (text.ends_with? ..lux_extension path)
(do !
[path (promise\wrap (..clean_path system context path))
- source_code (!.use (\ file content) [])]
+ source_code (\ file content [])]
(promise\wrap
(dictionary.try_put path source_code enumeration)))
(wrap enumeration))))
enumeration
files)
- directories (!.use (\ directory directories) [])]
+ directories (\ directory directories [])]
(monad.fold ! recur enumeration directories)))))
(def: Action
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux
index 1df76453c..86cec2ba1 100644
--- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux
@@ -7,9 +7,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." binary (#+ Binary)]
["." text
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux
index 64d7418eb..153aa79b5 100644
--- a/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux
+++ b/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux
@@ -4,9 +4,7 @@
[abstract
["." monad (#+ Monad do)]]
[control
- ["." try (#+ Try)]
- [security
- ["!" capability]]]
+ ["." try (#+ Try)]]
[data
[binary (#+ Binary)]
["." product]
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
index c23688a9e..5ddeac0d5 100644
--- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
@@ -4,9 +4,7 @@
[abstract
["." monad (#+ Monad do)]]
[control
- ["." try (#+ Try)]
- [security
- ["!" capability]]]
+ ["." try (#+ Try)]]
[data
[binary (#+ Binary)]
["." product]
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux
index d4a16e5f6..93842b99a 100644
--- a/stdlib/source/lux/world/console.lux
+++ b/stdlib/source/lux/world/console.lux
@@ -10,9 +10,7 @@
["." io (#+ IO io)]
[concurrency
["." promise (#+ Promise)]
- ["." atom]]
- [security
- ["!" capability (#+ capability:)]]]
+ ["." atom]]]
[data
["." text (#+ Char)
["%" format (#+ format)]]]])
@@ -25,37 +23,27 @@
[cannot_close]
)
-(capability: #export (Can_Read ! o)
- (can_read [] (! (Try o))))
-
-(capability: #export (Can_Write ! i)
- (can_write i (! (Try Any))))
-
-(capability: #export (Can_Close !)
- (can_close [] (! (Try Any))))
-
(interface: #export (Console !)
- (: (Can_Read ! Char)
+ (: (-> [] (! (Try Char)))
read)
- (: (Can_Read ! Text)
+ (: (-> [] (! (Try Text)))
read_line)
- (: (Can_Write ! Text)
+ (: (-> Text (! (Try Any)))
write)
- (: (Can_Close !)
+ (: (-> [] (! (Try Any)))
close))
(def: #export (async console)
(-> (Console IO) (Console Promise))
(`` (implementation
- (~~ (template [<capability> <forge>]
+ (~~ (template [<capability>]
[(def: <capability>
- (<forge>
- (|>> (!.use (\ console <capability>)) promise.future)))]
+ (|>> (\ console <capability>) promise.future))]
- [read ..can_read]
- [read_line ..can_read]
- [write ..can_write]
- [close ..can_close])))))
+ [read]
+ [read_line]
+ [write]
+ [close])))))
(with_expansions [<jvm> (as_is (import: java/lang/String)
@@ -92,35 +80,28 @@
exception.return
(: (Console IO)) ## TODO: Remove ASAP
(implementation
- (def: read
- (..can_read
- (function (_ _)
- (|> jvm_input
- java/io/InputStream::read
- (\ (try.with io.monad) map .nat)))))
+ (def: (read _)
+ (|> jvm_input
+ java/io/InputStream::read
+ (\ (try.with io.monad) map .nat)))
- (def: read_line
- (..can_read
- (function (_ _)
- (java/io/Console::readLine jvm_console))))
+ (def: (read_line _)
+ (java/io/Console::readLine jvm_console))
- (def: write
- (..can_write
- (function (_ message)
- (java/io/PrintStream::print message jvm_output))))
+ (def: (write message)
+ (java/io/PrintStream::print message jvm_output))
(def: close
- (..can_close
- (|>> (exception.throw ..cannot_close) wrap))))))))))]
+ (|>> (exception.throw ..cannot_close) wrap)))))))))]
(for {@.old (as_is <jvm>)
@.jvm (as_is <jvm>)}
(as_is)))
(def: #export (write_line message console)
(All [!] (-> Text (Console !) (! (Try Any))))
- (!.use (\ console write) [(format message text.new_line)]))
+ (\ console write (format message text.new_line)))
-(interface: #export (Simulation s)
+(interface: #export (Mock s)
(: (-> s (Try [s Char]))
on_read)
(: (-> s (Try [s Text]))
@@ -130,54 +111,48 @@
(: (-> s (Try s))
on_close))
-(def: #export (mock simulation init)
- (All [s] (-> (Simulation s) s (Console IO)))
+(def: #export (mock mock init)
+ (All [s] (-> (Mock s) s (Console IO)))
(let [state (atom.atom init)]
(`` (implementation
- (~~ (template [<method> <simulation>]
- [(def: <method>
- (..can_read
- (function (_ _)
- (do {! io.monad}
- [|state| (atom.read state)]
- (case (\ simulation <simulation> |state|)
- (#try.Success [|state| output])
- (do !
- [_ (atom.write |state| state)]
- (wrap (#try.Success output)))
-
- (#try.Failure error)
- (wrap (#try.Failure error)))))))]
+ (~~ (template [<method> <mock>]
+ [(def: (<method> _)
+ (do {! io.monad}
+ [|state| (atom.read state)]
+ (case (\ mock <mock> |state|)
+ (#try.Success [|state| output])
+ (do !
+ [_ (atom.write |state| state)]
+ (wrap (#try.Success output)))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error)))))]
[read on_read]
[read_line on_read_line]
))
- (def: write
- (..can_write
- (function (_ input)
- (do {! io.monad}
- [|state| (atom.read state)]
- (case (\ simulation on_write input |state|)
- (#try.Success |state|)
- (do !
- [_ (atom.write |state| state)]
- (wrap (#try.Success [])))
-
- (#try.Failure error)
- (wrap (#try.Failure error)))))))
-
- (def: close
- (..can_close
- (function (_ _)
- (do {! io.monad}
- [|state| (atom.read state)]
- (case (\ simulation on_close |state|)
- (#try.Success |state|)
- (do !
- [_ (atom.write |state| state)]
- (wrap (#try.Success [])))
-
- (#try.Failure error)
- (wrap (#try.Failure error)))))))
+ (def: (write input)
+ (do {! io.monad}
+ [|state| (atom.read state)]
+ (case (\ mock on_write input |state|)
+ (#try.Success |state|)
+ (do !
+ [_ (atom.write |state| state)]
+ (wrap (#try.Success [])))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error)))))
+
+ (def: (close _)
+ (do {! io.monad}
+ [|state| (atom.read state)]
+ (case (\ mock on_close |state|)
+ (#try.Success |state|)
+ (do !
+ [_ (atom.write |state| state)]
+ (wrap (#try.Success [])))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error)))))
))))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 891d40530..76fb8bc56 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -11,9 +11,7 @@
["." function]
[concurrency
["." promise (#+ Promise)]
- ["." stm (#+ Var STM)]]
- [security
- ["!" capability (#+ capability:)]]]
+ ["." stm (#+ Var STM)]]]
[data
["." bit ("#\." equivalence)]
["." product]
@@ -38,27 +36,12 @@
(type: #export Path
Text)
-(capability: #export (Can_Open ! capability)
- (can_open Path (! (Try (capability !)))))
-
-(capability: #export (Can_See o)
- (can_see [] o))
-
-(capability: #export (Can_Query ! o)
- (can_query [] (! (Try o))))
-
-(capability: #export (Can_Modify ! i)
- (can_modify [i] (! (Try Any))))
-
-(capability: #export (Can_Delete !)
- (can_delete [] (! (Try Any))))
-
(`` (interface: #export (File !)
- (: (Can_See Path)
+ (: Path
path)
(~~ (template [<name> <output>]
- [(: (Can_Query ! <output>)
+ [(: (-> [] (! (Try <output>)))
<name>)]
[size Nat]
@@ -67,11 +50,11 @@
[content Binary]
))
- (: (Can_Open ! File)
+ (: (-> Path (! (Try (File !))))
move)
(~~ (template [<name> <input>]
- [(: (Can_Modify ! <input>)
+ [(: (-> [<input>] (! (Try Any)))
<name>)]
[modify Instant]
@@ -79,26 +62,26 @@
[append Binary]
))
- (: (Can_Delete !)
+ (: (-> [] (! (Try Any)))
delete)
))
(interface: #export (Directory !)
- (: (Can_See Path)
+ (: Path
scope)
- (: (Can_Query ! (List (File !)))
+ (: (-> [] (! (Try (List (File !)))))
files)
- (: (Can_Query ! (List (Directory !)))
+ (: (-> [] (! (Try (List (Directory !)))))
directories)
- (: (Can_Delete !)
+ (: (-> [] (! (Try Any)))
discard))
(`` (interface: #export (System !)
(~~ (template [<name> <capability>]
- [(: (Can_Open ! <capability>)
+ [(: (-> Path (! (Try (<capability> !))))
<name>)]
[file File]
@@ -123,30 +106,25 @@
(-> (File IO) (File Promise))
(`` (implementation
(def: path
- (..can_see
- (|>> (!.use (\ file path)))))
-
- (~~ (template [<forge> <name>+]
- [(with_expansions [<rows> (template.splice <name>+)]
- (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]]]))
+ (\ file path))
+
+ (~~ (template [<name>]
+ [(def: <name>
+ (|>> (\ file <name>) promise.future))]
+
+ [size]
+ [last_modified]
+ [can_execute?]
+ [content]
+ [modify]
+ [over_write]
+ [append]
+ [delete]))
(def: move
- (..can_open
- (|>> (!.use (\ file move)) (io\map (try\map async_file)) promise.future))))))
+ (|>> (\ file move)
+ (io\map (try\map async_file))
+ promise.future)))))
(def: (async_directory directory)
(-> (Directory IO) (Directory Promise))
@@ -156,24 +134,24 @@
(~~ (template [<name> <async>]
[(def: <name>
- (..can_query
- (|>> (!.use (\ directory <name>))
- (io\map (try\map (list\map <async>)))
- promise.future)))]
+ (|>> (\ directory <name>)
+ (io\map (try\map (list\map <async>)))
+ promise.future))]
[files ..async_file]
[directories async_directory]))
(def: discard
- (..can_delete
- (|>> (!.use (\ directory discard)) promise.future))))))
+ (|>> (\ directory discard) promise.future)))))
(def: #export (async system)
(-> (System IO) (System Promise))
(`` (implementation
(~~ (template [<name> <async>]
- [(def: <name> (..can_open
- (|>> (!.use (\ system <name>)) (io\map (try\map <async>)) promise.future)))]
+ [(def: <name>
+ (|>> (\ system <name>)
+ (io\map (try\map <async>))
+ promise.future))]
[file ..async_file]
[create_file ..async_file]
@@ -285,142 +263,116 @@
(-> Path (File IO))
(~~ (template [<name> <flag>]
- [(def: <name>
- (..can_modify
- (function (<name> data)
- (do (try.with io.monad)
- [stream (java/io/FileOutputStream::new (java/io/File::new path) <flag>)
- _ (java/io/OutputStream::write data stream)
- _ (java/io/OutputStream::flush stream)]
- (java/lang/AutoCloseable::close stream)))))]
+ [(def: (<name> data)
+ (do (try.with io.monad)
+ [stream (java/io/FileOutputStream::new (java/io/File::new path) <flag>)
+ _ (java/io/OutputStream::write data stream)
+ _ (java/io/OutputStream::flush stream)]
+ (java/lang/AutoCloseable::close stream)))]
[over_write #0]
[append #1]
))
- (def: content
- (..can_query
- (function (content _)
- (do (try.with io.monad)
- [#let [file (java/io/File::new path)]
- size (java/io/File::length file)
- #let [data (binary.create (.nat size))]
- stream (java/io/FileInputStream::new file)
- bytes_read (java/io/InputStream::read data stream)
- _ (java/lang/AutoCloseable::close stream)]
- (if (i.= size bytes_read)
- (wrap data)
- (\ io.monad wrap (exception.throw ..cannot_read_all_data path)))))))
+ (def: (content _)
+ (do (try.with io.monad)
+ [#let [file (java/io/File::new path)]
+ size (java/io/File::length file)
+ #let [data (binary.create (.nat size))]
+ stream (java/io/FileInputStream::new file)
+ bytes_read (java/io/InputStream::read data stream)
+ _ (java/lang/AutoCloseable::close stream)]
+ (if (i.= size bytes_read)
+ (wrap data)
+ (\ io.monad wrap (exception.throw ..cannot_read_all_data path)))))
(def: path
- (..can_see
- (function (_ _)
- path)))
-
- (def: size
- (..can_query
- (function (size _)
- (|> path
- java/io/File::new
- java/io/File::length
- (\ (try.with io.monad) map .nat)))))
-
- (def: last_modified
- (..can_query
- (function (last_modified _)
- (|> path
- java/io/File::new
- (java/io/File::lastModified)
- (\ (try.with io.monad) map (|>> duration.from_millis instant.absolute))))))
-
- (def: can_execute?
- (..can_query
- (function (can_execute? _)
- (|> path
- java/io/File::new
- java/io/File::canExecute))))
-
- (def: move
- (..can_open
- (function (move destination)
- (do io.monad
- [outcome (java/io/File::renameTo (java/io/File::new destination)
- (java/io/File::new path))]
- (case outcome
- (#try.Success #1)
- (wrap (#try.Success (file destination)))
-
- _
- (wrap (exception.throw ..cannot_move [destination path])))))))
-
- (def: modify
- (..can_modify
- (function (modify time_stamp)
- (do io.monad
- [outcome (java/io/File::setLastModified (|> time_stamp instant.relative duration.to_millis)
- (java/io/File::new path))]
- (case outcome
- (#try.Success #1)
- (wrap (#try.Success []))
-
- _
- (wrap (exception.throw ..cannot_modify [time_stamp path])))))))
-
- (def: delete
- (..can_delete
- (function (delete _)
- (!delete path cannot_delete_file))))))
+ path)
+
+ (def: (size _)
+ (|> path
+ java/io/File::new
+ java/io/File::length
+ (\ (try.with io.monad) map .nat)))
+
+ (def: (last_modified _)
+ (|> path
+ java/io/File::new
+ (java/io/File::lastModified)
+ (\ (try.with io.monad) map (|>> duration.from_millis instant.absolute))))
+
+ (def: (can_execute? _)
+ (|> path
+ java/io/File::new
+ java/io/File::canExecute))
+
+ (def: (move destination)
+ (do io.monad
+ [outcome (java/io/File::renameTo (java/io/File::new destination)
+ (java/io/File::new path))]
+ (case outcome
+ (#try.Success #1)
+ (wrap (#try.Success (file destination)))
+
+ _
+ (wrap (exception.throw ..cannot_move [destination path])))))
+
+ (def: (modify time_stamp)
+ (do io.monad
+ [outcome (java/io/File::setLastModified (|> time_stamp instant.relative duration.to_millis)
+ (java/io/File::new path))]
+ (case outcome
+ (#try.Success #1)
+ (wrap (#try.Success []))
+
+ _
+ (wrap (exception.throw ..cannot_modify [time_stamp path])))))
+
+ (def: (delete _)
+ (!delete path cannot_delete_file))))
(`` (implementation: (directory path)
(-> Path (Directory IO))
(def: scope
- (..can_see
- (function (_ _)
- path)))
+ path)
(~~ (template [<name> <method> <capability>]
- [(def: <name>
- (..can_query
- (function (<name> _)
- (do {! (try.with io.monad)}
- [?children (java/io/File::listFiles (java/io/File::new path))]
- (case ?children
- (#.Some children)
- (|> children
- array.to_list
- (monad.filter ! (|>> <method>))
- (\ ! map (monad.map ! (|>> java/io/File::getAbsolutePath (\ ! map <capability>))))
- (\ ! join))
-
- #.None
- (\ io.monad wrap (exception.throw ..not_a_directory [path])))))))]
+ [(def: (<name> _)
+ (do {! (try.with io.monad)}
+ [?children (java/io/File::listFiles (java/io/File::new path))]
+ (case ?children
+ (#.Some children)
+ (|> children
+ array.to_list
+ (monad.filter ! (|>> <method>))
+ (\ ! map (monad.map ! (|>> java/io/File::getAbsolutePath (\ ! map <capability>))))
+ (\ ! join))
+
+ #.None
+ (\ io.monad wrap (exception.throw ..not_a_directory [path])))))]
[files java/io/File::isFile file]
[directories java/io/File::isDirectory directory]
))
- (def: discard
- (..can_delete
- (function (discard _)
- (!delete path cannot_discard_directory))))))
+ (def: (discard _)
+ (!delete path cannot_discard_directory))))
(`` (implementation: #export default
(System IO)
(~~ (template [<name> <method> <capability> <exception>]
- [(def: <name>
- (..can_open
- (function (<name> path)
- (do io.monad
- [#let [file (java/io/File::new path)]
- outcome (<method> file)]
- (case outcome
- (#try.Success #1)
- (wrap (#try.Success (<capability> path)))
-
- _
- (wrap (exception.throw <exception> [path])))))))]
+ [(def: (<name> path)
+ (do io.monad
+ [#let [file (java/io/File::new path)]
+ outcome (<method> file)]
+ (case outcome
+ (#try.Success #1)
+ (wrap (#try.Success (<capability> path)))
+
+ _
+ (wrap (exception.throw <exception> [path])))))]
[file java/io/File::isFile ..file cannot_find_file]
[create_file java/io/File::createNewFile ..file cannot_create_file]
@@ -507,157 +459,129 @@
(-> Path (File IO))
(~~ (template [<name> <method>]
- [(def: <name>
- (..can_modify
- (function (<name> data)
- (<method> [path (Buffer::from data)] (..node_fs [])))))]
+ [(def: (<name> data)
+ (<method> [path (Buffer::from data)] (..node_fs [])))]
[over_write Fs::writeFileSync]
[append Fs::appendFileSync]
))
- (def: content
- (..can_query
- (function (_ _)
- (Fs::readFileSync [path] (..node_fs [])))))
+ (def: (content _)
+ (Fs::readFileSync [path] (..node_fs [])))
(def: path
- (..can_see
- (function (_ _)
- path)))
-
- (def: size
- (..can_query
- (function (_ _)
- (do (try.with io.monad)
- [stat (Fs::statSync [path] (..node_fs []))]
- (wrap (|> stat
- Stats::size
- f.nat))))))
-
- (def: last_modified
- (..can_query
- (function (_ _)
- (do (try.with io.monad)
- [stat (Fs::statSync [path] (..node_fs []))]
- (wrap (|> stat
- Stats::mtimeMs
- f.int
- duration.from_millis
- instant.absolute))))))
-
- (def: can_execute?
- (..can_query
- (function (can_execute? _)
- (do (try.with io.monad)
- [#let [node_fs (..node_fs [])]
- _ (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)]
- (do io.monad
- [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::X_OK)] node_fs)]
- (wrap (#try.Success (case outcome
- (#try.Success _)
- true
-
- (#try.Failure _)
- false))))))))
-
- (def: move
- (..can_open
- (function (move destination)
- (do (try.with io.monad)
- [_ (Fs::renameSync [path destination] (..node_fs []))]
- (wrap (file destination))))))
-
- (def: modify
- (..can_modify
- (function (modify time_stamp)
- (let [when (|> time_stamp instant.relative duration.to_millis i.frac)]
- (Fs::utimesSync [path when when] (..node_fs []))))))
-
- (def: delete
- (..can_delete
- (function (delete _)
- (Fs::unlink [path] (..node_fs [])))))))
+ path)
+
+ (def: (size _)
+ (do (try.with io.monad)
+ [stat (Fs::statSync [path] (..node_fs []))]
+ (wrap (|> stat
+ Stats::size
+ f.nat))))
+
+ (def: (last_modified _)
+ (do (try.with io.monad)
+ [stat (Fs::statSync [path] (..node_fs []))]
+ (wrap (|> stat
+ Stats::mtimeMs
+ f.int
+ duration.from_millis
+ instant.absolute))))
+
+ (def: (can_execute? _)
+ (do (try.with io.monad)
+ [#let [node_fs (..node_fs [])]
+ _ (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)]
+ (do io.monad
+ [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::X_OK)] node_fs)]
+ (wrap (#try.Success (case outcome
+ (#try.Success _)
+ true
+
+ (#try.Failure _)
+ false))))))
+
+ (def: (move destination)
+ (do (try.with io.monad)
+ [_ (Fs::renameSync [path destination] (..node_fs []))]
+ (wrap (file destination))))
+
+ (def: (modify time_stamp)
+ (let [when (|> time_stamp instant.relative duration.to_millis i.frac)]
+ (Fs::utimesSync [path when when] (..node_fs []))))
+
+ (def: (delete _)
+ (Fs::unlink [path] (..node_fs [])))))
(`` (implementation: (directory path)
(-> Path (Directory IO))
(def: scope
- (..can_see
- (function (_ _)
- path)))
+ path)
(~~ (template [<name> <method> <capability>]
- [(def: <name>
- (..can_query
- (function (<name> _)
- (do {! (try.with io.monad)}
- [#let [node_fs (..node_fs [])]
- subs (Fs::readdirSync [path] node_fs)
- subs (monad.map ! (function (_ sub)
- (do !
- [stats (Fs::statSync [sub] node_fs)
- verdict (<method> [] stats)]
- (wrap [verdict sub])))
- (array.to_list subs))]
- (wrap (|> subs
- (list.filter product.left)
- (list\map (|>> product.right <capability>))))))))]
+ [(def: (<name> _)
+ (do {! (try.with io.monad)}
+ [#let [node_fs (..node_fs [])]
+ subs (Fs::readdirSync [path] node_fs)
+ subs (monad.map ! (function (_ sub)
+ (do !
+ [stats (Fs::statSync [sub] node_fs)
+ verdict (<method> [] stats)]
+ (wrap [verdict sub])))
+ (array.to_list subs))]
+ (wrap (|> subs
+ (list.filter product.left)
+ (list\map (|>> product.right <capability>))))))]
[files Stats::isFile ..file]
[directories Stats::isDirectory directory]
))
- (def: discard
- (..can_delete
- (function (discard _)
- (Fs::rmdirSync [path] (..node_fs [])))))))
+ (def: (discard _)
+ (Fs::rmdirSync [path] (..node_fs [])))))
(`` (implementation: #export default
(System IO)
(~~ (template [<name> <method> <capability> <exception>]
[(with_expansions [<failure> (exception.throw <exception> [path])]
- (def: <name>
- (..can_open
- (function (<name> path)
- (do {! io.monad}
- [?stats (Fs::statSync [path] (..node_fs []))]
- (case ?stats
- (#try.Success stats)
- (do !
- [?verdict (<method> [] stats)]
- (wrap (case ?verdict
- (#try.Success verdict)
- (if verdict
- (#try.Success (<capability> path))
- <failure>)
-
- (#try.Failure _)
- <failure>)))
-
- (#try.Failure _)
- (wrap <failure>)))))))]
+ (def: (<name> path)
+ (do {! io.monad}
+ [?stats (Fs::statSync [path] (..node_fs []))]
+ (case ?stats
+ (#try.Success stats)
+ (do !
+ [?verdict (<method> [] stats)]
+ (wrap (case ?verdict
+ (#try.Success verdict)
+ (if verdict
+ (#try.Success (<capability> path))
+ <failure>)
+
+ (#try.Failure _)
+ <failure>)))
+
+ (#try.Failure _)
+ (wrap <failure>)))))]
[file Stats::isFile ..file ..cannot_find_file]
[directory Stats::isDirectory ..directory ..cannot_find_directory]
))
(~~ (template [<name> <capability> <exception> <prep>]
- [(def: <name>
- (..can_open
- (function (<name> path)
- (let [node_fs (..node_fs [])]
- (do io.monad
- [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)]
- (case outcome
- (#try.Success _)
- (wrap (exception.throw <exception> [path]))
-
- (#try.Failure _)
- (do (try.with io.monad)
- [_ (|> node_fs <prep>)]
- (wrap (<capability> path)))))))))]
+ [(def: (<name> path)
+ (let [node_fs (..node_fs [])]
+ (do io.monad
+ [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)]
+ (case outcome
+ (#try.Success _)
+ (wrap (exception.throw <exception> [path]))
+
+ (#try.Failure _)
+ (do (try.with io.monad)
+ [_ (|> node_fs <prep>)]
+ (wrap (<capability> path)))))))]
[create_file ..file ..cannot_create_file (Fs::appendFileSync [path (Buffer::from (binary.create 0))])]
[create_directory ..directory ..cannot_create_directory (Fs::mkdirSync [path])]
@@ -710,106 +634,82 @@
(-> Path (File IO))
(~~ (template [<name> <mode>]
- [(def: <name>
- (..can_modify
- (function (<name> data)
- (do (try.with io.monad)
- [file (..open [path <mode>])
- _ (PyFile::write [data] file)
- _ (PyFile::close [] file)]
- (wrap [])))))]
+ [(def: (<name> data)
+ (do (try.with io.monad)
+ [file (..open [path <mode>])
+ _ (PyFile::write [data] file)
+ _ (PyFile::close [] file)]
+ (wrap [])))]
[over_write "w+b"]
[append "ab"]
))
- (def: content
- (..can_query
- (function (_ _)
- (do (try.with io.monad)
- [file (..open [path "rb"])
- data (PyFile::read [] file)
- _ (PyFile::close [] file)]
- (wrap data)))))
+ (def: (content _)
+ (do (try.with io.monad)
+ [file (..open [path "rb"])
+ data (PyFile::read [] file)
+ _ (PyFile::close [] file)]
+ (wrap data)))
(def: path
- (..can_see
- (function (_ _)
- path)))
-
- (def: size
- (..can_query
- (function (_ _)
- (do (try.with io.monad)
- [size (os/path::getsize [path])]
- (wrap (.nat size))))))
-
- (def: last_modified
- (..can_query
- (function (_ _)
- (do (try.with io.monad)
- [seconds_since_epoch (os/path::getmtime [path])]
- (wrap (|> seconds_since_epoch
- f.int
- (i.* +1,000)
- duration.from_millis
- instant.absolute))))))
-
- (def: can_execute?
- (..can_query
- (function (can_execute? _)
- (os::access [path (os::X_OK)]))))
-
- (def: move
- (..can_open
- (function (move destination)
- (do (try.with io.monad)
- [_ (os::rename [path destination])]
- (wrap (file destination))))))
-
- (def: modify
- (..can_modify
- (function (modify time_stamp)
- (let [when (|> time_stamp instant.relative duration.to_millis (i./ +1,000))]
- (os::utime [path (..tuple [when when])])))))
-
- (def: delete
- (..can_delete
- (function (delete _)
- (os::remove [path]))))
+ path)
+
+ (def: (size _)
+ (do (try.with io.monad)
+ [size (os/path::getsize [path])]
+ (wrap (.nat size))))
+
+ (def: (last_modified _)
+ (do (try.with io.monad)
+ [seconds_since_epoch (os/path::getmtime [path])]
+ (wrap (|> seconds_since_epoch
+ f.int
+ (i.* +1,000)
+ duration.from_millis
+ instant.absolute))))
+
+ (def: (can_execute? _)
+ (os::access [path (os::X_OK)]))
+
+ (def: (move destination)
+ (do (try.with io.monad)
+ [_ (os::rename [path destination])]
+ (wrap (file destination))))
+
+ (def: (modify time_stamp)
+ (let [when (|> time_stamp instant.relative duration.to_millis (i./ +1,000))]
+ (os::utime [path (..tuple [when when])])))
+
+ (def: (delete _)
+ (os::remove [path]))
))
(`` (implementation: (directory path)
(-> Path (Directory IO))
(def: scope
- (..can_see
- (function (_ _)
- path)))
+ path)
(~~ (template [<name> <method> <capability>]
- [(def: <name>
- (..can_query
- (function (<name> _)
- (do {! (try.with io.monad)}
- [subs (os::listdir [path])
- subs (monad.map ! (function (_ sub)
- (do !
- [verdict (<method> [sub])]
- (wrap [verdict sub])))
- (array.to_list subs))]
- (wrap (|> subs
- (list.filter product.left)
- (list\map (|>> product.right <capability>))))))))]
+ [(def: (<name> _)
+ (do {! (try.with io.monad)}
+ [subs (os::listdir [path])
+ subs (monad.map ! (function (_ sub)
+ (do !
+ [verdict (<method> [sub])]
+ (wrap [verdict sub])))
+ (array.to_list subs))]
+ (wrap (|> subs
+ (list.filter product.left)
+ (list\map (|>> product.right <capability>))))))]
[files os/path::isfile ..file]
[directories os/path::isdir directory]
))
- (def: discard
- (..can_delete
- (function (discard _)
- (os::rmdir [path]))))
+ (def: (discard _)
+ (os::rmdir [path]))
))
(`` (implementation: #export default
@@ -817,49 +717,43 @@
(~~ (template [<name> <method> <capability> <exception>]
[(with_expansions [<failure> (exception.throw <exception> [path])]
- (def: <name>
- (..can_open
- (function (<name> path)
- (do io.monad
- [?verdict (<method> [path])]
- (wrap (case ?verdict
- (#try.Success verdict)
- (if verdict
- (#try.Success (<capability> path))
- <failure>)
-
- (#try.Failure _)
- <failure>)))))))]
+ (def: (<name> path)
+ (do io.monad
+ [?verdict (<method> [path])]
+ (wrap (case ?verdict
+ (#try.Success verdict)
+ (if verdict
+ (#try.Success (<capability> path))
+ <failure>)
+
+ (#try.Failure _)
+ <failure>)))))]
[file os/path::isfile ..file ..cannot_find_file]
[directory os/path::isdir ..directory ..cannot_find_directory]
))
- (def: create_file
- (..can_open
- (function (create_file path)
- (do {! io.monad}
- [file (..open [path "w"])]
- (case file
- (#try.Success file)
- (do (try.with !)
- [_ (PyFile::close [] file)]
- (wrap (..file path)))
-
- (#try.Failure error)
- (wrap (exception.throw ..cannot_create_file [path])))))))
-
- (def: create_directory
- (..can_open
- (function (create_directory path)
- (do io.monad
- [outcome (os::mkdir [path])]
- (wrap (case outcome
- (#try.Success _)
- (#try.Success (..directory path))
-
- (#try.Failure error)
- (exception.throw ..cannot_create_directory [path])))))))
+ (def: (create_file path)
+ (do {! io.monad}
+ [file (..open [path "w"])]
+ (case file
+ (#try.Success file)
+ (do (try.with !)
+ [_ (PyFile::close [] file)]
+ (wrap (..file path)))
+
+ (#try.Failure error)
+ (wrap (exception.throw ..cannot_create_file [path])))))
+
+ (def: (create_directory path)
+ (do io.monad
+ [outcome (os::mkdir [path])]
+ (wrap (case outcome
+ (#try.Success _)
+ (#try.Success (..directory path))
+
+ (#try.Failure error)
+ (exception.throw ..cannot_create_directory [path])))))
(def: separator
(os/path::sep))
@@ -910,136 +804,118 @@
(-> Path (File IO))
(~~ (template [<name> <mode>]
- [(def: <name>
- (..can_modify
- (function (<name> data)
- (do {! io.monad}
- [?file (io/open [path <mode>])]
- (case ?file
- (#.Some file)
- (do !
- [?wrote (LuaFile::write [("lua utf8 decode" data)] file)]
- (case ?wrote
- (#.Some _)
- (do !
- [flushed? (LuaFile::flush [] file)
- closed? (LuaFile::close [] file)]
- (wrap (cond (not flushed?)
- (exception.throw ..cannot_write_to_file [path])
-
- (not closed?)
- (exception.throw ..cannot_close_file [path])
-
- ## else
- (#try.Success []))))
-
- #.None
- (wrap (exception.throw ..cannot_write_to_file [path]))))
-
- #.None
- (wrap (exception.throw ..cannot_open_file [path])))))))]
+ [(def: (<name> data)
+ (do {! io.monad}
+ [?file (io/open [path <mode>])]
+ (case ?file
+ (#.Some file)
+ (do !
+ [?wrote (LuaFile::write [("lua utf8 decode" data)] file)]
+ (case ?wrote
+ (#.Some _)
+ (do !
+ [flushed? (LuaFile::flush [] file)
+ closed? (LuaFile::close [] file)]
+ (wrap (cond (not flushed?)
+ (exception.throw ..cannot_write_to_file [path])
+
+ (not closed?)
+ (exception.throw ..cannot_close_file [path])
+
+ ## else
+ (#try.Success []))))
+
+ #.None
+ (wrap (exception.throw ..cannot_write_to_file [path]))))
+
+ #.None
+ (wrap (exception.throw ..cannot_open_file [path])))))]
[over_write "w+b"]
[append "ab"]
))
- (def: content
- (..can_query
- (function (_ _)
- (do {! io.monad}
- [?file (io/open [path "rb"])]
- (case ?file
- (#.Some file)
- (do !
- [data (LuaFile::read ["a"] file)
- closed? (LuaFile::close [] file)]
- (wrap (if closed?
- (#try.Success ("lua utf8 encode" data))
- (exception.throw ..cannot_close_file [path]))))
-
- #.None
- (wrap (exception.throw ..cannot_read_all_data [path])))))))
+ (def: (content _)
+ (do {! io.monad}
+ [?file (io/open [path "rb"])]
+ (case ?file
+ (#.Some file)
+ (do !
+ [data (LuaFile::read ["a"] file)
+ closed? (LuaFile::close [] file)]
+ (wrap (if closed?
+ (#try.Success ("lua utf8 encode" data))
+ (exception.throw ..cannot_close_file [path]))))
+
+ #.None
+ (wrap (exception.throw ..cannot_read_all_data [path])))))
(def: path
- (..can_see
- (function (_ _)
- path)))
-
- (~~ (template [<capability> <name>]
- [(def: <name>
- (<capability>
- (function (_ _)
- (let [[_ short] (name_of <name>)]
- (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))))]
-
- [..can_query size]
- [..can_query last_modified]
- [..can_query can_execute?]
-
- [..can_modify modify]
+ path)
+
+ (~~ (template [<name>]
+ [(def: (<name> _)
+ (let [[_ short] (name_of <name>)]
+ (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))]
+
+ [size]
+ [last_modified]
+ [can_execute?]
+
+ [modify]
))
- (def: move
- (..can_open
- (function (move destination)
- (do io.monad
- [?verdict (os/rename [path destination])]
- (wrap (if (case ?verdict
- (#.Some verdict)
- verdict
-
- #.None
- false)
- (#try.Success (file destination))
- (exception.throw ..cannot_move [destination path])))))))
-
- (def: delete
- (..can_delete
- (function (delete _)
- (do io.monad
- [?verdict (os/remove [path])]
- (wrap (if (case ?verdict
- (#.Some verdict)
- verdict
-
- #.None
- false)
- (#try.Success [])
- (exception.throw ..cannot_delete_file path)))))))
+ (def: (move destination)
+ (do io.monad
+ [?verdict (os/rename [path destination])]
+ (wrap (if (case ?verdict
+ (#.Some verdict)
+ verdict
+
+ #.None
+ false)
+ (#try.Success (file destination))
+ (exception.throw ..cannot_move [destination path])))))
+
+ (def: (delete _)
+ (do io.monad
+ [?verdict (os/remove [path])]
+ (wrap (if (case ?verdict
+ (#.Some verdict)
+ verdict
+
+ #.None
+ false)
+ (#try.Success [])
+ (exception.throw ..cannot_delete_file path)))))
))
(`` (implementation: (directory path)
(-> Path (Directory IO))
(def: scope
- (..can_see
- (function (_ _)
- path)))
+ path)
(~~ (template [<name>]
- [(def: <name>
- (..can_query
- (function (_ _)
- (let [[_ short] (name_of <name>)]
- (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))))]
+ [(def: (<name> _)
+ (let [[_ short] (name_of <name>)]
+ (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))]
[files]
[directories]
))
- (def: discard
- (..can_delete
- (function (discard _)
- (do io.monad
- [?verdict (os/remove [path])]
- (wrap (if (case ?verdict
- (#.Some verdict)
- verdict
-
- #.None
- false)
- (#try.Success [])
- (exception.throw ..cannot_discard_directory path)))))))
+ (def: (discard _)
+ (do io.monad
+ [?verdict (os/remove [path])]
+ (wrap (if (case ?verdict
+ (#.Some verdict)
+ verdict
+
+ #.None
+ false)
+ (#try.Success [])
+ (exception.throw ..cannot_discard_directory path)))))
))
(def: (default_file path)
@@ -1082,37 +958,33 @@
(`` (implementation: #export default
(System IO)
- (def: file (..can_open ..default_file))
- (def: create_file (..can_open ..default_create_file))
-
- (def: directory
- (let [dummy "lux_lua_dummy_file"]
- (..can_open
- (function (directory path)
- (do {! io.monad}
- [?file (..default_create_file (format path ..default_separator dummy))]
- (case ?file
- (#try.Success file)
- (do (try.with !)
- [_ (!.use (\ file delete) [])]
- (wrap (..directory path)))
-
- (#try.Failure error)
- (wrap (if (exception.match? ..file_already_exists error)
- (#try.Success (..directory path))
- (exception.throw ..cannot_find_directory [path])))))))))
-
- (def: create_directory
- (..can_open
- (function (create_directory path)
- (do io.monad
- [?verdict (os/execute [(format "mkdir " path)])]
- (wrap (case ?verdict
- (#.Some verdict)
- (#try.Success (..directory path))
-
- #.None
- (exception.throw ..cannot_create_directory [path])))))))
+ (def: file ..default_file)
+ (def: create_file ..default_create_file)
+
+ (def: (directory path)
+ (do {! io.monad}
+ [#let [dummy "lux_lua_dummy_file"]
+ ?file (..default_create_file (format path ..default_separator dummy))]
+ (case ?file
+ (#try.Success file)
+ (do (try.with !)
+ [_ (\ file delete [])]
+ (wrap (..directory path)))
+
+ (#try.Failure error)
+ (wrap (if (exception.match? ..file_already_exists error)
+ (#try.Success (..directory path))
+ (exception.throw ..cannot_find_directory [path]))))))
+
+ (def: (create_directory path)
+ (do io.monad
+ [?verdict (os/execute [(format "mkdir " path)])]
+ (wrap (case ?verdict
+ (#.Some verdict)
+ (#try.Success (..directory path))
+
+ #.None
+ (exception.throw ..cannot_create_directory [path])))))
(def: separator
..default_separator)
@@ -1168,157 +1040,131 @@
(-> Path (File IO))
(~~ (template [<name> <mode>]
- [(def: <name>
- (..can_modify
- (function (<name> data)
- (do {! (try.with io.monad)}
- [file (RubyFile::open [path <mode>])
- data (RubyFile::write [data] file)
- _ (RubyFile::flush [] file)
- _ (RubyFile::close [] file)]
- (wrap [])))))]
+ [(def: (<name> data)
+ (do {! (try.with io.monad)}
+ [file (RubyFile::open [path <mode>])
+ data (RubyFile::write [data] file)
+ _ (RubyFile::flush [] file)
+ _ (RubyFile::close [] file)]
+ (wrap [])))]
[over_write "wb"]
[append "ab"]
))
- (def: content
- (..can_query
- (function (_ _)
- (do {! (try.with io.monad)}
- [file (RubyFile::open [path "rb"])
- data (RubyFile::read [] file)
- _ (RubyFile::close [] file)]
- (wrap data)))))
+ (def: (content _)
+ (do {! (try.with io.monad)}
+ [file (RubyFile::open [path "rb"])
+ data (RubyFile::read [] file)
+ _ (RubyFile::close [] file)]
+ (wrap data)))
(def: path
- (..can_see
- (function (_ _)
- path)))
-
- (~~ (template [<capability> <name> <pipeline>]
- [(def: <name>
- (<capability>
- (function (_ _)
- (do {! (try.with io.monad)}
- [stat (: (IO (Try RubyStat))
- (RubyFile::stat [path]))]
- (wrap (`` (|> stat (: RubyStat) (~~ (template.splice <pipeline>)))))))))]
-
- [..can_query size [RubyStat::size .nat]]
- [..can_query last_modified [(RubyStat::mtime [])
- (RubyTime::to_f [])
- (f.* +1,000.0)
- f.int
- duration.from_millis
- instant.absolute]]
- [..can_query can_execute? [(RubyStat::executable? [])]]
+ path)
+
+ (~~ (template [<name> <pipeline>]
+ [(def: (<name> _)
+ (do {! (try.with io.monad)}
+ [stat (: (IO (Try RubyStat))
+ (RubyFile::stat [path]))]
+ (wrap (`` (|> stat (: RubyStat) (~~ (template.splice <pipeline>)))))))]
+
+ [size [RubyStat::size .nat]]
+ [last_modified [(RubyStat::mtime [])
+ (RubyTime::to_f [])
+ (f.* +1,000.0)
+ f.int
+ duration.from_millis
+ instant.absolute]]
+ [can_execute? [(RubyStat::executable? [])]]
))
- (def: modify
- (..can_modify
- (function (_ moment)
- (let [moment (|> moment
- instant.relative
- duration.to_millis
- i.frac
- (f./ +1,000.0)
- RubyTime::at)]
- (do {! (try.with io.monad)}
- [_ (RubyFile::utime [moment moment path])]
- (wrap []))))))
-
- (def: move
- (..can_open
- (function (_ destination)
- (do {! (try.with io.monad)}
- [_ (RubyFileUtils::move [path destination])]
- (wrap (file destination))))))
-
- (def: delete
- (..can_delete
- (function (_ _)
- (do {! (try.with io.monad)}
- [_ (RubyFile::delete [path])]
- (wrap [])))))
+ (def: (modify moment)
+ (let [moment (|> moment
+ instant.relative
+ duration.to_millis
+ i.frac
+ (f./ +1,000.0)
+ RubyTime::at)]
+ (do (try.with io.monad)
+ [_ (RubyFile::utime [moment moment path])]
+ (wrap []))))
+
+ (def: (move destination)
+ (do (try.with io.monad)
+ [_ (RubyFileUtils::move [path destination])]
+ (wrap (file destination))))
+
+ (def: (delete _)
+ (do (try.with io.monad)
+ [_ (RubyFile::delete [path])]
+ (wrap [])))
))
(`` (implementation: (directory path)
(-> Path (Directory IO))
(def: scope
- (..can_see
- (function (_ _)
- path)))
+ path)
(~~ (template [<name> <test> <constructor> <capability>]
- [(def: <name>
- (..can_query
- (function (_ _)
- (do {! (try.with io.monad)}
- [self (RubyDir::open [path])
- children (RubyDir::children [] self)
- output (loop [input (|> children
- array.to_list
- (list\map (|>> (format path ..default_separator))))
- output (: (List (<capability> IO))
- (list))]
- (case input
- #.Nil
- (wrap output)
-
- (#.Cons head tail)
- (do !
- [verdict (<test> head)]
- (if verdict
- (recur tail (#.Cons (<constructor> head) output))
- (recur tail output)))))
- _ (RubyDir::close [] self)]
- (wrap output)))))]
+ [(def: (<name> _)
+ (do {! (try.with io.monad)}
+ [self (RubyDir::open [path])
+ children (RubyDir::children [] self)
+ output (loop [input (|> children
+ array.to_list
+ (list\map (|>> (format path ..default_separator))))
+ output (: (List (<capability> IO))
+ (list))]
+ (case input
+ #.Nil
+ (wrap output)
+
+ (#.Cons head tail)
+ (do !
+ [verdict (<test> head)]
+ (if verdict
+ (recur tail (#.Cons (<constructor> head) output))
+ (recur tail output)))))
+ _ (RubyDir::close [] self)]
+ (wrap output)))]
[files RubyFile::file? ..file File]
[directories RubyFile::directory? directory Directory]
))
- (def: discard
- (..can_delete
- (function (discard _)
- (do {! (try.with io.monad)}
- [_ (RubyFileUtils::rmdir [path])]
- (wrap [])))))
+ (def: (discard _)
+ (do (try.with io.monad)
+ [_ (RubyFileUtils::rmdir [path])]
+ (wrap [])))
))
(`` (implementation: #export default
(System IO)
(~~ (template [<name> <test> <constructor> <exception>]
- [(def: <name>
- (..can_open
- (function (_ path)
- (do {! (try.with io.monad)}
- [verdict (<test> path)]
- (\ io.monad wrap
- (if verdict
- (#try.Success (<constructor> path))
- (exception.throw <exception> [path])))))))]
+ [(def: (<name> path)
+ (do {! (try.with io.monad)}
+ [verdict (<test> path)]
+ (\ io.monad wrap
+ (if verdict
+ (#try.Success (<constructor> path))
+ (exception.throw <exception> [path])))))]
[file RubyFile::file? ..file ..cannot_find_file]
[directory RubyFile::directory? ..directory ..cannot_find_directory]
))
- (def: create_file
- (..can_open
- (function (_ path)
- (do {! (try.with io.monad)}
- [_ (RubyFileUtils::touch [path])]
- (wrap (..file path))))))
-
- (def: create_directory
- (..can_open
- (function (create_directory path)
- (do {! (try.with io.monad)}
- [_ (RubyFileUtils::mkdir path)]
- (wrap (..directory path))))))
+ (def: (create_file path)
+ (do {! (try.with io.monad)}
+ [_ (RubyFileUtils::touch [path])]
+ (wrap (..file path))))
+
+ (def: (create_directory path)
+ (do {! (try.with io.monad)}
+ [_ (RubyFileUtils::mkdir path)]
+ (wrap (..directory path))))
(def: separator
..default_separator)
@@ -1370,163 +1216,135 @@
(-> Path (File IO))
(~~ (template [<name> <mode>]
- [(def: <name>
- (..can_modify
- (function (<name> data)
- (do {! (try.with io.monad)}
- [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])]
- (if (bit\= false (:coerce Bit outcome))
- (\ io.monad wrap (exception.throw ..cannot_write_to_file [path]))
- (wrap []))))))]
+ [(def: (<name> data)
+ (do {! (try.with io.monad)}
+ [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])]
+ (if (bit\= false (:coerce Bit outcome))
+ (\ io.monad wrap (exception.throw ..cannot_write_to_file [path]))
+ (wrap []))))]
[over_write +0]
[append (..FILE_APPEND)]
))
- (def: content
- (..can_query
- (function (_ _)
- (do {! (try.with io.monad)}
- [data (..file_get_contents [path])]
- (if (bit\= false (:coerce Bit data))
- (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
- (wrap (..unpack [..byte_array_format data])))))))
+ (def: (content _)
+ (do {! (try.with io.monad)}
+ [data (..file_get_contents [path])]
+ (if (bit\= false (:coerce Bit data))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap (..unpack [..byte_array_format data])))))
(def: path
- (..can_see
- (function (_ _)
- path)))
-
- (~~ (template [<capability> <name> <ffi> <pipeline>]
- [(def: <name>
- (<capability>
- (function (_ _)
- (do {! (try.with io.monad)}
- [value (<ffi> [path])]
- (if (bit\= false (:coerce Bit value))
- (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
- (wrap (`` (|> value (~~ (template.splice <pipeline>))))))))))]
-
- [..can_query size ..filesize [.nat]]
- [..can_query last_modified ..filemtime [(i.* +1,000) duration.from_millis instant.absolute]]
+ path)
+
+ (~~ (template [<name> <ffi> <pipeline>]
+ [(def: (<name> _)
+ (do {! (try.with io.monad)}
+ [value (<ffi> [path])]
+ (if (bit\= false (:coerce Bit value))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap (`` (|> value (~~ (template.splice <pipeline>))))))))]
+
+ [size ..filesize [.nat]]
+ [last_modified ..filemtime [(i.* +1,000) duration.from_millis instant.absolute]]
))
- (def: can_execute?
- (..can_query
- (function (_ _)
- (..is_executable [path]))))
-
- (def: modify
- (..can_modify
- (function (_ moment)
- (do {! (try.with io.monad)}
- [verdict (..touch [path (|> moment instant.relative duration.to_millis (i./ +1,000))])]
- (if (bit\= false (:coerce Bit verdict))
- (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
- (wrap []))))))
-
- (def: move
- (..can_open
- (function (_ destination)
- (do {! (try.with io.monad)}
- [verdict (..rename [path destination])]
- (if (bit\= false (:coerce Bit verdict))
- (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
- (wrap (file destination)))))))
-
- (def: delete
- (..can_delete
- (function (_ _)
- (do {! (try.with io.monad)}
- [verdict (..unlink [path])]
- (if (bit\= false (:coerce Bit verdict))
- (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
- (wrap []))))))
+ (def: (can_execute? _)
+ (..is_executable [path]))
+
+ (def: (modify moment)
+ (do {! (try.with io.monad)}
+ [verdict (..touch [path (|> moment instant.relative duration.to_millis (i./ +1,000))])]
+ (if (bit\= false (:coerce Bit verdict))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap []))))
+
+ (def: (move destination)
+ (do {! (try.with io.monad)}
+ [verdict (..rename [path destination])]
+ (if (bit\= false (:coerce Bit verdict))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap (file destination)))))
+
+ (def: (delete _)
+ (do (try.with io.monad)
+ [verdict (..unlink [path])]
+ (if (bit\= false (:coerce Bit verdict))
+ (\ io.monad wrap (exception.throw ..cannot_find_file [path]))
+ (wrap []))))
))
(`` (implementation: (directory path)
(-> Path (Directory IO))
(def: scope
- (..can_see
- (function (_ _)
- path)))
+ path)
(~~ (template [<name> <test> <constructor> <capability>]
- [(def: <name>
- (..can_query
- (function (_ _)
- (do {! (try.with io.monad)}
- [children (..scandir [path])]
- (loop [input (|> children
- array.to_list
- (list.filter (function (_ child)
- (not (or (text\= "." child)
- (text\= ".." child))))))
- output (: (List (<capability> IO))
- (list))]
- (case input
- #.Nil
- (wrap output)
-
- (#.Cons head tail)
- (do !
- [verdict (<test> head)]
- (if verdict
- (recur tail (#.Cons (<constructor> head) output))
- (recur tail output)))))))))]
+ [(def: (<name> _)
+ (do {! (try.with io.monad)}
+ [children (..scandir [path])]
+ (loop [input (|> children
+ array.to_list
+ (list.filter (function (_ child)
+ (not (or (text\= "." child)
+ (text\= ".." child))))))
+ output (: (List (<capability> IO))
+ (list))]
+ (case input
+ #.Nil
+ (wrap output)
+
+ (#.Cons head tail)
+ (do !
+ [verdict (<test> head)]
+ (if verdict
+ (recur tail (#.Cons (<constructor> head) output))
+ (recur tail output)))))))]
[files ..is_file ..file File]
[directories ..is_dir directory Directory]
))
- (def: discard
- (..can_delete
- (function (_ _)
- (do {! (try.with io.monad)}
- [verdict (..rmdir [path])]
- (if (bit\= false (:coerce Bit verdict))
- (\ io.monad wrap (exception.throw ..cannot_find_directory [path]))
- (wrap []))))))
+ (def: (discard _)
+ (do (try.with io.monad)
+ [verdict (..rmdir [path])]
+ (if (bit\= false (:coerce Bit verdict))
+ (\ io.monad wrap (exception.throw ..cannot_find_directory [path]))
+ (wrap []))))
))
(`` (implementation: #export default
(System IO)
(~~ (template [<name> <test> <constructor> <exception>]
- [(def: <name>
- (..can_open
- (function (_ path)
- (do {! (try.with io.monad)}
- [verdict (<test> path)]
- (\ io.monad wrap
- (if verdict
- (#try.Success (<constructor> path))
- (exception.throw <exception> [path])))))))]
+ [(def: (<name> path)
+ (do {! (try.with io.monad)}
+ [verdict (<test> path)]
+ (\ io.monad wrap
+ (if verdict
+ (#try.Success (<constructor> path))
+ (exception.throw <exception> [path])))))]
[file ..is_file ..file ..cannot_find_file]
[directory ..is_dir ..directory ..cannot_find_directory]
))
- (def: create_file
- (..can_open
- (function (_ path)
- (do {! (try.with io.monad)}
- [verdict (..touch [path (|> instant.now io.run instant.relative duration.to_millis (i./ +1,000))])]
- (\ io.monad wrap
- (if verdict
- (#try.Success (..file path))
- (exception.throw ..cannot_create_file [path])))))))
+ (def: (create_file path)
+ (do {! (try.with io.monad)}
+ [verdict (..touch [path (|> instant.now io.run instant.relative duration.to_millis (i./ +1,000))])]
+ (\ io.monad wrap
+ (if verdict
+ (#try.Success (..file path))
+ (exception.throw ..cannot_create_file [path])))))
- (def: create_directory
- (..can_open
- (function (_ path)
- (do {! (try.with io.monad)}
- [verdict (..mkdir path)]
- (\ io.monad wrap
- (if verdict
- (#try.Success (..directory path))
- (exception.throw ..cannot_create_directory [path])))))))
+ (def: (create_directory path)
+ (do {! (try.with io.monad)}
+ [verdict (..mkdir path)]
+ (\ io.monad wrap
+ (if verdict
+ (#try.Success (..directory path))
+ (exception.throw ..cannot_create_directory [path])))))
(def: separator
..default_separator)
@@ -1541,14 +1359,14 @@
[(def: #export (<get> monad system path)
(All [!] (-> (Monad !) (System !) Path (! (Try (<signature> !)))))
(do monad
- [outcome (!.use (\ system <find>) path)]
+ [outcome (\ system <find> path)]
(case outcome
(#try.Success file)
(wrap (#try.Success file))
(#try.Failure error)
(if (exception.match? <exception> error)
- (!.use (\ system <create>) path)
+ (\ system <create> path)
(wrap (#try.Failure error))))))]
[get_file File create_file file ..cannot_find_file]
@@ -1559,7 +1377,7 @@
[(def: #export (<predicate> monad system path)
(All [!] (-> (Monad !) (System !) Path (! Bit)))
(do monad
- [?file (!.use (\ system <capability>) path)]
+ [?file (\ system <capability> path)]
(case ?file
(#try.Success file)
(wrap true)
@@ -1720,108 +1538,89 @@
(-> Text Path (Var Mock) (File Promise))
(implementation
(def: path
- (..can_see
- (function.constant path)))
+ path)
- (def: size
- (..can_query
- (function (_ _)
- (stm.commit
- (do stm.monad
- [|store| (stm.read store)]
- (wrap (do try.monad
- [[name file] (..retrieve_mock_file! separator path |store|)]
- (wrap (binary.size (get@ #mock_content file))))))))))
-
- (def: content
- (..can_query
- (function (_ _)
- (stm.commit
- (do stm.monad
- [|store| (stm.read store)]
- (wrap (do try.monad
- [[name file] (..retrieve_mock_file! separator path |store|)]
- (wrap (get@ #mock_content file)))))))))
-
- (def: last_modified
- (..can_query
- (function (_ _)
- (stm.commit
- (do stm.monad
- [|store| (stm.read store)]
- (wrap (do try.monad
- [[name file] (..retrieve_mock_file! separator path |store|)]
- (wrap (get@ #mock_last_modified file)))))))))
-
- (def: can_execute?
- (..can_query
- (function (_ _)
- (stm.commit
- (do stm.monad
- [|store| (stm.read store)]
- (wrap (do try.monad
- [[name file] (..retrieve_mock_file! separator path |store|)]
- (wrap (get@ #mock_can_execute file)))))))))
-
- (def: over_write
- (..can_modify
- (function (_ content)
- (do promise.monad
- [now (promise.future instant.now)]
- (stm.commit
- (..try_update! (..update_mock_file! separator path now content) store))))))
-
- (def: append
- (..can_modify
- (function (_ content)
- (do promise.monad
- [now (promise.future instant.now)]
- (stm.commit
- (..try_update! (function (_ |store|)
- (do try.monad
- [[name file] (..retrieve_mock_file! separator path |store|)]
- (..update_mock_file! separator path now
- (\ binary.monoid compose
- (get@ #mock_content file)
- content)
- |store|)))
- store))))))
-
- (def: modify
- (..can_modify
- (function (_ now)
- (stm.commit
- (..try_update! (function (_ |store|)
- (do try.monad
- [[name file] (..retrieve_mock_file! separator path |store|)]
- (..update_mock_file! separator path now (get@ #mock_content file) |store|)))
- store)))))
-
- (def: delete
- (..can_delete
- (function (_ _)
- (stm.commit
- (..try_update! (..delete_mock_file! separator path) store)))))
-
- (def: move
- (..can_open
- (function (_ path)
- (stm.commit
- (do {! stm.monad}
- [|store| (stm.read store)]
- (case (do try.monad
- [[name file] (..retrieve_mock_file! separator path |store|)
- |store| (..delete_mock_file! separator path |store|)
- [name |store|] (..create_mock_file! separator path (get@ #mock_last_modified file) |store|)
- |store| (..update_mock_file! separator path (get@ #mock_last_modified file) (get@ #mock_content file) |store|)]
- (wrap [|store| (mock_file separator path store)]))
- (#try.Success [|store| moved])
- (do !
- [_ (stm.write |store| store)]
- (wrap (#try.Success moved)))
-
- (#try.Failure error)
- (wrap (#try.Failure error))))))))
+ (def: (size _)
+ (stm.commit
+ (do stm.monad
+ [|store| (stm.read store)]
+ (wrap (do try.monad
+ [[name file] (..retrieve_mock_file! separator path |store|)]
+ (wrap (binary.size (get@ #mock_content file))))))))
+
+ (def: (content _)
+ (stm.commit
+ (do stm.monad
+ [|store| (stm.read store)]
+ (wrap (do try.monad
+ [[name file] (..retrieve_mock_file! separator path |store|)]
+ (wrap (get@ #mock_content file)))))))
+
+ (def: (last_modified _)
+ (stm.commit
+ (do stm.monad
+ [|store| (stm.read store)]
+ (wrap (do try.monad
+ [[name file] (..retrieve_mock_file! separator path |store|)]
+ (wrap (get@ #mock_last_modified file)))))))
+
+ (def: (can_execute? _)
+ (stm.commit
+ (do stm.monad
+ [|store| (stm.read store)]
+ (wrap (do try.monad
+ [[name file] (..retrieve_mock_file! separator path |store|)]
+ (wrap (get@ #mock_can_execute file)))))))
+
+ (def: (over_write content)
+ (do promise.monad
+ [now (promise.future instant.now)]
+ (stm.commit
+ (..try_update! (..update_mock_file! separator path now content) store))))
+
+ (def: (append content)
+ (do promise.monad
+ [now (promise.future instant.now)]
+ (stm.commit
+ (..try_update! (function (_ |store|)
+ (do try.monad
+ [[name file] (..retrieve_mock_file! separator path |store|)]
+ (..update_mock_file! separator path now
+ (\ binary.monoid compose
+ (get@ #mock_content file)
+ content)
+ |store|)))
+ store))))
+
+ (def: (modify now)
+ (stm.commit
+ (..try_update! (function (_ |store|)
+ (do try.monad
+ [[name file] (..retrieve_mock_file! separator path |store|)]
+ (..update_mock_file! separator path now (get@ #mock_content file) |store|)))
+ store)))
+
+ (def: (delete _)
+ (stm.commit
+ (..try_update! (..delete_mock_file! separator path) store)))
+
+ (def: (move path)
+ (stm.commit
+ (do {! stm.monad}
+ [|store| (stm.read store)]
+ (case (do try.monad
+ [[name file] (..retrieve_mock_file! separator path |store|)
+ |store| (..delete_mock_file! separator path |store|)
+ [name |store|] (..create_mock_file! separator path (get@ #mock_last_modified file) |store|)
+ |store| (..update_mock_file! separator path (get@ #mock_last_modified file) (get@ #mock_content file) |store|)]
+ (wrap [|store| (mock_file separator path store)]))
+ (#try.Success [|store| moved])
+ (do !
+ [_ (stm.write |store| store)]
+ (wrap (#try.Success moved)))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error))))))
))
(def: (create_mock_directory! separator path mock)
@@ -1908,64 +1707,56 @@
(-> Text Path (Var Mock) (Directory Promise))
(implementation
(def: scope
- (..can_see
- (function (_ _)
- path)))
+ path)
- (def: files
- (..can_query
- (function (_ _)
- (stm.commit
- (do stm.monad
- [|store| (stm.read store)]
- (wrap (do try.monad
- [directory (..retrieve_mock_directory! separator path |store|)]
- (wrap (|> directory
- dictionary.entries
- (list.all (function (_ [node_name node])
- (case node
- (#.Left file)
- (#.Some (..mock_file separator
+ (def: (files _)
+ (stm.commit
+ (do stm.monad
+ [|store| (stm.read store)]
+ (wrap (do try.monad
+ [directory (..retrieve_mock_directory! separator path |store|)]
+ (wrap (|> directory
+ dictionary.entries
+ (list.all (function (_ [node_name node])
+ (case node
+ (#.Left file)
+ (#.Some (..mock_file separator
+ (format path separator node_name)
+ store))
+
+ (#.Right directory)
+ #.None))))))))))
+
+ (def: (directories _)
+ (stm.commit
+ (do stm.monad
+ [|store| (stm.read store)]
+ (wrap (do try.monad
+ [directory (..retrieve_mock_directory! separator path |store|)]
+ (wrap (|> directory
+ dictionary.entries
+ (list.all (function (_ [node_name node])
+ (case node
+ (#.Left file)
+ #.None
+
+ (#.Right directory)
+ (#.Some (mock_directory separator
(format path separator node_name)
- store))
-
- (#.Right directory)
- #.None))))))))))))
-
- (def: directories
- (..can_query
- (function (_ _)
- (stm.commit
- (do stm.monad
- [|store| (stm.read store)]
- (wrap (do try.monad
- [directory (..retrieve_mock_directory! separator path |store|)]
- (wrap (|> directory
- dictionary.entries
- (list.all (function (_ [node_name node])
- (case node
- (#.Left file)
- #.None
-
- (#.Right directory)
- (#.Some (mock_directory separator
- (format path separator node_name)
- store))))))))))))))
-
- (def: discard
- (..can_delete
- (function (_ _)
- (stm.commit
- (do {! stm.monad}
- [|store| (stm.read store)]
- (case (..delete_mock_directory! separator path |store|)
- (#try.Success |store|)
- (do !
- [_ (stm.write |store| store)]
- (wrap (#try.Success [])))
-
- (#try.Failure error)
- (wrap (#try.Failure error))))))))
+ store))))))))))))
+
+ (def: (discard _)
+ (stm.commit
+ (do {! stm.monad}
+ [|store| (stm.read store)]
+ (case (..delete_mock_directory! separator path |store|)
+ (#try.Success |store|)
+ (do !
+ [_ (stm.write |store| store)]
+ (wrap (#try.Success [])))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error))))))
))
(def: #export (mock separator)
@@ -1974,57 +1765,49 @@
(implementation
(def: separator separator)
- (def: file
- (..can_open
- (function (_ path)
- (stm.commit
- (do stm.monad
- [|store| (stm.read store)]
- (wrap (do try.monad
- [[name file] (..retrieve_mock_file! separator path |store|)]
- (wrap (..mock_file separator path store)))))))))
-
- (def: create_file
- (..can_open
- (function (_ path)
- (do promise.monad
- [now (promise.future instant.now)]
- (stm.commit
- (do {! stm.monad}
- [|store| (stm.read store)]
- (case (..create_mock_file! separator path now |store|)
- (#try.Success [name |store|])
- (do !
- [_ (stm.write |store| store)]
- (wrap (#try.Success (..mock_file separator path store))))
-
- (#try.Failure error)
- (wrap (#try.Failure error)))))))))
-
- (def: directory
- (..can_open
- (function (_ path)
- (stm.commit
- (do stm.monad
- [|store| (stm.read store)]
- (wrap (do try.monad
- [directory (..retrieve_mock_directory! separator path |store|)]
- (wrap (..mock_directory separator path store)))))))))
-
- (def: create_directory
- (..can_open
- (function (_ path)
- (stm.commit
- (do {! stm.monad}
- [|store| (stm.read store)]
- (case (..create_mock_directory! separator path |store|)
- (#try.Success |store|)
- (do !
- [_ (stm.write |store| store)]
- (wrap (#try.Success (..mock_directory separator path store))))
-
- (#try.Failure error)
- (wrap (#try.Failure error))))))))
+ (def: (file path)
+ (stm.commit
+ (do stm.monad
+ [|store| (stm.read store)]
+ (wrap (do try.monad
+ [[name file] (..retrieve_mock_file! separator path |store|)]
+ (wrap (..mock_file separator path store)))))))
+
+ (def: (create_file path)
+ (do promise.monad
+ [now (promise.future instant.now)]
+ (stm.commit
+ (do {! stm.monad}
+ [|store| (stm.read store)]
+ (case (..create_mock_file! separator path now |store|)
+ (#try.Success [name |store|])
+ (do !
+ [_ (stm.write |store| store)]
+ (wrap (#try.Success (..mock_file separator path store))))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error)))))))
+
+ (def: (directory path)
+ (stm.commit
+ (do stm.monad
+ [|store| (stm.read store)]
+ (wrap (do try.monad
+ [directory (..retrieve_mock_directory! separator path |store|)]
+ (wrap (..mock_directory separator path store)))))))
+
+ (def: (create_directory path)
+ (stm.commit
+ (do {! stm.monad}
+ [|store| (stm.read store)]
+ (case (..create_mock_directory! separator path |store|)
+ (#try.Success |store|)
+ (do !
+ [_ (stm.write |store| store)]
+ (wrap (#try.Success (..mock_directory separator path store))))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error))))))
)))
(def: #export (make_directories monad system path)
diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux
index 24d8657ad..85ae21b2f 100644
--- a/stdlib/source/lux/world/file/watch.lux
+++ b/stdlib/source/lux/world/file/watch.lux
@@ -11,9 +11,7 @@
["." exception (#+ exception:)]
[concurrency
["." promise (#+ Promise)]
- ["." stm (#+ STM Var)]]
- [security
- ["!" capability]]]
+ ["." stm (#+ STM Var)]]]
[data
["." product]
["." maybe]
@@ -117,12 +115,12 @@
(def: (file_tracker fs directory)
(-> (//.System Promise) (//.Directory Promise) (Promise (Try File_Tracker)))
(do {! (try.with promise.monad)}
- [files (!.use (\ directory files) [])]
+ [files (\ directory files [])]
(monad.fold !
(function (_ file tracker)
(do !
- [last_modified (!.use (\ file last_modified) [])]
- (wrap (dictionary.put (!.use (\ file path) [])
+ [last_modified (\ file last_modified [])]
+ (wrap (dictionary.put (\ file path)
[file last_modified]
tracker))))
(: File_Tracker
@@ -132,11 +130,11 @@
(def: (poll_files directory file_tracker)
(-> (//.Directory Promise) File_Tracker (Promise (Try (List [//.Path (//.File Promise) Instant]))))
(do {! (try.with promise.monad)}
- [files (!.use (\ directory files) [])]
+ [files (\ directory files [])]
(monad.map ! (function (_ file)
(do !
- [last_modified (!.use (\ file last_modified) [])]
- (wrap [(!.use (\ file path) []) file last_modified])))
+ [last_modified (\ file last_modified [])]
+ (wrap [(\ file path) file last_modified])))
files)))
(def: (poll_directory_changes [path [concern directory file_tracker]])
@@ -195,7 +193,7 @@
(if updated?
(wrap (#try.Success []))
(do (try.with !)
- [directory (!.use (\ fs directory) path)
+ [directory (\ fs directory path)
file_tracker (..file_tracker fs directory)]
(do !
[_ (stm.commit (stm.update (dictionary.put path [new_concern directory file_tracker]) tracker))]
diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux
index 51219b9ea..e4133710e 100644
--- a/stdlib/source/lux/world/net.lux
+++ b/stdlib/source/lux/world/net.lux
@@ -1,9 +1,5 @@
(.module:
- [lux (#- Location)
- [control
- [try (#+ Try)]
- [security
- ["!" capability (#+ capability:)]]]])
+ [lux (#- Location)])
(type: #export Address Text)
@@ -14,12 +10,3 @@
(type: #export Location
{#address Address
#port Port})
-
-(capability: #export (Can-Read ! o)
- (can-read Nat (! (Try o))))
-
-(capability: #export (Can-Write ! i)
- (can-write i (! (Try Any))))
-
-(capability: #export (Can-Close !)
- (can-close [] (! (Try Any))))
diff --git a/stdlib/source/lux/world/net/http/client.lux b/stdlib/source/lux/world/net/http/client.lux
index 145133288..ad11a10ab 100644
--- a/stdlib/source/lux/world/net/http/client.lux
+++ b/stdlib/source/lux/world/net/http/client.lux
@@ -13,6 +13,7 @@
[data
["." binary (#+ Binary)]
["." maybe ("#\." functor)]
+ ["." text]
[collection
["." dictionary]]]
[math
@@ -218,3 +219,7 @@
(#try.Failure error)
(#try.Failure error)))))))
+
+(def: #export headers
+ (-> (List [Text Text]) //.Headers)
+ (dictionary.from_list text.hash))
diff --git a/stdlib/source/lux/world/net/http/status.lux b/stdlib/source/lux/world/net/http/status.lux
index a89a5de82..cb0e8a8af 100644
--- a/stdlib/source/lux/world/net/http/status.lux
+++ b/stdlib/source/lux/world/net/http/status.lux
@@ -4,77 +4,79 @@
## https://en.wikipedia.org/wiki/List_of_HTTP_status_codes
(template [<status> <name>]
- [(def: #export <name> Status <status>)]
+ [(def: #export <name>
+ Status
+ <status>)]
## 1xx Informational response
[100 continue]
- [101 switching-protocols]
+ [101 switching_protocols]
[102 processing]
- [103 early-hints]
+ [103 early_hints]
## 2xx Success
[200 ok]
[201 created]
[202 accepted]
- [203 non-authoritative-information]
- [204 no-content]
- [205 reset-content]
- [206 partial-content]
- [207 multi-status]
- [208 already-reported]
- [226 im-used]
+ [203 non_authoritative_information]
+ [204 no_content]
+ [205 reset_content]
+ [206 partial_content]
+ [207 multi_status]
+ [208 already_reported]
+ [226 im_used]
## 3xx Redirection
- [300 multiple-choices]
- [301 moved-permanently]
+ [300 multiple_choices]
+ [301 moved_permanently]
[302 found]
- [303 see-other]
- [304 not-modified]
- [305 use-proxy]
- [306 switch-proxy]
- [307 temporary-redirect]
- [308 permanent-redirect]
+ [303 see_other]
+ [304 not_modified]
+ [305 use_proxy]
+ [306 switch_proxy]
+ [307 temporary_redirect]
+ [308 permanent_redirect]
## 4xx Client errors
- [400 bad-request]
+ [400 bad_request]
[401 unauthorized]
- [402 payment-required]
+ [402 payment_required]
[403 forbidden]
- [404 not-found]
- [405 method-not-allowed]
- [406 not-acceptable]
- [407 proxy-authentication-required]
- [408 request-timeout]
+ [404 not_found]
+ [405 method_not_allowed]
+ [406 not_acceptable]
+ [407 proxy_authentication_required]
+ [408 request_timeout]
[409 conflict]
[410 gone]
- [411 length-required]
- [412 precondition-failed]
- [413 payload-too-large]
- [414 uri-too-long]
- [415 unsupported-media-type]
- [416 range-not-satisfiable]
- [417 expectation-failed]
- [418 im-a-teapot]
- [421 misdirected-request]
- [422 unprocessable-entity]
+ [411 length_required]
+ [412 precondition_failed]
+ [413 payload_too_large]
+ [414 uri_too_long]
+ [415 unsupported_media_type]
+ [416 range_not_satisfiable]
+ [417 expectation_failed]
+ [418 im_a_teapot]
+ [421 misdirected_request]
+ [422 unprocessable_entity]
[423 locked]
- [424 failed-dependency]
- [426 upgrade-required]
- [428 precondition-required]
- [429 too-many-requests]
- [431 request-header-fields-too-large]
- [451 unavailable-for-legal-reasons]
+ [424 failed_dependency]
+ [426 upgrade_required]
+ [428 precondition_required]
+ [429 too_many_requests]
+ [431 request_header_fields_too_large]
+ [451 unavailable_for_legal_reasons]
## 5xx Server errors
- [500 internal-server-error]
- [501 not-implemented]
- [502 bad-gateway]
- [503 service-unavailable]
- [504 gateway-timeout]
- [505 http-version-not-supported]
- [506 variant-also-negotiates]
- [507 insufficient-storage]
- [508 loop-detected]
- [510 not-extended]
- [511 network-authentication-required]
+ [500 internal_server_error]
+ [501 not_implemented]
+ [502 bad_gateway]
+ [503 service_unavailable]
+ [504 gateway_timeout]
+ [505 http_version_not_supported]
+ [506 variant_also_negotiates]
+ [507 insufficient_storage]
+ [508 loop_detected]
+ [510 not_extended]
+ [511 network_authentication_required]
)
diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux
index 0691958b8..d250acfcf 100644
--- a/stdlib/source/lux/world/shell.lux
+++ b/stdlib/source/lux/world/shell.lux
@@ -10,7 +10,6 @@
["." exception (#+ exception:)]
["." io (#+ IO)]
[security
- ["!" capability (#+ capability:)]
["?" policy (#+ Context Safety Safe)]]
[concurrency
["." atom (#+ Atom)]
@@ -33,15 +32,6 @@
[//
[file (#+ Path)]])
-(capability: #export (Can_Read !)
- (can_read [] (! (Try Text))))
-
-(capability: #export (Can_Write !)
- (can_write Text (! (Try Any))))
-
-(capability: #export (Can_Destroy !)
- (can_destroy [] (! (Try Any))))
-
(type: #export Exit
Int)
@@ -54,35 +44,31 @@
[+1 error]
)
-(capability: #export (Can_Wait !)
- (can_wait [] (! (Try Exit))))
-
(interface: #export (Process !)
- (: (Can_Read !)
+ (: (-> [] (! (Try Text)))
read)
- (: (Can_Read !)
+ (: (-> [] (! (Try Text)))
error)
- (: (Can_Write !)
+ (: (-> Text (! (Try Any)))
write)
- (: (Can_Destroy !)
+ (: (-> [] (! (Try Any)))
destroy)
- (: (Can_Wait !)
+ (: (-> [] (! (Try Exit)))
await))
(def: (async_process process)
(-> (Process IO) (Process Promise))
(`` (implementation
- (~~ (template [<method> <capability>]
+ (~~ (template [<method>]
[(def: <method>
- (<capability>
- (|>> (!.use (\ process <method>))
- promise.future)))]
-
- [read ..can_read]
- [error ..can_read]
- [write ..can_write]
- [destroy ..can_destroy]
- [await ..can_wait]
+ (|>> (\ process <method>)
+ promise.future))]
+
+ [read]
+ [error]
+ [write]
+ [destroy]
+ [await]
)))))
(type: #export Command
@@ -91,23 +77,18 @@
(type: #export Argument
Text)
-(capability: #export (Can_Execute !)
- (can_execute [Environment Path Command (List Argument)] (! (Try (Process !)))))
-
(interface: #export (Shell !)
- (: (Can_Execute !)
+ (: (-> [Environment Path Command (List Argument)] (! (Try (Process !))))
execute))
(def: #export (async shell)
(-> (Shell IO) (Shell Promise))
(implementation
- (def: execute
- (..can_execute
- (function (_ input)
- (promise.future
- (do (try.with io.monad)
- [process (!.use (\ shell execute) input)]
- (wrap (..async_process process)))))))))
+ (def: (execute input)
+ (promise.future
+ (do (try.with io.monad)
+ [process (\ shell execute input)]
+ (wrap (..async_process process)))))))
## https://en.wikipedia.org/wiki/Code_injection#Shell_injection
(interface: (Policy ?)
@@ -157,9 +138,9 @@
(: (Context Safety Policy)
(function (_ (^open "?\."))
(implementation
- (def: command (|>> sanitize_command (!.use ?\can_upgrade)))
- (def: argument (|>> sanitize_argument (!.use ?\can_upgrade)))
- (def: value (!.use ?\can_downgrade)))))))
+ (def: command (|>> sanitize_command ?\can_upgrade))
+ (def: argument (|>> sanitize_argument ?\can_upgrade))
+ (def: value ?\can_downgrade))))))
(def: unix_policy
(let [replacer (: Replacer
@@ -259,33 +240,27 @@
(wrap (: (Process IO)
(`` (implementation
(~~ (template [<name> <stream>]
- [(def: <name>
- (..can_read
- (function (_ _)
- (do !
- [output (java/io/BufferedReader::readLine <stream>)]
- (case output
- (#.Some output)
- (wrap output)
-
- #.None
- (\ io.monad wrap (exception.throw ..no_more_output [])))))))]
+ [(def: (<name> _)
+ (do !
+ [output (java/io/BufferedReader::readLine <stream>)]
+ (case output
+ (#.Some output)
+ (wrap output)
+
+ #.None
+ (\ io.monad wrap (exception.throw ..no_more_output [])))))]
[read jvm_input]
[error jvm_error]
))
- (def: write
- (..can_write
- (function (_ message)
- (java/io/OutputStream::write (\ utf8.codec encode message) jvm_output))))
- (~~ (template [<name> <capability> <method>]
- [(def: <name>
- (<capability>
- (function (_ _)
- (<method> process))))]
-
- [destroy ..can_destroy java/lang/Process::destroy]
- [await ..can_wait java/lang/Process::waitFor]
+ (def: (write message)
+ (java/io/OutputStream::write (\ utf8.codec encode message) jvm_output))
+ (~~ (template [<name> <method>]
+ [(def: (<name> _)
+ (<method> process))]
+
+ [destroy java/lang/Process::destroy]
+ [await java/lang/Process::waitFor]
))))))))
(import: java/io/File
@@ -313,26 +288,24 @@
(implementation: #export default
(Shell IO)
- (def: execute
- (..can_execute
- (function (_ [environment working_directory command arguments])
- (do {! (try.with io.monad)}
- [#let [builder (|> (list& command arguments)
- ..jvm::arguments_array
- java/lang/ProcessBuilder::new
- (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)))]
- _ (|> builder
- java/lang/ProcessBuilder::environment
- (\ try.functor map (..jvm::load_environment environment))
- (\ io.monad wrap))
- process (java/lang/ProcessBuilder::start builder)]
- (..default_process process))))))
+ (def: (execute [environment working_directory command arguments])
+ (do {! (try.with io.monad)}
+ [#let [builder (|> (list& command arguments)
+ ..jvm::arguments_array
+ java/lang/ProcessBuilder::new
+ (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)))]
+ _ (|> builder
+ java/lang/ProcessBuilder::environment
+ (\ try.functor map (..jvm::load_environment environment))
+ (\ io.monad wrap))
+ process (java/lang/ProcessBuilder::start builder)]
+ (..default_process process))))
)]
(for {@.old (as_is <jvm>)
@.jvm (as_is <jvm>)}
(as_is)))
-(interface: #export (Simulation s)
+(interface: #export (Mock s)
(: (-> s (Try [s Text]))
on_read)
(: (-> s (Try [s Text]))
@@ -344,65 +317,57 @@
(: (-> s (Try [s Exit]))
on_await))
-(`` (implementation: (mock_process simulation state)
- (All [s] (-> (Simulation s) (Atom s) (Process IO)))
-
- (~~ (template [<name> <capability> <simulation>]
- [(def: <name>
- (<capability>
- (function (_ _)
- (do {! io.monad}
- [|state| (atom.read state)]
- (case (\ simulation <simulation> |state|)
- (#try.Success [|state| output])
- (do !
- [_ (atom.write |state| state)]
- (wrap (#try.Success output)))
-
- (#try.Failure error)
- (wrap (#try.Failure error)))))))]
-
- [read ..can_read on_read]
- [error ..can_read on_error]
- [await ..can_wait on_await]
+(`` (implementation: (mock_process mock state)
+ (All [s] (-> (Mock s) (Atom s) (Process IO)))
+
+ (~~ (template [<name> <mock>]
+ [(def: (<name> _)
+ (do {! io.monad}
+ [|state| (atom.read state)]
+ (case (\ mock <mock> |state|)
+ (#try.Success [|state| output])
+ (do !
+ [_ (atom.write |state| state)]
+ (wrap (#try.Success output)))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error)))))]
+
+ [read on_read]
+ [error on_error]
+ [await on_await]
))
- (def: write
- (..can_write
- (function (_ message)
- (do {! io.monad}
- [|state| (atom.read state)]
- (case (\ simulation on_write message |state|)
- (#try.Success |state|)
- (do !
- [_ (atom.write |state| state)]
- (wrap (#try.Success [])))
-
- (#try.Failure error)
- (wrap (#try.Failure error)))))))
- (def: destroy
- (..can_destroy
- (function (_ _)
- (do {! io.monad}
- [|state| (atom.read state)]
- (case (\ simulation on_destroy |state|)
- (#try.Success |state|)
- (do !
- [_ (atom.write |state| state)]
- (wrap (#try.Success [])))
-
- (#try.Failure error)
- (wrap (#try.Failure error)))))))))
-
-(implementation: #export (mock simulation init)
+ (def: (write message)
+ (do {! io.monad}
+ [|state| (atom.read state)]
+ (case (\ mock on_write message |state|)
+ (#try.Success |state|)
+ (do !
+ [_ (atom.write |state| state)]
+ (wrap (#try.Success [])))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error)))))
+ (def: (destroy _)
+ (do {! io.monad}
+ [|state| (atom.read state)]
+ (case (\ mock on_destroy |state|)
+ (#try.Success |state|)
+ (do !
+ [_ (atom.write |state| state)]
+ (wrap (#try.Success [])))
+
+ (#try.Failure error)
+ (wrap (#try.Failure error)))))))
+
+(implementation: #export (mock mock init)
(All [s]
(-> (-> [Environment Path Command (List Argument)]
- (Try (Simulation s)))
+ (Try (Mock s)))
s
(Shell IO)))
- (def: execute
- (..can_execute
- (function (_ input)
- (io.io (do try.monad
- [simulation (simulation input)]
- (wrap (..mock_process simulation (atom.atom init)))))))))
+ (def: (execute input)
+ (io.io (do try.monad
+ [mock (mock input)]
+ (wrap (..mock_process mock (atom.atom init)))))))
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 2d873f8a8..772f57d88 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -11,8 +11,6 @@
["." exception (#+ exception:)]
[parser
[environment (#+ Environment)]]
- [security
- ["!" capability]]
[concurrency
["." promise (#+ Promise) ("#\." monad)]]]
[data
@@ -36,7 +34,10 @@
["." console (#+ Console)]
["." program (#+ Program)]
["." file (#+ Path)
- ["." watch]]]]
+ ["." watch]]
+ [net
+ ["." http #_
+ ["#" client]]]]]
["." / #_
["#" profile]
["#." action (#+ Action)]
@@ -65,7 +66,7 @@
(-> /.Profile (List (Repository Promise)))
(|>> (get@ #/.repositories)
set.to_list
- (list\map (|>> (/repository/remote.repository #.None) /repository.async))))
+ (list\map (|>> (/repository/remote.repository http.default #.None) /repository.async))))
(def: (with_dependencies program console command profile)
(All [a]
@@ -155,7 +156,7 @@
(dictionary.get repository (get@ #/.deploy_repositories profile))]
[(#.Some artifact) (#.Some repository)]
(/command/deploy.do! console
- (/repository.async (/repository/remote.repository (#.Some identity) repository))
+ (/repository.async (/repository/remote.repository http.default (#.Some identity) repository))
(file.async file.default)
artifact
profile)
diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux
index f74d3069a..5f3d95631 100644
--- a/stdlib/source/program/aedifex/command/auto.lux
+++ b/stdlib/source/program/aedifex/command/auto.lux
@@ -5,9 +5,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
[collection
["." list]
@@ -29,14 +27,14 @@
(def: (targets fs path)
(-> (file.System Promise) Path (Promise (List Path)))
(do {! promise.monad}
- [?root (!.use (\ fs directory) [path])]
+ [?root (\ fs directory [path])]
(case ?root
(#try.Success root)
(loop [root root]
(do !
[subs (\ ! map (|>> (try.default (list)))
- (!.use (\ root directories) []))]
- (\ ! map (|>> list.concat (list& (!.use (\ root scope) [])))
+ (\ root directories []))]
+ (\ ! map (|>> list.concat (list& (\ root scope)))
(monad.map ! recur subs))))
(#try.Failure error)
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 6d61475d0..572ebf0f0 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -7,9 +7,7 @@
["." exception (#+ exception:)]
["." io (#+ IO)]
[concurrency
- ["." promise (#+ Promise) ("#\." monad)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise) ("#\." monad)]]]
[data
["." product]
["." maybe]
@@ -140,7 +138,7 @@
(let [[read! write!] (: [(Promise (Try Any))
(promise.Resolver (Try Any))]
(promise.promise []))
- _ (|> (!.use (\ process <capability>) [])
+ _ (|> (\ process <capability> [])
(promise.await (function (recur ?line)
(case ?line
(#try.Failure error)
@@ -156,7 +154,7 @@
(#try.Success _)
(promise.await recur
- (!.use (\ process <capability>) []))))
+ (\ process <capability> []))))
(console.write_line line console)))))
io.run)]
read!))]
@@ -188,19 +186,18 @@
/ (\ fs separator)
cache_directory (format working_directory / target)]
_ (console.write_line ..start console)
- process (!.use (\ shell execute)
- [environment
- working_directory
- command
- (list.concat (list compiler_params
- (list "build")
- (..plural "--library" (..libraries fs home resolution))
- (..plural "--source" (set.to_list (get@ #///.sources profile)))
- (..singular "--target" cache_directory)
- (..singular "--module" program_module)))])
+ process (\ shell execute [environment
+ working_directory
+ command
+ (list.concat (list compiler_params
+ (list "build")
+ (..plural "--library" (..libraries fs home resolution))
+ (..plural "--source" (set.to_list (get@ #///.sources profile)))
+ (..singular "--target" cache_directory)
+ (..singular "--module" program_module)))])
_ (..log_output! console process)
_ (..log_error! console process)
- exit (!.use (\ process await) [])
+ exit (\ process await [])
_ (console.write_line (if (i.= shell.normal exit)
..success
..failure)
diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux
index b966fe85e..142451113 100644
--- a/stdlib/source/program/aedifex/command/clean.lux
+++ b/stdlib/source/program/aedifex/command/clean.lux
@@ -5,8 +5,6 @@
[control
["." try (#+ Try)]
["." exception]
- [security
- ["!" capability]]
[concurrency
["." promise (#+ Promise)]]]
[data
@@ -24,9 +22,9 @@
(-> (Directory Promise) (Promise (Try Any)))
(do {! ///action.monad}
[nodes (: (Promise (Try (List (File Promise))))
- (!.use (\ root files) []))
+ (\ root files []))
_ (monad.map ! (function (_ node)
- (!.use (\ node delete) []))
+ (\ node delete []))
nodes)]
(wrap [])))
@@ -39,7 +37,7 @@
(do promise.monad
[#let [target (get@ #///.target profile)]
root (: (Promise (Try (Directory Promise)))
- (!.use (\ fs directory) target))]
+ (\ fs directory target))]
(case root
(#try.Success root)
(do {! ///action.monad}
@@ -47,9 +45,9 @@
(do !
[_ (..clean_files! root)
subs (: (Promise (Try (List (Directory Promise))))
- (!.use (\ root directories) []))
+ (\ root directories []))
_ (monad.map ! recur subs)]
- (!.use (\ root discard) [])))]
+ (\ root discard [])))]
(console.write_line (..success target) console))
(#try.Failure error)
diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux
index 2e5ce6d89..4b6b96e3e 100644
--- a/stdlib/source/program/aedifex/command/install.lux
+++ b/stdlib/source/program/aedifex/command/install.lux
@@ -6,9 +6,7 @@
["." try (#+ Try)]
["." exception]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
[binary (#+ Binary)]
[text
diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux
index 16d036718..b8a728904 100644
--- a/stdlib/source/program/aedifex/command/pom.lux
+++ b/stdlib/source/program/aedifex/command/pom.lux
@@ -4,8 +4,6 @@
[monad (#+ do)]]
[control
["." try (#+ Try)]
- [security
- ["!" capability]]
[concurrency
["." promise (#+ Promise) ("#\." monad)]]]
[data
@@ -37,6 +35,6 @@
outcome (|> pom
(\ xml.codec encode)
(\ utf8.codec encode)
- (!.use (\ file over_write)))
+ (\ file over_write))
_ (console.write_line ..success console)]
(wrap ///pom.file)))
diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux
index f3ab6c12a..e8b5a2a23 100644
--- a/stdlib/source/program/aedifex/command/test.lux
+++ b/stdlib/source/program/aedifex/command/test.lux
@@ -4,9 +4,7 @@
[monad (#+ do)]]
[control
[concurrency
- ["." promise (#+ Promise) ("#\." monad)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise) ("#\." monad)]]]
[data
[text
["%" format (#+ format)]]]
@@ -44,14 +42,13 @@
#let [[compiler_command compiler_parameters] (case compiler
(#//build.JVM artifact) (///runtime.java program)
(#//build.JS artifact) (///runtime.node program))]
- process (!.use (\ shell execute)
- [environment
- working_directory
- compiler_command
- compiler_parameters])
+ process (\ shell execute [environment
+ working_directory
+ compiler_command
+ compiler_parameters])
_ (//build.log_output! console process)
_ (//build.log_error! console process)
- exit (!.use (\ process await) [])
+ exit (\ process await [])
_ (console.write_line (if (i.= shell.normal exit)
..success
..failure)
diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux
index 0fdf7956f..edfa3142b 100644
--- a/stdlib/source/program/aedifex/dependency/deployment.lux
+++ b/stdlib/source/program/aedifex/dependency/deployment.lux
@@ -6,9 +6,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
[binary (#+ Binary)]
["." product]
@@ -19,17 +17,12 @@
[collection
["." dictionary]
["." set (#+ Set)]
- ["." list ("#\." monoid)]]
- [format
- ["." xml]]]
+ ["." list ("#\." monoid)]]]
[time
- ["." instant (#+ Instant)]]
- [world
- [program (#+ Program)]
- ["." file (#+ Path File Directory)]]]
+ ["." instant (#+ Instant)]]]
["." /// #_
- ["#" local]
- ["#." hash (#+ Hash SHA-1 MD5)]
+ [repository (#+ Repository)]
+ ["#." hash (#+ Hash)]
["#." package (#+ Package)]
["#." artifact (#+ Artifact)
["#/." time]
@@ -37,16 +30,14 @@
["#/." extension (#+ Extension)]
["#/." versioning]
["#/." snapshot
- ["#/." version (#+ Version)
+ ["#/." version
["#/." value]]]]
- ["#." metadata
+ ["#." metadata #_
["#/." artifact]
["#/." snapshot (#+ Metadata)]]
["#." dependency (#+ Dependency)
[resolution (#+ Resolution)]
- ["#/." status (#+ Status)]]
- ["#." repository (#+ Repository)
- ["#/." origin]]])
+ ["#/." status (#+ Status)]]])
(def: (with_status repository version_template [artifact type] [data status])
(-> (Repository Promise) ///artifact.Version Dependency [Binary Status] (Promise (Try Any)))
@@ -150,8 +141,7 @@
(def: #export (all repository resolution)
(-> (Repository Promise) Resolution (Promise (Try (Set Artifact))))
- (do {! (try.with promise.monad)}
- []
+ (let [! (try.with promise.monad)]
(|> (dictionary.entries resolution)
(monad.map ! (function (_ [dependency package])
(..one repository dependency package)))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 2d92e1438..138ee31bf 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -33,7 +33,9 @@
["." i64]]]
[world
[net (#+ URL)
- ["." uri]]]]
+ ["." uri]
+ ["." http #_
+ ["#" client]]]]]
["." // (#+ Dependency)
["#." status (#+ Status)]
["/#" // #_
@@ -214,7 +216,7 @@
///package.repositories
(try\map set.to_list)
(try.default (list))
- (list\map (|>> (///repository/remote.repository #.None)
+ (list\map (|>> (///repository/remote.repository http.default #.None)
///repository.async))
(list\compose repositories))]
[successes failures resolution] (recur sub_repositories
diff --git a/stdlib/source/program/aedifex/dependency/status.lux b/stdlib/source/program/aedifex/dependency/status.lux
index 8c4db9ddd..f501ebc8b 100644
--- a/stdlib/source/program/aedifex/dependency/status.lux
+++ b/stdlib/source/program/aedifex/dependency/status.lux
@@ -27,12 +27,10 @@
..any_equivalence
($_ sum.equivalence
///hash.equivalence
- ///hash.equivalence
- )
+ ///hash.equivalence)
($_ product.equivalence
///hash.equivalence
- ///hash.equivalence
- )
+ ///hash.equivalence)
))
(def: #export (verified payload)
diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux
index b00829469..2e7dbbab6 100644
--- a/stdlib/source/program/aedifex/input.lux
+++ b/stdlib/source/program/aedifex/input.lux
@@ -6,9 +6,7 @@
[pipe (#+ do>)]
["." try (#+ Try)]
[parser
- ["<c>" code]]
- [security
- ["!" capability]]]
+ ["<.>" code]]]
[data
[binary (#+ Binary)]
["." text
@@ -46,13 +44,13 @@
(|>> (do> try.monad
[(\ utf8.codec decode)]
[..parse_lux]
- [(list) (<c>.run //parser.project)])))
+ [(list) (<code>.run //parser.project)])))
(def: #export (read monad fs profile)
(All [!] (-> (Monad !) (file.System !) Text (! (Try Profile))))
(do (try.with monad)
- [project_file (!.use (\ fs file) //project.file)
- project_file (!.use (\ project_file content) [])]
+ [project_file (\ fs file //project.file)
+ project_file (\ project_file content [])]
(\ monad wrap
(|> project_file
(do> try.monad
diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux
index 08dab9ed3..86981eb62 100644
--- a/stdlib/source/program/aedifex/metadata.lux
+++ b/stdlib/source/program/aedifex/metadata.lux
@@ -1,12 +1,34 @@
(.module:
[lux #*
+ [data
+ [text
+ ["%" format (#+ format)]]]
[world
- [file (#+ Path)]]])
+ [file (#+ Path)]
+ [net
+ ["." uri (#+ URI)]]]]
+ ["." // #_
+ ["#." artifact (#+ Artifact)]])
(def: #export remote_file
Path
"maven-metadata.xml")
+(def: #export (remote_artifact_uri artifact)
+ (-> Artifact URI)
+ (let [/ uri.separator]
+ (format (get@ #//artifact.group artifact)
+ / (get@ #//artifact.name artifact)
+ / (get@ #//artifact.version artifact)
+ / ..remote_file)))
+
+(def: #export (remote_project_uri artifact)
+ (-> Artifact URI)
+ (let [/ uri.separator]
+ (format (get@ #//artifact.group artifact)
+ / (get@ #//artifact.name artifact)
+ / ..remote_file)))
+
(def: #export local_file
Path
"maven-metadata-local.xml")
diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux
index f871954c3..acfa7bd62 100644
--- a/stdlib/source/program/aedifex/package.lux
+++ b/stdlib/source/program/aedifex/package.lux
@@ -19,7 +19,7 @@
[set (#+ Set)]]]]
["." // #_
["/" profile]
- ["#." hash (#+ Hash SHA-1 MD5)]
+ ["#." hash]
["#." pom]
[dependency (#+ Dependency)
["#." status (#+ Status)]]
@@ -49,10 +49,14 @@
(def: #export (local pom library)
(-> XML Binary Package)
{#origin (#//origin.Local "")
- #library [library #//status.Unverified]
- #pom [pom
- (|> pom (\ xml.codec encode) (\ utf8.codec encode))
- #//status.Unverified]})
+ #library [library
+ (#//status.Verified (//hash.sha-1 library)
+ (//hash.md5 library))]
+ #pom (let [binary_pom (|> pom (\ xml.codec encode) (\ utf8.codec encode))]
+ [pom
+ binary_pom
+ (#//status.Verified (//hash.sha-1 binary_pom)
+ (//hash.md5 binary_pom))])})
(def: #export dependencies
(-> Package (Try (Set Dependency)))
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux
index c5f822633..d966c7f82 100644
--- a/stdlib/source/program/aedifex/repository.lux
+++ b/stdlib/source/program/aedifex/repository.lux
@@ -30,21 +30,21 @@
(promise.future (\ repository upload uri content)))
))
-(interface: #export (Simulation s)
+(interface: #export (Mock s)
(: (-> URI s (Try [s Binary]))
on_download)
(: (-> URI Binary s (Try s))
on_upload))
-(def: #export (mock simulation init)
- (All [s] (-> (Simulation s) s (Repository Promise)))
+(def: #export (mock mock init)
+ (All [s] (-> (Mock s) s (Repository Promise)))
(let [state (stm.var init)]
(implementation
(def: (download uri)
(stm.commit
(do {! stm.monad}
[|state| (stm.read state)]
- (case (\ simulation on_download uri |state|)
+ (case (\ mock on_download uri |state|)
(#try.Success [|state| output])
(do !
[_ (stm.write |state| state)]
@@ -57,7 +57,7 @@
(stm.commit
(do {! stm.monad}
[|state| (stm.read state)]
- (case (\ simulation on_upload uri content |state|)
+ (case (\ mock on_upload uri content |state|)
(#try.Success |state|)
(do !
[_ (stm.write |state| state)]
diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux
index 2841bbd32..8ceaf5ffc 100644
--- a/stdlib/source/program/aedifex/repository/local.lux
+++ b/stdlib/source/program/aedifex/repository/local.lux
@@ -6,9 +6,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." text
["%" format (#+ format)]]]
@@ -46,7 +44,7 @@
(: (Promise (Try (File Promise)))
(file.get_file promise.monad system absolute_path)))
(: (Promise (Try (File Promise)))
- (!.use (\ system file) absolute_path)))))
+ (\ system file absolute_path)))))
(implementation: #export (repository program system)
(-> (Program Promise) (file.System Promise) (//.Repository Promise))
@@ -54,9 +52,9 @@
(def: (download uri)
(do {! (try.with promise.monad)}
[file (..file program system false uri)]
- (!.use (\ file content) [])))
+ (\ file content [])))
(def: (upload uri content)
(do {! (try.with promise.monad)}
[file (..file program system true uri)]
- (!.use (\ file over_write) [content]))))
+ (\ file over_write content))))
diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux
index dcf1e1d51..50115f123 100644
--- a/stdlib/source/program/aedifex/repository/remote.lux
+++ b/stdlib/source/program/aedifex/repository/remote.lux
@@ -1,19 +1,15 @@
(.module:
[lux #*
- [ffi (#+ import:)]
[abstract
[monad (#+ do)]]
[control
["." io (#+ IO)]
- ["." try]
+ ["." try (#+ Try)]
["." exception (#+ exception:)]]
[data
- ["." binary]
- ["." text
+ ["." product]
+ [text
["%" format (#+ format)]]]
- [math
- [number
- ["n" nat]]]
[tool
[compiler
["." version]
@@ -22,7 +18,11 @@
["#" version]]]]]
[world
[net (#+ URL)
- [uri (#+ URI)]]]]
+ [uri (#+ URI)]
+ ["." http #_
+ ["#" client]
+ ["#/." status]
+ ["@#" /]]]]]
["." //
["#." identity (#+ Identity)]
["/#" // #_
@@ -32,108 +32,64 @@
(type: #export Address
URL)
-(import: java/lang/String)
+(template [<name>]
+ [(exception: #export (<name> {url URL} {status Nat})
+ (exception.report
+ ["URL" (%.text url)]
+ ["Status Code" (%.nat status)]))]
-(import: java/lang/AutoCloseable
- ["#::."
- (close [] #io #try void)])
-
-(import: java/io/InputStream)
-
-(import: java/io/OutputStream
- ["#::."
- (flush [] #io #try void)
- (write [[byte]] #io #try void)])
-
-(import: java/net/URLConnection
- ["#::."
- (setDoOutput [boolean] #io #try void)
- (setRequestProperty [java/lang/String java/lang/String] #io #try void)
- (getInputStream [] #io #try java/io/InputStream)
- (getOutputStream [] #io #try java/io/OutputStream)])
-
-(import: java/net/HttpURLConnection
- ["#::."
- (setRequestMethod [java/lang/String] #io #try void)
- (getResponseCode [] #io #try int)])
-
-(import: java/net/URL
- ["#::."
- (new [java/lang/String])
- (openConnection [] #io #try java/net/URLConnection)])
-
-(import: java/io/BufferedInputStream
- ["#::."
- (new [java/io/InputStream])
- (read [[byte] int int] #io #try int)])
-
-(exception: #export (no_credentials {address Address})
- (exception.report
- ["Address" (%.text address)]))
-
-(exception: #export (deployment_failure {code Int})
- (exception.report
- ["Code" (%.int code)]))
+ [download_failure]
+ [upload_failure]
+ )
(def: #export (uri version_template artifact extension)
(-> Version Artifact Extension URI)
(format (///artifact.uri version_template artifact) extension))
-(def: buffer_size
- (n.* 1,024 1,024))
-
-(def: user_agent
+(def: #export user_agent
(format "LuxAedifex/" (version.format language/lux.version)))
-(implementation: #export (repository identity address)
- (All [s] (-> (Maybe Identity) Address (//.Repository IO)))
+(def: base_headers
+ (List [Text Text])
+ (list ["User-Agent" ..user_agent]))
+
+(implementation: #export (repository http identity address)
+ (All [s] (-> (http.Client IO) (Maybe Identity) Address (//.Repository IO)))
(def: (download uri)
(do {! (try.with io.monad)}
- [connection (|> (format address uri)
- java/net/URL::new
- java/net/URL::openConnection)
- #let [connection (:coerce java/net/HttpURLConnection connection)]
- _ (java/net/HttpURLConnection::setRequestMethod "GET" connection)
- _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user_agent connection)
- input (|> connection
- java/net/URLConnection::getInputStream
- (\ ! map (|>> java/io/BufferedInputStream::new)))
- #let [buffer (binary.create ..buffer_size)]]
- (loop [output (\ binary.monoid identity)]
+ [[status message] (: (IO (Try (@http.Response IO)))
+ (http.get (format address uri)
+ (http.headers ..base_headers)
+ #.None
+ http))]
+ (case status
+ (^ (static http/status.ok))
+ (\ ! map product.right ((get@ #@http.body message) #.None))
+
+ _
(do !
- [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)]
- (case bytes_read
- -1 (do !
- [_ (java/lang/AutoCloseable::close input)]
- (wrap output))
- +0 (recur output)
- _ (if (n.= ..buffer_size bytes_read)
- (recur (\ binary.monoid compose output buffer))
- (do !
- [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes_read) buffer))]
- (recur (\ binary.monoid compose output chunk)))))))))
+ [_ ((get@ #@http.body message) (#.Some 0))]
+ (\ io.monad wrap (exception.throw ..download_failure [(format address uri) status]))))))
(def: (upload uri content)
- (case identity
- #.None
- (\ io.monad wrap (exception.throw ..no_credentials [address]))
-
- (#.Some [user password])
- (do (try.with io.monad)
- [connection (|> (format address uri)
- java/net/URL::new
- java/net/URL::openConnection)
- #let [connection (:coerce java/net/HttpURLConnection connection)]
- _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection)
- _ (java/net/URLConnection::setDoOutput true connection)
- _ (java/net/URLConnection::setRequestProperty "Authorization" (//identity.basic_auth user password) connection)
- stream (java/net/URLConnection::getOutputStream connection)
- _ (java/io/OutputStream::write content stream)
- _ (java/io/OutputStream::flush stream)
- _ (java/lang/AutoCloseable::close stream)
- code (java/net/HttpURLConnection::getResponseCode connection)]
- (case code
- +201 (wrap [])
- _ (\ io.monad wrap (exception.throw ..deployment_failure [code]))))))
+ (do (try.with io.monad)
+ [[status message] (: (IO (Try (@http.Response IO)))
+ (http.put (format address uri)
+ (http.headers (case identity
+ #.None
+ ..base_headers
+
+ (#.Some [user password])
+ (list& ["Authorization" (//identity.basic_auth user password)]
+ ..base_headers)))
+ (#.Some content)
+ http))
+ _ ((get@ #@http.body message) (#.Some 0))]
+ (case status
+ (^ (static http/status.created))
+ (wrap [])
+
+ _
+ (\ io.monad wrap (exception.throw ..upload_failure [(format address uri) status])))))
)
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 557e9d22a..f443301db 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -8,8 +8,6 @@
[control
["." io (#+ IO io)]
["." try (#+ Try)]
- [security
- ["!" capability]]
[concurrency
["." promise (#+ Promise) ("#\." monad)]]]
[data
@@ -97,14 +95,14 @@
(! (Try (File !)))
(:assume (file.get_file monad file_system package)))]
- (!.use (\ (:share [!]
- (Monad !)
- monad
-
- (File !)
- (:assume package))
- over_write)
- [content]))
+ (\ (:share [!]
+ (Monad !)
+ monad
+
+ (File !)
+ (:assume package))
+ over_write
+ content))
(#try.Failure error)
(\ monad wrap (#try.Failure error)))}
@@ -118,7 +116,7 @@
(do (try.with monad)
[package (: (Promise (Try (File Promise)))
(file.get_file monad file_system package))]
- (!.use (\ (: (File Promise) package) over_write) [content]))
+ (\ (: (File Promise) package) over_write content))
(#try.Failure error)
(\ monad wrap (#try.Failure error))))))))
diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux
index 2c764aff9..238034534 100644
--- a/stdlib/source/program/compositor/export.lux
+++ b/stdlib/source/program/compositor/export.lux
@@ -5,9 +5,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." text
["%" format (#+ format)]]
@@ -72,4 +70,4 @@
(format target (\ system separator) ..file)))]
(|> tar
(binary.run tar.writer)
- (!.use (\ package over_write)))))
+ (\ package over_write))))
diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux
index 7b4a9262e..19a2d7607 100644
--- a/stdlib/source/program/compositor/import.lux
+++ b/stdlib/source/program/compositor/import.lux
@@ -7,8 +7,6 @@
["." exception (#+ exception:)]
[concurrency
["." promise (#+ Promise) ("#\." monad)]]
- [security
- ["!" capability]]
["<>" parser
["<b>" binary]]]
[data
@@ -47,8 +45,8 @@
(-> (file.System Promise) Library Import (Action Import))
(do (try.with promise.monad)
[file (: (Action (File Promise))
- (!.use (\ system file) [library]))
- binary (!.use (\ file content) [])]
+ (\ system file library))
+ binary (\ file content [])]
(promise\wrap
(do {! try.monad}
[tar (<b>.run tar.parser binary)]
diff --git a/stdlib/source/spec/lux/world/console.lux b/stdlib/source/spec/lux/world/console.lux
index 5bfcf1ff8..7dedd72cb 100644
--- a/stdlib/source/spec/lux/world/console.lux
+++ b/stdlib/source/spec/lux/world/console.lux
@@ -6,8 +6,6 @@
[control
[io (#+ IO)]
["." try]
- [security
- ["!" capability]]
[concurrency
["." promise (#+ Promise)]]]
[data
@@ -20,36 +18,40 @@
(def: #export (spec console)
(-> (IO (/.Console Promise)) Test)
- (<| (_.for [/.Console])
- (do {! random.monad}
- [message (random.ascii/alpha 10)]
- (wrap (do promise.monad
- [console (promise.future console)
- ?write (!.use (\ console write) [(format message text.new_line)])
- ?read (!.use (\ console read) [])
- ?read_line (!.use (\ console read_line) [])
- ?close/good (!.use (\ console close) [])
- ?close/bad (!.use (\ console close) [])]
- ($_ _.and'
- (_.cover' [/.Can_Write]
- (case ?write
- (#try.Success _)
- true
-
- _
- false))
- (_.cover' [/.Can_Read]
- (case [?read ?read_line]
- [(#try.Success _) (#try.Success _)]
- true
+ (do random.monad
+ [message (random.ascii/alpha 10)]
+ (wrap (do promise.monad
+ [console (promise.future console)
+ ?write (\ console write (format message text.new_line))
+ ?read (\ console read [])
+ ?read_line (\ console read_line [])
+ ?close/good (\ console close [])
+ ?close/bad (\ console close [])
- _
- false))
- (_.cover' [/.Can_Close]
- (case [?close/good ?close/bad]
- [(#try.Success _) (#try.Failure _)]
- true
-
- _
- false))
- ))))))
+ #let [can_write!
+ (case ?write
+ (#try.Success _)
+ true
+
+ _
+ false)
+
+ can_read!
+ (case [?read ?read_line]
+ [(#try.Success _) (#try.Success _)]
+ true
+
+ _
+ false)
+
+ can_close!
+ (case [?close/good ?close/bad]
+ [(#try.Success _) (#try.Failure _)]
+ true
+
+ _
+ false)]]
+ (_.cover' [/.Console]
+ (and can_write!
+ can_read!
+ can_close!))))))
diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux
index 15e3012d0..8ff65a2c7 100644
--- a/stdlib/source/spec/lux/world/shell.lux
+++ b/stdlib/source/spec/lux/world/shell.lux
@@ -4,11 +4,9 @@
[abstract
[monad (#+ do)]]
[control
- ["." try]
- [security
- ["!" capability]]
+ ["." try ("#\." functor)]
[concurrency
- ["." promise (#+ Promise)]]
+ ["." promise (#+ Promise) ("#\." monad)]]
[parser
["." environment (#+ Environment)]]]
[data
@@ -34,64 +32,59 @@
[sleep! "sleep" Nat %.nat]
)
-(def: (read_test expected process)
- (-> Text (/.Process Promise) _.Assertion)
- (do promise.monad
- [?read (!.use (\ process read) [])
- ?await (!.use (\ process await) [])]
- ($_ _.and'
- (_.cover' [/.Can_Read]
- (case ?read
- (#try.Success actual)
- (text\= expected actual)
-
- (#try.Failure error)
- false))
- (_.cover' [/.Can_Wait /.Exit /.normal]
- (case ?await
- (#try.Success exit)
- (i.= /.normal exit)
-
- (#try.Failure error)
- false))
- )))
-
-(def: (destroy_test process)
+(def: (can_wait! process)
(-> (/.Process Promise) _.Assertion)
+ (|> (\ process await [])
+ (promise\map (|>> (try\map (i.= /.normal))
+ (try.default false)
+ (_.cover' [/.Exit /.normal])))
+ promise\join))
+
+(def: (can_read! expected process)
+ (-> Text (/.Process Promise) (Promise Bit))
+ (|> (\ process read [])
+ (promise\map (|>> (try\map (text\= expected))
+ (try.default false)))))
+
+(def: (can_destroy! process)
+ (-> (/.Process Promise) (Promise Bit))
(do promise.monad
- [?destroy (!.use (\ process destroy) [])
- ?await (!.use (\ process await) [])]
- (_.cover' [/.Can_Destroy]
- (and (case ?destroy
- (#try.Success _)
- true
-
- (#try.Failure error)
- false)
- (case ?await
- (#try.Success _)
- false
-
- (#try.Failure error)
- true)))))
+ [?destroy (\ process destroy [])
+ ?await (\ process await [])]
+ (wrap (and (case ?destroy
+ (#try.Success _)
+ true
+
+ (#try.Failure error)
+ false)
+ (case ?await
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ true)))))
-(with_expansions [<shell_coverage> (as_is [/.Can_Execute /.Command /.Argument])]
+(with_expansions [<shell_coverage> (as_is [/.Command /.Argument])]
(def: #export (spec shell)
(-> (/.Shell Promise) Test)
(<| (_.for [/.Shell /.Process])
(do {! random.monad}
[message (random.ascii/alpha 10)
seconds (\ ! map (|>> (n.% 5) (n.+ 5)) random.nat)]
- (wrap (do promise.monad
- [?echo (!.use (\ shell execute) (..echo! message))
- ?sleep (!.use (\ shell execute) (..sleep! seconds))]
+ (wrap (do {! promise.monad}
+ [?echo (\ shell execute (..echo! message))
+ ?sleep (\ shell execute (..sleep! seconds))]
(case [?echo ?sleep]
[(#try.Success echo) (#try.Success sleep)]
- ($_ _.and'
- (_.cover' <shell_coverage>
- true)
- (..read_test message echo)
- (..destroy_test sleep))
+ (do !
+ [can_read! (..can_read! message echo)
+ can_destroy! (..can_destroy! sleep)]
+ ($_ _.and'
+ (_.cover' <shell_coverage>
+ (and can_read!
+ can_destroy!))
+ (..can_wait! echo)
+ ))
_
(_.cover' <shell_coverage>
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index e3c2bd1eb..09ffcd3d8 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -9,6 +9,7 @@
["#." cli]
["#." command]
["#." dependency
+ ["#/." deployment]
["#/." resolution]
["#/." status]]
["#." hash]
@@ -27,6 +28,7 @@
Test
($_ _.and
/dependency.test
+ /dependency/deployment.test
/dependency/resolution.test
/dependency/status.test
))
diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux
index 7ef74d2c0..0808c7d21 100644
--- a/stdlib/source/test/aedifex/command/auto.lux
+++ b/stdlib/source/test/aedifex/command/auto.lux
@@ -9,9 +9,7 @@
["." environment (#+ Environment)]]
[concurrency
["." atom (#+ Atom)]
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." text
["%" format (#+ format)]
@@ -62,7 +60,7 @@
(if (n.= expected_runs actual_runs)
(wrap (#try.Failure end_signal))
(do (try.with !)
- [_ (!.use (\ dummy_file over_write) (\ utf8.codec encode (%.nat actual_runs)))]
+ [_ (\ dummy_file over_write (\ utf8.codec encode (%.nat actual_runs)))]
(do !
[_ (promise.future (atom.write actual_runs @runs))]
(wrap (#try.Success [])))))))]))
@@ -99,8 +97,8 @@
($_ _.and
(wrap (do promise.monad
[verdict (do ///action.monad
- [_ (!.use (\ fs create_directory) [source])
- dummy_file (!.use (\ fs create_file) [dummy_path])
+ [_ (\ fs create_directory source)
+ dummy_file (\ fs create_file dummy_path)
#let [[@runs command] (..command expected_runs end_signal dummy_file)]
_ (\ watcher poll [])]
(do promise.monad
diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux
index 0e86ef946..9d37ceb00 100644
--- a/stdlib/source/test/aedifex/command/build.lux
+++ b/stdlib/source/test/aedifex/command/build.lux
@@ -10,9 +10,7 @@
[concurrency
["." promise (#+ Promise)]]
[parser
- ["." environment]]
- [security
- ["!" capability]]]
+ ["." environment]]]
[data
["." text ("#\." equivalence)]
[collection
@@ -42,7 +40,7 @@
(shell.mock
(function (_ [actual_environment actual_working_directory actual_command actual_arguments])
(#try.Success
- (: (shell.Simulation [])
+ (: (shell.Mock [])
(implementation
(def: (on_read state)
(exception.throw shell.no_more_output []))
@@ -60,7 +58,7 @@
(shell.mock
(function (_ [actual_environment actual_working_directory actual_command actual_arguments])
(#try.Success
- (: (shell.Simulation [])
+ (: (shell.Mock [])
(implementation
(def: (on_read state)
(exception.throw shell.no_more_output []))
@@ -142,8 +140,8 @@
(wrap (do promise.monad
[verdict (do ///action.monad
[_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs shell resolution profile)
- start (!.use (\ console read_line) [])
- end (!.use (\ console read_line) [])]
+ start (\ console read_line [])
+ end (\ console read_line [])]
(wrap (and (text\= /.start start)
(text\= /.success end))))]
(_.cover' [/.do!
@@ -156,8 +154,8 @@
(wrap (do promise.monad
[verdict (do ///action.monad
[_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (..bad_shell [])) resolution profile)
- start (!.use (\ console read_line) [])
- end (!.use (\ console read_line) [])]
+ start (\ console read_line [])
+ end (\ console read_line [])]
(wrap (and (text\= /.start start)
(text\= /.failure end))))]
(_.cover' [/.failure]
diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux
index 705cca7f2..18997e02e 100644
--- a/stdlib/source/test/aedifex/command/clean.lux
+++ b/stdlib/source/test/aedifex/command/clean.lux
@@ -6,9 +6,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
[binary (#+ Binary)]
["." product]
@@ -55,7 +53,7 @@
(do {! (try.with promise.monad)}
[file (: (Promise (Try (File Promise)))
(file.get_file promise.monad fs path))]
- (!.use (\ file over_write) content)))
+ (\ file over_write content)))
(def: (create_directory! fs path files)
(-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any)))
@@ -111,7 +109,7 @@
context_exists!/post (..directory_exists? fs context)
target_exists!/post (..assets_exist? fs target_path direct_files)
sub_exists!/post (..assets_exist? fs sub_path sub_files)
- logging (!.use (\ console read_line) [])]
+ logging (\ console read_line [])]
(wrap (and (and context_exists!/pre
context_exists!/post)
(and target_exists!/pre
diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux
index 7e1bf166e..fd4395935 100644
--- a/stdlib/source/test/aedifex/command/deploy.lux
+++ b/stdlib/source/test/aedifex/command/deploy.lux
@@ -8,8 +8,6 @@
["." exception]
[concurrency
["." promise (#+ Promise)]]
- [security
- ["!" capability]]
[parser
["." environment (#+ Environment)]]]
[data
@@ -80,7 +78,7 @@
[#let [console (@version.echo "")]
_ (..make_sources! fs (get@ #///.sources profile))
_ (/.do! console repository fs artifact profile)]
- (!.use (\ console read_line) [])))
+ (\ console read_line [])))
(def: #export test
Test
@@ -96,7 +94,7 @@
home (random.ascii/alpha 5)
working_directory (random.ascii/alpha 5)
- #let [repository (///repository.mock @repository.simulation
+ #let [repository (///repository.mock @repository.mock
@repository.empty)
fs (file.mock (\ file.default separator))
program (program.async (program.mock environment.empty home working_directory))]]
diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux
index 2b4898dd3..ecb34437a 100644
--- a/stdlib/source/test/aedifex/command/deps.lux
+++ b/stdlib/source/test/aedifex/command/deps.lux
@@ -8,8 +8,6 @@
["." try]
[concurrency
["." promise]]
- [security
- ["!" capability]]
[parser
["." environment]]]
[data
diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux
index 8096fc2b2..bb52b3cca 100644
--- a/stdlib/source/test/aedifex/command/install.lux
+++ b/stdlib/source/test/aedifex/command/install.lux
@@ -8,8 +8,6 @@
["." exception]
[concurrency
["." promise (#+ Promise)]]
- [security
- ["!" capability]]
[parser
["." environment (#+ Environment)]]]
[data
@@ -70,7 +68,7 @@
[#let [console (@version.echo "")]
_ (..make_sources! fs (get@ #///.sources sample))
_ (/.do! console fs (///repository/local.repository program fs) sample)]
- (!.use (\ console read_line) [])))
+ (\ console read_line [])))
(def: #export test
Test
diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux
index f7f182225..0338bf7c4 100644
--- a/stdlib/source/test/aedifex/command/pom.lux
+++ b/stdlib/source/test/aedifex/command/pom.lux
@@ -6,9 +6,7 @@
[control
["." try (#+ Try) ("#\." functor)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." binary]
["." text ("#\." equivalence)
@@ -51,11 +49,11 @@
(\ ! wrap))
file (: (Promise (Try (File Promise)))
(file.get_file promise.monad fs path))
- actual (!.use (\ file content) [])
+ actual (\ file content [])
logging! (\ ///action.monad map
(text\= /.success)
- (!.use (\ console read_line) []))
+ (\ console read_line []))
#let [expected_path!
(text\= ///pom.file path)
diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux
index cad06aa69..47e2ed2b3 100644
--- a/stdlib/source/test/aedifex/command/test.lux
+++ b/stdlib/source/test/aedifex/command/test.lux
@@ -9,9 +9,7 @@
[concurrency
["." promise]]
[parser
- ["." environment]]
- [security
- ["!" capability]]]
+ ["." environment]]]
[data
["." text ("#\." equivalence)]
[collection
@@ -65,10 +63,10 @@
(wrap (do promise.monad
[verdict (do ///action.monad
[_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (@build.good_shell [])) resolution profile)
- build_start (!.use (\ console read_line) [])
- build_end (!.use (\ console read_line) [])
- test_start (!.use (\ console read_line) [])
- test_end (!.use (\ console read_line) [])]
+ build_start (\ console read_line [])
+ build_end (\ console read_line [])
+ test_start (\ console read_line [])
+ test_end (\ console read_line [])]
(wrap (and (and (text\= //build.start build_start)
(text\= //build.success build_end))
(and (text\= /.start test_start)
@@ -83,7 +81,7 @@
[#let [bad_shell (shell.mock
(function (_ [actual_environment actual_working_directory actual_command actual_arguments])
(#try.Success
- (: (shell.Simulation [])
+ (: (shell.Mock [])
(implementation
(def: (on_read state)
(exception.throw shell.no_more_output []))
@@ -99,10 +97,10 @@
shell.error)]))))))
[])]
_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async bad_shell) resolution profile)
- build_start (!.use (\ console read_line) [])
- build_end (!.use (\ console read_line) [])
- test_start (!.use (\ console read_line) [])
- test_end (!.use (\ console read_line) [])]
+ build_start (\ console read_line [])
+ build_end (\ console read_line [])
+ test_start (\ console read_line [])
+ test_end (\ console read_line [])]
(wrap (and (and (text\= //build.start build_start)
(text\= //build.success build_end))
(and (text\= /.start test_start)
diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux
index 079b0fde4..1bbb7f874 100644
--- a/stdlib/source/test/aedifex/command/version.lux
+++ b/stdlib/source/test/aedifex/command/version.lux
@@ -7,9 +7,7 @@
["." try]
["." exception (#+ exception:)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." maybe]
["." text ("#\." equivalence)
@@ -23,7 +21,7 @@
["#/." lux #_
["#" version]]]]]
[world
- ["." console (#+ Console Simulation)]]]
+ ["." console (#+ Console Mock)]]]
[///
["@." profile]]
{#program
@@ -31,8 +29,8 @@
(exception: #export console_is_closed!)
-(implementation: simulation
- (Simulation [Bit Text])
+(implementation: mock
+ (Mock [Bit Text])
(def: (on_read [open? state])
(if open?
@@ -61,7 +59,7 @@
(def: #export echo
(-> Text (Console Promise))
(|>> [true]
- (console.mock ..simulation)
+ (console.mock ..mock)
console.async))
(def: #export test
@@ -73,7 +71,7 @@
[#let [console (..echo "")]
verdict (do (try.with promise.monad)
[_ (/.do! console profile)
- logging (!.use (\ console read_line) [])]
+ logging (\ console read_line [])]
(wrap (text\= (version.format language/lux.version)
logging)))]
(_.cover' [/.do!]
diff --git a/stdlib/source/test/aedifex/dependency/deployment.lux b/stdlib/source/test/aedifex/dependency/deployment.lux
new file mode 100644
index 000000000..b947e609e
--- /dev/null
+++ b/stdlib/source/test/aedifex/dependency/deployment.lux
@@ -0,0 +1,203 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ ["." hash (#+ Hash)]]
+ [control
+ ["." io (#+ IO)]
+ ["." try ("#\." functor)]
+ [concurrency
+ ["." atom (#+ Atom)]
+ ["." promise]]]
+ [data
+ ["." product]
+ ["." maybe ("#\." functor)]
+ ["." binary (#+ Binary) ("#\." equivalence)]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." dictionary (#+ Dictionary)]
+ ["." set]
+ ["." list ("#\." fold)]]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["n" nat]]]
+ [world
+ [net (#+ URL)
+ ["." uri (#+ URI)]
+ ["." http #_
+ ["#" client]
+ ["#/." status]
+ ["@#" /]]]]]
+ ["$." //
+ ["#/" // #_
+ ["#." package]]]
+ {#program
+ ["." /
+ [// (#+ Dependency)
+ ["." resolution]
+ [//
+ ["." profile]
+ ["." metadata]
+ ["." package (#+ Package)]
+ ["." artifact (#+ Artifact) ("#\." equivalence)
+ ["#/." type]
+ ["#/." extension]]
+ ["." repository
+ ["." remote]]]]]})
+
+(def: good_upload
+ (@http.Response IO)
+ [http/status.created
+ {#@http.headers (http.headers (list))
+ #@http.body (function (_ _)
+ (|> [0 (binary.create 0)]
+ #try.Success
+ io.io))}])
+
+(type: Cache
+ (Atom (Dictionary URL Binary)))
+
+(def: (http cache)
+ (-> Cache (http.Client IO))
+ (implementation
+ (def: (request method url headers input)
+ (do io.monad
+ [_ (: (IO Any)
+ (case [method input]
+ [#@http.Put (#.Some input)]
+ (atom.update (dictionary.put url input) cache)
+
+ _
+ (wrap [])))]
+ (wrap (#try.Success ..good_upload))))))
+
+(def: (verify_one expected_deployments address package cache expected_artifact actual_artifact)
+ (-> Nat URL Package (Dictionary URL Binary) Artifact Artifact Bit)
+ (let [url (: (-> URI URL)
+ (|>> (format address)))
+ library_url (url (format (artifact.uri (get@ #artifact.version expected_artifact)
+ expected_artifact)
+ artifact/extension.lux_library))
+ pom_url (url (format (artifact.uri (get@ #artifact.version expected_artifact)
+ expected_artifact)
+ artifact/extension.pom))
+ artifact_metadata_url (url (metadata.remote_artifact_uri expected_artifact))
+ project_metadata_url (url (metadata.remote_project_uri expected_artifact))
+
+ expected_library (|> package
+ (get@ #package.library)
+ product.left)
+ expected_pom (|> package
+ (get@ #package.pom)
+ product.right
+ product.left)
+
+ correct_artifact!
+ (artifact\= expected_artifact actual_artifact)
+
+ expected_number_of_uploads!
+ (n.= (n.* expected_deployments 8)
+ (dictionary.size cache))
+
+ correct_library_upload!
+ (and (|> cache
+ (dictionary.get library_url)
+ (maybe\map (binary\= expected_library))
+ (maybe.default false))
+ (dictionary.key? cache (format library_url artifact/extension.sha-1))
+ (dictionary.key? cache (format library_url artifact/extension.md5)))
+
+ correct_pom_upload!
+ (and (|> cache
+ (dictionary.get pom_url)
+ (maybe\map (binary\= expected_pom))
+ (maybe.default false))
+ (dictionary.key? cache (format pom_url artifact/extension.sha-1))
+ (dictionary.key? cache (format pom_url artifact/extension.md5)))
+
+ artifact_metadata_upload!
+ (dictionary.key? cache artifact_metadata_url)
+
+ project_metadata_upload!
+ (dictionary.key? cache project_metadata_url)]
+ (and correct_artifact!
+ expected_number_of_uploads!
+ correct_library_upload!
+ correct_pom_upload!
+ artifact_metadata_upload!
+ project_metadata_upload!)))
+
+(def: bundle
+ (Random [Dependency Artifact Package])
+ (do random.monad
+ [[profile package] $///package.random
+ #let [artifact (|> profile
+ (get@ #profile.identity)
+ maybe.assume)
+ dependency (: Dependency
+ [artifact
+ artifact/type.lux_library])]]
+ (wrap [dependency artifact package])))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [address (\ ! map (text.suffix uri.separator)
+ (random.ascii/upper 10))]
+ ($_ _.and
+ (do {! random.monad}
+ [[dependency expected_artifact package] ..bundle
+ #let [cache (: Cache
+ (atom.atom (dictionary.new text.hash)))
+ http (..http cache)
+ repository (repository.async (remote.repository http #.None address))]]
+ (wrap (do promise.monad
+ [?outcome (/.one repository dependency package)
+ cache (promise.future (atom.read cache))]
+ (_.cover' [/.one]
+ (|> ?outcome
+ (try\map (verify_one 1 address package cache expected_artifact))
+ (try.default false))))))
+ (do {! random.monad}
+ [#let [hash (: (Hash [Dependency Artifact Package])
+ (\ hash.functor map (|>> product.right product.left product.left)
+ text.hash))]
+ num_bundles (\ ! map (n.% 10) random.nat)
+ bundles (|> ..bundle
+ (random.set hash num_bundles)
+ (\ ! map set.to_list))
+ #let [resolution (list\fold (function (_ [dependency expected_artifact package] resolution)
+ (dictionary.put dependency package resolution))
+ resolution.empty
+ bundles)
+ cache (: Cache
+ (atom.atom (dictionary.new text.hash)))
+ http (..http cache)
+ repository (repository.async (remote.repository http #.None address))]]
+ (wrap (do promise.monad
+ [?outcome (/.all repository resolution)
+ cache (promise.future (atom.read cache))]
+ (_.cover' [/.all]
+ (|> ?outcome
+ (try\map (function (_ actual_artifacts)
+ (let [expected_deployments!
+ (n.= num_bundles (set.size actual_artifacts))
+
+ every_deployment_was_correct!
+ (list.every? (function (_ [dependency expected_artifact package])
+ (let [deployed!
+ (set.member? actual_artifacts expected_artifact)
+
+ deployed_correctly!
+ (verify_one num_bundles address package cache expected_artifact expected_artifact)]
+ (and deployed!
+ deployed_correctly!)))
+ bundles)]
+ (and expected_deployments!
+ every_deployment_was_correct!))))
+ (try.default false))))))
+ ))))
diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux
index ebb32b790..7dcf46d3a 100644
--- a/stdlib/source/test/aedifex/dependency/resolution.lux
+++ b/stdlib/source/test/aedifex/dependency/resolution.lux
@@ -43,7 +43,7 @@
["#." artifact (#+ Artifact)
["#/." type]
["#/." extension]]
- ["#." repository (#+ Simulation)
+ ["#." repository (#+ Mock)
["#/." origin]]]]})
(def: random
@@ -56,43 +56,7 @@
package
/.empty))))
-(def: #export (single artifact package)
- (-> Artifact Package (Simulation Any))
- (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)]
- (implementation
- (def: (on_download uri state)
- (if (text.contains? expected uri)
- (cond (text.ends_with? ///artifact/extension.lux_library uri)
- (#try.Success [state (|> package
- (get@ #///package.library)
- product.left)])
-
- (text.ends_with? ///artifact/extension.pom uri)
- (#try.Success [state (|> package
- (get@ #///package.pom)
- product.left
- (\ xml.codec encode)
- (\ utf8.codec encode))])
-
- ## (text.ends_with? ///artifact/extension.sha-1 uri)
- ## (#try.Success [state (|> package
- ## (get@ #///package.sha-1)
- ## (\ ///hash.sha-1_codec encode)
- ## (\ utf8.codec encode))])
-
- ## (text.ends_with? ///artifact/extension.md5 uri)
- ## (#try.Success [state (|> package
- ## (get@ #///package.md5)
- ## (\ ///hash.md5_codec encode)
- ## (\ utf8.codec encode))])
-
- ## else
- (#try.Failure "NOPE"))
- (#try.Failure "NOPE")))
- (def: (on_upload uri binary state)
- (#try.Failure "NOPE")))))
-
-(def: lux_sha1
+(def: lux_sha-1
Text
(format ///artifact/extension.lux_library ///artifact/extension.sha-1))
@@ -100,7 +64,7 @@
Text
(format ///artifact/extension.lux_library ///artifact/extension.md5))
-(def: pom_sha1
+(def: pom_sha-1
Text
(format ///artifact/extension.pom ///artifact/extension.sha-1))
@@ -108,7 +72,7 @@
Text
(format ///artifact/extension.pom ///artifact/extension.md5))
-(def: sha1
+(def: sha-1
(-> Binary Binary)
(|>> ///hash.sha-1
(\ ///hash.sha-1_codec encode)
@@ -120,8 +84,48 @@
(\ ///hash.md5_codec encode)
(\ utf8.codec encode)))
+(def: #export (single artifact package)
+ (-> Artifact Package (Mock Any))
+ (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)]
+ (implementation
+ (def: (on_download uri state)
+ (if (text.contains? expected uri)
+ (let [library (: Binary
+ (|> package
+ (get@ #///package.library)
+ product.left))
+ pom (: Binary
+ (|> package
+ (get@ #///package.pom)
+ product.left
+ (\ xml.codec encode)
+ (\ utf8.codec encode)))]
+ (cond (text.ends_with? ///artifact/extension.lux_library uri)
+ (#try.Success [state library])
+
+ (text.ends_with? ..lux_sha-1 uri)
+ (#try.Success [state (..sha-1 library)])
+
+ (text.ends_with? ..lux_md5 uri)
+ (#try.Success [state (..md5 library)])
+
+ (text.ends_with? ///artifact/extension.pom uri)
+ (#try.Success [state pom])
+
+ (text.ends_with? ..pom_sha-1 uri)
+ (#try.Success [state (..sha-1 pom)])
+
+ (text.ends_with? ..pom_md5 uri)
+ (#try.Success [state (..md5 pom)])
+
+ ## else
+ (#try.Failure "NOPE")))
+ (#try.Failure "NOPE")))
+ (def: (on_upload uri binary state)
+ (#try.Failure "NOPE")))))
+
(def: (bad_sha-1 expected_artifact expected_package dummy_package)
- (-> Artifact Package Package (Simulation Any))
+ (-> Artifact Package Package (Mock Any))
(implementation
(def: (on_download uri state)
(if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
@@ -130,17 +134,17 @@
(get@ #///package.library)
product.left)])
- (text.ends_with? lux_sha1 uri)
+ (text.ends_with? ..lux_sha-1 uri)
(#try.Success [state (|> expected_package
(get@ #///package.library)
product.left
- sha1)])
+ ..sha-1)])
- (text.ends_with? lux_md5 uri)
+ (text.ends_with? ..lux_md5 uri)
(#try.Success [state (|> expected_package
(get@ #///package.library)
product.left
- md5)])
+ ..md5)])
(text.ends_with? ///artifact/extension.pom uri)
(#try.Success [state (|> expected_package
@@ -149,21 +153,21 @@
(\ xml.codec encode)
(\ utf8.codec encode))])
- (text.ends_with? pom_sha1 uri)
+ (text.ends_with? ..pom_sha-1 uri)
(#try.Success [state (|> dummy_package
(get@ #///package.pom)
product.left
(\ xml.codec encode)
(\ utf8.codec encode)
- sha1)])
+ ..sha-1)])
- (text.ends_with? pom_md5 uri)
+ (text.ends_with? ..pom_md5 uri)
(#try.Success [state (|> expected_package
(get@ #///package.pom)
product.left
(\ xml.codec encode)
(\ utf8.codec encode)
- md5)])
+ ..md5)])
## else
(#try.Failure "NOPE"))
@@ -172,7 +176,7 @@
(#try.Failure "NOPE"))))
(def: (bad_md5 expected_artifact expected_package dummy_package)
- (-> Artifact Package Package (Simulation Any))
+ (-> Artifact Package Package (Mock Any))
(implementation
(def: (on_download uri state)
(if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
@@ -181,17 +185,17 @@
(get@ #///package.library)
product.left)])
- (text.ends_with? lux_sha1 uri)
+ (text.ends_with? ..lux_sha-1 uri)
(#try.Success [state (|> expected_package
(get@ #///package.library)
product.left
- sha1)])
+ ..sha-1)])
- (text.ends_with? lux_md5 uri)
+ (text.ends_with? ..lux_md5 uri)
(#try.Success [state (|> dummy_package
(get@ #///package.library)
product.left
- md5)])
+ ..md5)])
(text.ends_with? ///artifact/extension.pom uri)
(#try.Success [state (|> expected_package
@@ -200,21 +204,21 @@
(\ xml.codec encode)
(\ utf8.codec encode))])
- (text.ends_with? pom_sha1 uri)
+ (text.ends_with? ..pom_sha-1 uri)
(#try.Success [state (|> expected_package
(get@ #///package.pom)
product.left
(\ xml.codec encode)
(\ utf8.codec encode)
- sha1)])
+ ..sha-1)])
- (text.ends_with? pom_md5 uri)
+ (text.ends_with? ..pom_md5 uri)
(#try.Success [state (|> dummy_package
(get@ #///package.pom)
product.left
(\ xml.codec encode)
(\ utf8.codec encode)
- md5)])
+ ..md5)])
## else
(#try.Failure "NOPE"))
diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux
index 86771cf1f..0241b27a9 100644
--- a/stdlib/source/test/aedifex/input.lux
+++ b/stdlib/source/test/aedifex/input.lux
@@ -6,9 +6,7 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]
- [security
- ["!" capability]]]
+ ["." promise (#+ Promise)]]]
[data
["." binary]
["." text
@@ -58,7 +56,7 @@
//format.profile
%.code
(\ utf8.codec encode)
- (!.use (\ file over_write)))
+ (\ file over_write))
actual (: (Promise (Try Profile))
(/.read promise.monad fs //.default))]
(wrap (\ //.equivalence =
diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux
index 132c51b38..56daf3cad 100644
--- a/stdlib/source/test/aedifex/package.lux
+++ b/stdlib/source/test/aedifex/package.lux
@@ -26,15 +26,16 @@
[world
["." file]]]
[//
- ["@." profile]
+ ["$." profile]
[//
[lux
[data
- ["_." binary]]]]]
+ ["$." binary]]]]]
{#program
["." /
["/#" // #_
["#" profile]
+ ["#." hash ("#\." equivalence)]
["#." pom]
[dependency
["#." status]]
@@ -45,13 +46,13 @@
(Random [//.Profile /.Package])
(do {! random.monad}
[content_size (\ ! map (n.% 100) random.nat)
- content (_binary.random content_size)
+ content ($binary.random content_size)
[profile pom] (random.one (function (_ profile)
(try.to_maybe
(do try.monad
[pom (//pom.write profile)]
(wrap [profile pom]))))
- @profile.random)]
+ $profile.random)]
(wrap [profile (/.local pom content)])))
(def: #export test
@@ -79,19 +80,31 @@
(and (case (get@ #/.origin local)
(#//origin.Local "") true
_ false)
- (and (is? expected_library actual_library)
- (case library_status
- #//status.Unverified true
- _ false))
- (and (is? expected_pom actual_pom)
- (|> (do try.monad
- [xml_pom (\ utf8.codec decode binary_pom)
- decoded_pom (\ xml.codec decode xml_pom)]
- (wrap (\ xml.equivalence = actual_pom decoded_pom)))
- (try.default false))
- (case pom_status
- #//status.Unverified true
- _ false)))))
+ (let [expected_sha1 (//hash.sha-1 expected_library)
+ expected_md5 (//hash.md5 expected_library)]
+ (and (is? expected_library actual_library)
+ (case library_status
+ (#//status.Verified actual_sha1 expected_md5)
+ (and (//hash\= expected_sha1 actual_sha1)
+ (//hash\= expected_md5 expected_md5))
+
+ _
+ false)))
+ (let [expected_sha1 (//hash.sha-1 binary_pom)
+ expected_md5 (//hash.md5 binary_pom)]
+ (and (is? expected_pom actual_pom)
+ (|> (do try.monad
+ [xml_pom (\ utf8.codec decode binary_pom)
+ decoded_pom (\ xml.codec decode xml_pom)]
+ (wrap (\ xml.equivalence = actual_pom decoded_pom)))
+ (try.default false))
+ (case pom_status
+ (#//status.Verified actual_sha1 expected_md5)
+ (and (//hash\= expected_sha1 actual_sha1)
+ (//hash\= expected_md5 expected_md5))
+
+ _
+ false))))))
(_.cover [/.dependencies]
(let [expected (get@ #//.dependencies profile)]
(case (/.dependencies package)
diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux
index ed32f0ac3..98d869b5b 100644
--- a/stdlib/source/test/aedifex/repository.lux
+++ b/stdlib/source/test/aedifex/repository.lux
@@ -24,13 +24,14 @@
["." / #_
["#." identity]
["#." origin]
+ ["#." remote]
[//
["@." artifact]]]
{#spec
["$." /]}
{#program
["." /
- ["#." remote]
+ ["." remote]
["/#" // #_
["#." artifact (#+ Version Artifact)
["#/." extension (#+ Extension)]]]]})
@@ -62,8 +63,8 @@
Version
"4.5.6-NO")
-(implementation: #export simulation
- (/.Simulation Store)
+(implementation: #export mock
+ (/.Mock Store)
(def: (on_download uri state)
(case (dictionary.get uri state)
@@ -83,18 +84,19 @@
Test
(<| (_.covering /._)
($_ _.and
- (_.for [/.mock /.Simulation]
+ (_.for [/.mock /.Mock]
(do random.monad
[_ (wrap [])]
($/.spec (..artifact ..valid_version)
(..artifact ..invalid_version)
- (/.mock ..simulation
+ (/.mock ..mock
(|> ..empty
- (dictionary.put (/remote.uri ..invalid_version
- (..artifact ..invalid_version)
- //artifact/extension.lux_library)
+ (dictionary.put (remote.uri ..invalid_version
+ (..artifact ..invalid_version)
+ //artifact/extension.lux_library)
(binary.create 0)))))))
/identity.test
/origin.test
+ /remote.test
)))
diff --git a/stdlib/source/test/aedifex/repository/remote.lux b/stdlib/source/test/aedifex/repository/remote.lux
new file mode 100644
index 000000000..f488391ce
--- /dev/null
+++ b/stdlib/source/test/aedifex/repository/remote.lux
@@ -0,0 +1,130 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io (#+ IO)]
+ ["." try ("#\." monad)]
+ ["." exception]
+ ["." function]]
+ [data
+ ["." binary ("#\." equivalence)]
+ ["." maybe ("#\." functor)]
+ ["." text ("#\." equivalence)
+ ["%" format (#+ format)]
+ [encoding
+ ["." utf8]]]
+ [collection
+ ["." dictionary]]]
+ [math
+ ["." random (#+ Random)]]
+ [world
+ [net (#+ URL)
+ ["." http #_
+ ["#" client]
+ ["#/." status]
+ ["@#" /]]]]]
+ {#program
+ ["." /
+ ["/#" // #_
+ ["#." identity]]]})
+
+(def: (url_body url)
+ (-> URL (@http.Body IO))
+ (let [url (\ utf8.codec encode url)]
+ (function (_ _)
+ (io.io (#try.Success [(binary.size url) url])))))
+
+(def: (good_http user password)
+ (-> //identity.User //identity.Password (http.Client IO))
+ (implementation
+ (def: (request method url headers input)
+ (with_expansions [<failure> [http/status.bad_request
+ {#@http.headers (http.headers (list))
+ #@http.body (..url_body "")}]]
+ (<| io.io
+ #try.Success
+ (if (|> headers
+ (dictionary.get "User-Agent")
+ (maybe\map (is? /.user_agent))
+ (maybe.default false))
+ (case [method input]
+ [#@http.Get #.None]
+ [http/status.ok
+ {#@http.headers (http.headers (list))
+ #@http.body (..url_body url)}]
+
+ [#@http.Put (#.Some input)]
+ (if (|> headers
+ (dictionary.get "Authorization")
+ (maybe\map (text\= (//identity.basic_auth user password)))
+ (maybe.default false))
+ [http/status.created
+ {#@http.headers (http.headers (list))
+ #@http.body (..url_body url)}]
+ <failure>)
+
+ _
+ <failure>)
+ <failure>))))))
+
+(def: bad_http
+ (http.Client IO)
+ (implementation
+ (def: (request method url headers input)
+ (<| io.io
+ #try.Success
+ [http/status.bad_request
+ {#@http.headers (http.headers (list))
+ #@http.body (..url_body "")}]))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [address (random.ascii/upper 10)
+ uri (random.ascii/lower 10)
+
+ user (random.ascii/lower 10)
+ password (random.ascii/lower 10)
+
+ content (\ ! map (\ utf8.codec encode)
+ (random.ascii/lower 10))]
+ ($_ _.and
+ (_.cover [/.repository /.user_agent /.Address]
+ (let [repo (/.repository (..good_http user password)
+ (#.Some {#//identity.user user
+ #//identity.password password})
+ address)]
+ (and (|> (\ repo download uri)
+ io.run
+ (try\map (\ utf8.codec decode))
+ try\join
+ (try\map (text\= (format address uri)))
+ (try.default false))
+ (|> (\ repo upload uri content)
+ io.run
+ (try\map (function.constant true))
+ (try.default false)))))
+ (_.cover [/.upload_failure]
+ (let [repo (/.repository (..good_http user password)
+ #.None
+ address)]
+ (case (io.run (\ repo upload uri content))
+ (#try.Failure error)
+ (exception.match? /.upload_failure error)
+
+ (#try.Success _)
+ false)))
+ (_.cover [/.download_failure]
+ (let [repo (/.repository ..bad_http
+ #.None
+ address)]
+ (case (io.run (\ repo download uri))
+ (#try.Failure error)
+ (exception.match? /.download_failure error)
+
+ (#try.Success _)
+ false)))
+ ))))
diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux
index c4c0657e7..ef0454553 100644
--- a/stdlib/source/test/lux/control/security/policy.lux
+++ b/stdlib/source/test/lux/control/security/policy.lux
@@ -9,9 +9,6 @@
["$." functor (#+ Injection Comparison)]
["$." apply]
["$." monad]]}]
- [control
- [security
- ["!" capability]]]
[data
["." text ("#\." equivalence)]]
[math
@@ -24,14 +21,14 @@
(def: (injection can_conceal)
(All [label]
(-> (Can_Conceal label) (Injection (All [value] (Private value label)))))
- (!.use can_conceal))
+ can_conceal)
(def: (comparison can_reveal)
(All [label]
(-> (Can_Reveal label) (Comparison (All [value] (Private value label)))))
(function (_ == left right)
- (== (!.use can_reveal left)
- (!.use can_reveal right))))
+ (== (can_reveal left)
+ (can_reveal right))))
(type: Password (Private Text))
@@ -56,14 +53,14 @@
(def: &equivalence
(implementation
(def: (= reference sample)
- (text\= (!.use %\can_downgrade reference)
- (!.use %\can_downgrade sample)))))
+ (text\= (%\can_downgrade reference)
+ (%\can_downgrade sample)))))
(def: hash
- (|>> (!.use %\can_downgrade)
+ (|>> %\can_downgrade
(\ text.hash hash)))))
(def: password
- (!.use %\can_upgrade))
+ %\can_upgrade)
(def: privilege
privilege))))))
diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux
index 47e4ceb27..c5ea26a6f 100644
--- a/stdlib/source/test/lux/world.lux
+++ b/stdlib/source/test/lux/world.lux
@@ -13,7 +13,8 @@
["#/." resolution]]]
["#." net #_
["#/." http #_
- ["#/." client]]]])
+ ["#/." client]
+ ["#/." status]]]])
(def: #export test
Test
@@ -25,4 +26,5 @@
/input/keyboard.test
/output/video/resolution.test
/net/http/client.test
+ /net/http/status.test
))
diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux
index 56e3902f0..b196199fc 100644
--- a/stdlib/source/test/lux/world/console.lux
+++ b/stdlib/source/test/lux/world/console.lux
@@ -6,9 +6,7 @@
[control
["." io]
["." try (#+ Try)]
- ["." exception (#+ exception:)]
- [security
- ["!" capability]]]
+ ["." exception (#+ exception:)]]
[data
["." text ("#\." equivalence)
["%" format (#+ format)]]]
@@ -21,8 +19,8 @@
(exception: dead)
-(def: simulation
- (/.Simulation [Bit Text])
+(def: mock
+ (/.Mock [Bit Text])
(implementation
(def: (on_read [dead? content])
(do try.monad
@@ -53,16 +51,16 @@
Test
(<| (_.covering /._)
($_ _.and
- (_.for [/.async /.mock /.Simulation]
- ($/.spec (io.io (/.async (/.mock ..simulation [false ""])))))
+ (_.for [/.async /.mock /.Mock]
+ ($/.spec (io.io (/.async (/.mock ..mock [false ""])))))
(do random.monad
[expected (random.ascii/alpha 10)
- #let [console (/.mock ..simulation [false ""])]]
+ #let [console (/.mock ..mock [false ""])]]
(_.cover [/.write_line]
(io.run
(do io.monad
[?_ (/.write_line expected console)
- ?actual (!.use (\ console read_line) [])]
+ ?actual (\ console read_line [])]
(wrap (<| (try.default false)
(do try.monad
[_ ?_
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index c7f546a1b..8a0c416be 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -7,9 +7,7 @@
["." io (#+ IO)]
["." try (#+ Try)]
[concurrency
- ["." promise]]
- [security
- ["!" capability]]]
+ ["." promise]]]
[data
["." binary (#+ Binary)]
["." text]
@@ -72,7 +70,7 @@
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
(do {! random.monad}
[file_size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10))))
dataL (_binary.random file_size)
diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux
index c0873b41a..9c1b31811 100644
--- a/stdlib/source/test/lux/world/file/watch.lux
+++ b/stdlib/source/test/lux/world/file/watch.lux
@@ -8,9 +8,7 @@
["." try]
["." exception]
[concurrency
- ["." promise]]
- [security
- ["!" capability]]]
+ ["." promise]]]
[data
["." binary ("#\." equivalence)]
["." text ("#\." equivalence)
@@ -106,12 +104,12 @@
data (_binary.random 10)]
(wrap (do {! promise.monad}
[verdict (do (try.with !)
- [_ (!.use (\ fs create_directory) [directory])
+ [_ (\ fs create_directory directory)
_ (\ watcher start /.all directory)
poll/0 (\ watcher poll [])
#let [no_events_prior_to_creation!
(list.empty? poll/0)]
- file (!.use (\ fs create_file) [expected_path])
+ file (\ fs create_file expected_path)
poll/1 (\ watcher poll [])
poll/1' (\ watcher poll [])
#let [after_creation!
@@ -126,7 +124,7 @@
false)
(list.empty? poll/1'))]
_ (promise.delay 1 (#try.Success "Delay to make sure the over_write time-stamp always changes."))
- _ (!.use (\ file over_write) data)
+ _ (\ file over_write data)
poll/2 (\ watcher poll [])
poll/2' (\ watcher poll [])
#let [after_modification!
@@ -140,7 +138,7 @@
_
false)
(list.empty? poll/2'))]
- _ (!.use (\ file delete) [])
+ _ (\ file delete [])
poll/3 (\ watcher poll [])
poll/3' (\ watcher poll [])
#let [after_deletion!
diff --git a/stdlib/source/test/lux/world/net/http/status.lux b/stdlib/source/test/lux/world/net/http/status.lux
new file mode 100644
index 000000000..801dc1b43
--- /dev/null
+++ b/stdlib/source/test/lux/world/net/http/status.lux
@@ -0,0 +1,119 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [data
+ [collection
+ ["." list]
+ ["." set (#+ Set)]]]
+ [macro
+ ["." template]]
+ [math
+ [number
+ ["n" nat]]]]
+ {1
+ ["." /
+ ["/#" //]]})
+
+(with_expansions [<categories> (as_is [informational
+ [/.continue
+ /.switching_protocols
+ /.processing
+ /.early_hints]]
+ [success
+ [/.ok
+ /.created
+ /.accepted
+ /.non_authoritative_information
+ /.no_content
+ /.reset_content
+ /.partial_content
+ /.multi_status
+ /.already_reported
+ /.im_used]]
+ [redirection
+ [/.multiple_choices
+ /.moved_permanently
+ /.found
+ /.see_other
+ /.not_modified
+ /.use_proxy
+ /.switch_proxy
+ /.temporary_redirect
+ /.permanent_redirect]]
+ [client
+ [/.bad_request
+ /.unauthorized
+ /.payment_required
+ /.forbidden
+ /.not_found
+ /.method_not_allowed
+ /.not_acceptable
+ /.proxy_authentication_required
+ /.request_timeout
+ /.conflict
+ /.gone
+ /.length_required
+ /.precondition_failed
+ /.payload_too_large
+ /.uri_too_long
+ /.unsupported_media_type
+ /.range_not_satisfiable
+ /.expectation_failed
+ /.im_a_teapot
+ /.misdirected_request
+ /.unprocessable_entity
+ /.locked
+ /.failed_dependency
+ /.upgrade_required
+ /.precondition_required
+ /.too_many_requests
+ /.request_header_fields_too_large
+ /.unavailable_for_legal_reasons]]
+ [server
+ [/.internal_server_error
+ /.not_implemented
+ /.bad_gateway
+ /.service_unavailable
+ /.gateway_timeout
+ /.http_version_not_supported
+ /.variant_also_negotiates
+ /.insufficient_storage
+ /.loop_detected
+ /.not_extended
+ /.network_authentication_required]])]
+ (def: all
+ (List //.Status)
+ (list.concat (`` (list (~~ (template [<category> <status+>]
+ [((: (-> Any (List //.Status))
+ (function (_ _)
+ (`` (list (~~ (template.splice <status+>))))))
+ 123)]
+
+ <categories>))))))
+
+ (def: unique
+ (Set //.Status)
+ (set.from_list n.hash ..all))
+
+ (def: verdict
+ (n.= (list.size ..all)
+ (set.size ..unique)))
+
+ (template [<category> <status+>]
+ [(def: <category>
+ Test
+ (_.cover <status+>
+ ..verdict))]
+
+ <categories>)
+
+ (def: #export test
+ Test
+ (<| (_.covering /._)
+ (`` ($_ _.and
+ (~~ (template [<category> <status+>]
+ [<category>]
+
+ <categories>))
+ ))))
+ )
diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux
index 334250a96..64fa47d28 100644
--- a/stdlib/source/test/lux/world/shell.lux
+++ b/stdlib/source/test/lux/world/shell.lux
@@ -1,7 +1,6 @@
(.module:
[lux #*
["_" test (#+ Test)]
- ["." debug]
[abstract
[monad (#+ do)]]
[control
@@ -10,8 +9,6 @@
["." io (#+ IO)]
[concurrency
["." promise (#+ Promise)]]
- [security
- ["!" capability]]
[parser
["." environment (#+ Environment)]]]
[data
@@ -32,9 +29,9 @@
(exception: dead)
-(def: (simulation [environment working_directory command arguments])
+(def: (mock [environment working_directory command arguments])
(-> [Environment Path /.Command (List /.Argument)]
- (/.Simulation Bit))
+ (/.Mock Bit))
(implementation
(def: (on_read dead?)
(if dead?
@@ -66,40 +63,28 @@
(def: (io_shell command oops input destruction exit)
(-> /.Command Text Text Text /.Exit (/.Shell IO))
(implementation
- (def: execute
- ((debug.private /.can_execute)
- (function (_ [environment working_directory command arguments])
- (io.io
- (#try.Success
- (: (/.Process IO)
- (implementation
- (def: read
- ((debug.private /.can_read)
- (function (_ _)
- (io.io (#try.Success command)))))
- (def: error
- ((debug.private /.can_read)
- (function (_ _)
- (io.io (#try.Success oops)))))
- (def: write
- ((debug.private /.can_write)
- (function (_ message)
- (io.io (#try.Failure message)))))
- (def: destroy
- ((debug.private /.can_destroy)
- (function (_ _)
- (io.io (#try.Failure destruction)))))
- (def: await
- ((debug.private /.can_wait)
- (function (_ _)
- (io.io (#try.Success exit))))))))))))))
+ (def: (execute [environment working_directory command arguments])
+ (<| io.io
+ #try.Success
+ (: (/.Process IO))
+ (implementation
+ (def: (read _)
+ (io.io (#try.Success command)))
+ (def: (error _)
+ (io.io (#try.Success oops)))
+ (def: (write message)
+ (io.io (#try.Failure message)))
+ (def: (destroy _)
+ (io.io (#try.Failure destruction)))
+ (def: (await _)
+ (io.io (#try.Success exit))))))))
(def: #export test
Test
(<| (_.covering /._)
($_ _.and
- (_.for [/.async /.mock /.Simulation]
- ($/.spec (/.async (/.mock (|>> ..simulation #try.Success)
+ (_.for [/.async /.mock /.Mock]
+ ($/.spec (/.async (/.mock (|>> ..mock #try.Success)
false))))
(_.cover [/.error]
(not (i.= /.normal /.error)))
@@ -112,11 +97,11 @@
#let [shell (/.async (..io_shell command oops input destruction exit))]]
(wrap (do {! promise.monad}
[verdict (do (try.with !)
- [process (!.use (\ shell execute) [environment.empty "~" command (list)])
- read (!.use (\ process read) [])
- error (!.use (\ process error) [])
+ [process (\ shell execute [environment.empty "~" command (list)])
+ read (\ process read [])
+ error (\ process error [])
wrote! (do !
- [write (!.use (\ process write) [input])]
+ [write (\ process write input)]
(wrap (#try.Success (case write
(#try.Success _)
false
@@ -124,19 +109,19 @@
(#try.Failure write)
(text\= input write)))))
destroyed! (do !
- [destroy (!.use (\ process destroy) [])]
+ [destroy (\ process destroy [])]
(wrap (#try.Success (case destroy
(#try.Success _)
false
(#try.Failure destroy)
(text\= destruction destroy)))))
- await (!.use (\ process await) [])]
+ await (\ process await [])]
(wrap (and (text\= command read)
(text\= oops error)
wrote!
destroyed!
(i.= exit await))))]
- (_.cover' [/.Can_Write]
+ (_.cover' [/.Shell]
(try.default false verdict)))))
)))