aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/spec
diff options
context:
space:
mode:
authorEduardo Julian2021-07-02 03:11:36 -0400
committerEduardo Julian2021-07-02 03:11:36 -0400
commit5cf4efa861075f8276f43a2516f5beacaf610b44 (patch)
treee21cf528d960c29d22cbc7e41180fa09e62f16d6 /stdlib/source/spec
parent744ee69630de59ca3ba660b0aab6361cd17ce1b4 (diff)
No longer employing the capabilities model on the lux/world/* modules.
Capabilities should be opt-in, but using them in the standard library makes them mandatory.
Diffstat (limited to '')
-rw-r--r--stdlib/source/spec/lux/world/console.lux70
-rw-r--r--stdlib/source/spec/lux/world/shell.lux95
2 files changed, 80 insertions, 85 deletions
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>