aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/world/shell.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/world/shell.lux237
1 files changed, 101 insertions, 136 deletions
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)))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-26 10:55:22 +0000