aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/world/net.lux14
-rw-r--r--stdlib/source/lux/world/net/tcp.jvm.lux70
-rw-r--r--stdlib/source/lux/world/net/udp.jvm.lux60
-rw-r--r--stdlib/source/test/lux.lux11
-rw-r--r--stdlib/source/test/lux/world.lux19
-rw-r--r--stdlib/source/test/lux/world/binary.lux87
-rw-r--r--stdlib/source/test/lux/world/file.lux318
-rw-r--r--stdlib/source/test/lux/world/net/tcp.lux104
-rw-r--r--stdlib/source/test/lux/world/net/udp.lux90
9 files changed, 409 insertions, 364 deletions
diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux
index a56c9c62e..ff753f527 100644
--- a/stdlib/source/lux/world/net.lux
+++ b/stdlib/source/lux/world/net.lux
@@ -4,7 +4,7 @@
[error (#+ Error)]]
[control
[security
- [capability (#+ Capability)]]]])
+ ["!" capability (#+ capability:)]]]])
(type: #export Address Text)
@@ -16,11 +16,11 @@
{#address Address
#port Port})
-(type: #export (Can-Read ! o)
- (Capability Nat (! (Error o))))
+(capability: #export (Can-Read ! o)
+ (can-read Nat (! (Error o))))
-(type: #export (Can-Write ! i)
- (Capability i (! (Error Any))))
+(capability: #export (Can-Write ! i)
+ (can-write i (! (Error Any))))
-(type: #export (Can-Close !)
- (Capability [] (! (Error Any))))
+(capability: #export (Can-Close !)
+ (can-close [] (! (Error Any))))
diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux
index 35b2e31f0..7ff25d6ee 100644
--- a/stdlib/source/lux/world/net/tcp.jvm.lux
+++ b/stdlib/source/lux/world/net/tcp.jvm.lux
@@ -3,8 +3,10 @@
[control
monad
[concurrency
- ["." promise (#+ Promise promise)]
- ["." frp]]]
+ ["." promise (#+ Promise Resolver)]
+ ["." frp (#+ Channel Sink)]]
+ [security
+ ["!" capability]]]
[data
["." error (#+ Error)]]
[world
@@ -53,10 +55,12 @@
(def: #export (async tcp)
(-> (TCP IO) (TCP Promise))
- (`` (structure (~~ (do-template [<capability>]
- [(def: <capability> (|>> (:: tcp <capability>) promise.future))]
+ (`` (structure (~~ (do-template [<capability> <forge>]
+ [(def: <capability> (<forge> (|>> (!.use (:: tcp <capability>)) promise.future)))]
- [read] [write] [close])))))
+ [read //.can-read]
+ [write //.can-write]
+ [close //.can-close])))))
(`` (for {(~~ (static host.jvm))
(as-is (def: (tcp socket)
@@ -65,24 +69,30 @@
[input (Socket::getInputStream socket)
output (Socket::getOutputStream socket)]
(wrap (: (TCP IO)
- (structure (def: (read size)
- (do (error.with io.monad)
- [#let [data (binary.create size)]
- bytes-read (InputStream::read data +0 (.int size) input)]
- (wrap [(.nat bytes-read)
- data])))
+ (structure (def: read
+ (//.can-read
+ (function (read size)
+ (do (error.with io.monad)
+ [#let [data (binary.create size)]
+ bytes-read (InputStream::read data +0 (.int size) input)]
+ (wrap [(.nat bytes-read)
+ data])))))
- (def: (write data)
- (do (error.with io.monad)
- [_ (OutputStream::write data +0 (.int (binary.size data))
- output)]
- (Flushable::flush output)))
-
- (def: (close _)
- (do (error.with io.monad)
- [_ (AutoCloseable::close input)
- _ (AutoCloseable::close output)]
- (AutoCloseable::close socket))))))))
+ (def: write
+ (//.can-write
+ (function (write data)
+ (do (error.with io.monad)
+ [_ (OutputStream::write data +0 (.int (binary.size data))
+ output)]
+ (Flushable::flush output)))))
+
+ (def: close
+ (//.can-close
+ (function (close _)
+ (do (error.with io.monad)
+ [_ (AutoCloseable::close input)
+ _ (AutoCloseable::close output)]
+ (AutoCloseable::close socket))))))))))
(def: #export (client address port)
(-> //.Address //.Port (IO (Error (TCP IO))))
@@ -91,17 +101,17 @@
(io.io (tcp socket))))
(def: #export (server port)
- (-> //.Port (IO (Error [(Promise Any)
- (frp.Channel (TCP IO))])))
+ (-> //.Port (IO (Error [(Resolver Any)
+ (Channel (TCP IO))])))
(do (error.with io.monad)
[server (ServerSocket::new (.int port))
- #let [close-signal (: (Promise Any)
- (promise #.None))
+ #let [[close-signal close-resolver] (: [(Promise Any) (Resolver Any)]
+ (promise.promise []))
_ (promise.await (function (_ _)
(AutoCloseable::close server))
close-signal)
- output (: (frp.Channel (TCP IO))
- (frp.channel []))
+ [output sink] (: [(Channel (TCP IO)) (Sink (TCP IO))]
+ (frp.channel []))
_ (: (Promise Any)
(promise.future
(loop [_ []]
@@ -115,6 +125,6 @@
(#error.Success client)
(do @
- [_ (frp.publish output client)]
+ [_ (:: sink feed client)]
(recur [])))))))]]
- (wrap [close-signal output]))))}))
+ (wrap [close-resolver output]))))}))
diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux
index 833b72e08..f7228aed3 100644
--- a/stdlib/source/lux/world/net/udp.jvm.lux
+++ b/stdlib/source/lux/world/net/udp.jvm.lux
@@ -4,7 +4,9 @@
monad
["ex" exception (#+ exception:)]
[concurrency
- ["." promise (#+ Promise)]]]
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
[data
["." error (#+ Error)]
["." maybe]
@@ -64,10 +66,12 @@
(def: #export (async udp)
(-> (UDP IO) (UDP Promise))
- (`` (structure (~~ (do-template [<name>]
- [(def: <name> (|>> (:: udp <name>) promise.future))]
+ (`` (structure (~~ (do-template [<name> <forge>]
+ [(def: <name> (<forge> (|>> (!.use (:: udp <name>)) promise.future)))]
- [read] [write] [close])))))
+ [read //.can-read]
+ [write //.can-write]
+ [close //.can-close])))))
(`` (for {(~~ (static host.jvm))
(as-is (def: (resolve address)
@@ -82,34 +86,40 @@
(def: (udp socket)
(-> DatagramSocket (UDP IO))
- (structure (def: (read size)
- (let [data (binary.create size)
- packet (DatagramPacket::new|receive data +0 (.int size))]
- (do (error.with io.monad)
- [_ (DatagramSocket::receive packet socket)
- #let [bytes-read (.nat (DatagramPacket::getLength packet))]]
- (wrap [bytes-read
- {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress)
- #//.port (.nat (DatagramPacket::getPort packet))}
- data]))))
-
- (def: (write [location data])
- (do (error.with io.monad)
- [address (resolve (get@ #//.address location))]
- (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location)))
- socket)))
-
- (def: (close _)
- (AutoCloseable::close socket))))
+ (structure (def: read
+ (//.can-read
+ (function (read size)
+ (let [data (binary.create size)
+ packet (DatagramPacket::new|receive data +0 (.int size))]
+ (do (error.with io.monad)
+ [_ (DatagramSocket::receive packet socket)
+ #let [bytes-read (.nat (DatagramPacket::getLength packet))]]
+ (wrap [bytes-read
+ {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress)
+ #//.port (.nat (DatagramPacket::getPort packet))}
+ data]))))))
+
+ (def: write
+ (//.can-write
+ (function (write [location data])
+ (do (error.with io.monad)
+ [address (resolve (get@ #//.address location))]
+ (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location)))
+ socket)))))
+
+ (def: close
+ (//.can-close
+ (function (close _)
+ (AutoCloseable::close socket))))))
(def: #export client
(IO (Error (UDP IO)))
(|> (DatagramSocket::new|client)
- (:: (error.with io.monad) map udp)))
+ (:: (error.with io.monad) map ..udp)))
(def: #export server
(-> //.Port (IO (Error (UDP IO))))
(|>> .int
DatagramSocket::new|server
- (:: (error.with io.monad) map udp)))
+ (:: (error.with io.monad) map ..udp)))
)}))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 191a664ce..d0dc4f257 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -119,6 +119,7 @@
["#." math]
["#." time]
["#." type]
+ ["#." world]
["#." host
["#/." jvm]]]
## [control
@@ -142,12 +143,6 @@
## ["_.S" structure]
## ["_.S" case]
## ["_.S" function]]]]]
- ## [world
- ## [binary (#+)]
- ## [file (#+)]
- ## [net
- ## [tcp (#+)]
- ## [udp (#+)]]]
))
(def: identity
@@ -372,8 +367,8 @@
/math.test)
(<| (_.context "/time")
/time.test)
- (<| (_.context "/type")
- /type.test)
+ /type.test
+ /world.test
(<| (_.context "/host Host-platform interoperation")
($_ _.and
/host.test
diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux
new file mode 100644
index 000000000..b23b29dbe
--- /dev/null
+++ b/stdlib/source/test/lux/world.lux
@@ -0,0 +1,19 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]]
+ ["." / #_
+ ["#." binary]
+ ["#." file]
+ ["#." net #_
+ ["#/." tcp]
+ ["#/." udp]]
+ ])
+
+(def: #export test
+ Test
+ ($_ _.and
+ /binary.test
+ /file.test
+ /net/tcp.test
+ /net/udp.test
+ ))
diff --git a/stdlib/source/test/lux/world/binary.lux b/stdlib/source/test/lux/world/binary.lux
index ec4da0d11..2f347c50d 100644
--- a/stdlib/source/test/lux/world/binary.lux
+++ b/stdlib/source/test/lux/world/binary.lux
@@ -1,22 +1,21 @@
(.module:
[lux #*
- [control
- ["." monad (#+ do)]]
+ data/text/format
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]
+ [control ["." monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." equivalence]]}]
[data
["." error (#+ Error)]
- ["." number
- ["." i64]]
+ [number
+ ["." i64]
+ ["." nat]]
[collection
- ["." list]]]
- [world
- ["/" binary]]
- [math
- ["r" random]]]
- lux/test
- [test
- [lux
- [control
- ["_eq" equivalence]]]])
+ ["." list]]]]
+ {1
+ ["." / (#+ Binary)]})
(def: (succeed result)
(-> (Error Bit) Bit)
@@ -28,7 +27,7 @@
output))
(def: #export (binary size)
- (-> Nat (r.Random /.Binary))
+ (-> Nat (Random Binary))
(let [output (/.create size)]
(loop [idx 0]
(if (n/< size idx)
@@ -39,7 +38,7 @@
(:: r.monad wrap output)))))
(def: (bits-io bytes read write value)
- (-> Nat (-> Nat /.Binary (Error Nat)) (-> Nat Nat /.Binary (Error Any)) Nat Bit)
+ (-> Nat (-> Nat Binary (Error Nat)) (-> Nat Nat Binary (Error Any)) Nat Bit)
(let [binary (/.create 8)
bits (n/* 8 bytes)
capped-value (|> 1 (i64.left-shift bits) dec (i64.and value))]
@@ -49,9 +48,10 @@
output (read 0 binary)]
(wrap (n/= capped-value output))))))
-(context: "Binary."
- (<| (times 100)
- (do @
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ (do r.monad
[#let [gen-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 8))))]
binary-size gen-size
random-binary (binary binary-size)
@@ -59,30 +59,29 @@
#let [gen-idx (|> r.nat (:: @ map (n/% binary-size)))]
[from to] (r.and gen-idx gen-idx)
#let [[from to] [(n/min from to) (n/max from to)]]]
- ($_ seq
- ## TODO: De-comment...
- ## (_eq.spec /.equivalence (:: @ map binary gen-size))
- (test "Can get size of binary."
- (|> random-binary /.size (n/= binary-size)))
- (test "Can read/write 8-bit values."
- (bits-io 1 /.read/8 /.write/8 value))
- (test "Can read/write 16-bit values."
- (bits-io 2 /.read/16 /.write/16 value))
- (test "Can read/write 32-bit values."
- (bits-io 4 /.read/32 /.write/32 value))
- (test "Can read/write 64-bit values."
- (bits-io 8 /.read/64 /.write/64 value))
- (test "Can slice binaries."
- (let [slice-size (|> to (n/- from) inc)
- random-slice (error.assume (/.slice from to random-binary))
- idxs (list.n/range 0 (dec slice-size))
- reader (function (_ binary idx) (/.read/8 idx binary))]
- (and (n/= slice-size (/.size random-slice))
- (case [(monad.map error.monad (reader random-slice) idxs)
- (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)]
- [(#error.Success slice-vals) (#error.Success binary-vals)]
- (:: (list.equivalence number.nat-equivalence) = slice-vals binary-vals)
+ ($_ _.and
+ ($equivalence.spec /.equivalence (binary binary-size))
+ (_.test "Can get size of binary."
+ (|> random-binary /.size (n/= binary-size)))
+ (_.test "Can read/write 8-bit values."
+ (bits-io 1 /.read/8 /.write/8 value))
+ (_.test "Can read/write 16-bit values."
+ (bits-io 2 /.read/16 /.write/16 value))
+ (_.test "Can read/write 32-bit values."
+ (bits-io 4 /.read/32 /.write/32 value))
+ (_.test "Can read/write 64-bit values."
+ (bits-io 8 /.read/64 /.write/64 value))
+ (_.test "Can slice binaries."
+ (let [slice-size (|> to (n/- from) inc)
+ random-slice (error.assume (/.slice from to random-binary))
+ idxs (list.n/range 0 (dec slice-size))
+ reader (function (_ binary idx) (/.read/8 idx binary))]
+ (and (n/= slice-size (/.size random-slice))
+ (case [(monad.map error.monad (reader random-slice) idxs)
+ (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)]
+ [(#error.Success slice-vals) (#error.Success binary-vals)]
+ (:: (list.equivalence nat.equivalence) = slice-vals binary-vals)
- _
- #0))))
+ _
+ #0))))
))))
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index deed8dbd2..e27add632 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -1,26 +1,29 @@
(.module:
[lux #*
- ["." io (#+ IO)]
+ data/text/format
+ ["r" math/random (#+ Random) ("#@." monad)]
+ ["_" test (#+ Test)]
[control
- [monad (#+ do)]]
- [concurrency
- ["." promise]]
+ ["." monad (#+ do)]
+ [concurrency
+ ["." promise]]
+ [security
+ ["!" capability]]]
+ ["." io (#+ IO)]
[data
["." error (#+ Error)]
- ["." number]
- ["." text
- format]
+ ["." text]
+ [number
+ ["." int]]
[collection
["." list]]]
[time
["." instant]
["." duration]]
[world
- ["@" file (#+ Path File)]
- ["." binary (#+ Binary)]]
- [math
- ["r" random ("#;." monad)]]]
- lux/test
+ ["." binary (#+ Binary)]]]
+ {1
+ ["." / (#+ Path File)]}
[//
["_." binary]])
@@ -30,163 +33,166 @@
(def: (creation-and-deletion number)
(-> Nat Test)
- (r;wrap (do promise.monad
+ (r@wrap (do promise.monad
[#let [path (format "temp_file_" (%n number))]
result (promise.future
- (do (error.ErrorT io.monad)
+ (do (error.with io.monad)
[#let [check-existence! (: (IO (Error Bit))
- (io.from-io (@.exists? io.monad @.system path)))]
+ (error.lift io.monad (/.exists? io.monad /.system path)))]
pre! check-existence!
- file (:: @.system create-file path)
+ file (!.use (:: /.system create-file) path)
post! check-existence!
- _ (:: file delete [])
+ _ (!.use (:: file delete) [])
remains? check-existence!]
(wrap (and (not pre!)
post!
(not remains?)))))]
- (assert "Can create/delete files."
- (error.default #0 result)))))
+ (_.assert "Can create/delete files."
+ (error.default #0 result)))))
(def: (read-and-write number data)
(-> Nat Binary Test)
- (r;wrap (do promise.monad
+ (r@wrap (do promise.monad
[#let [path (format "temp_file_" (%n number))]
result (promise.future
- (do (error.ErrorT io.monad)
- [file (:: @.system create-file path)
- _ (:: file over-write data)
- content (:: file content [])
- _ (:: file delete [])]
+ (do (error.with io.monad)
+ [file (!.use (:: /.system create-file) path)
+ _ (!.use (:: file over-write) data)
+ content (!.use (:: file content) [])
+ _ (!.use (:: file delete) [])]
(wrap (:: binary.equivalence = data content))))]
- (assert "Can write/read files."
- (error.default #0 result)))))
+ (_.assert "Can write/read files."
+ (error.default #0 result)))))
-(context: "File system."
- (do @
- [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
- dataL (_binary.binary file-size)
- dataR (_binary.binary file-size)
- new-modified (|> r.int (:: @ map (|>> (:: number.number abs)
- truncate-millis
- duration.from-millis
- instant.absolute)))]
- ($_ seq
- (creation-and-deletion 0)
- (read-and-write 1 dataL)
- (wrap (do promise.monad
- [#let [path "temp_file_2"]
- result (promise.future
- (do (error.ErrorT io.monad)
- [file (:: @.system create-file path)
- _ (:: file over-write dataL)
- read-size (:: file size [])
- _ (:: file delete [])]
- (wrap (n/= file-size read-size))))]
- (assert "Can read file size."
- (error.default #0 result))))
- (wrap (do promise.monad
- [#let [path "temp_file_3"]
- result (promise.future
- (do (error.ErrorT io.monad)
- [file (:: @.system create-file path)
- _ (:: file over-write dataL)
- _ (:: file append dataR)
- content (:: file content [])
- read-size (:: file size [])
- _ (:: file delete [])]
- (wrap (and (n/= (n/* 2 file-size) read-size)
- (:: binary.equivalence =
- dataL
- (error.assume (binary.slice 0 (dec file-size) content)))
- (:: binary.equivalence =
- dataR
- (error.assume (binary.slice file-size (dec read-size) content)))))))]
- (assert "Can append to files."
- (error.default #0 result))))
- (wrap (do promise.monad
- [#let [path "temp_dir_4"]
- result (promise.future
- (do (error.ErrorT io.monad)
- [#let [check-existence! (: (IO (Error Bit))
- (io.from-io (@.exists? io.monad @.system path)))]
- pre! check-existence!
- dir (:: @.system create-directory path)
- post! check-existence!
- _ (:: dir discard [])
- remains? check-existence!]
- (wrap (and (not pre!)
- post!
- (not remains?)))))]
- (assert "Can create/delete directories."
- (error.default #0 result))))
- (wrap (do promise.monad
- [#let [file-path "temp_file_5"
- dir-path "temp_dir_5"]
- result (promise.future
- (do (error.ErrorT io.monad)
- [dir (:: @.system create-directory dir-path)
- file (:: @.system create-file (format dir-path "/" file-path))
- _ (:: file over-write dataL)
- read-size (:: file size [])
- _ (:: file delete [])
- _ (:: dir discard [])]
- (wrap (n/= file-size read-size))))]
- (assert "Can create files inside of directories."
- (error.default #0 result))))
- (wrap (do promise.monad
- [#let [file-path "temp_file_6"
- dir-path "temp_dir_6"
- inner-dir-path "inner_temp_dir_6"]
- result (promise.future
- (do (error.ErrorT io.monad)
- [dir (:: @.system create-directory dir-path)
- pre-files (:: dir files [])
- pre-directories (:: dir directories [])
-
- file (:: @.system create-file (format dir-path "/" file-path))
- inner-dir (:: @.system create-directory (format dir-path "/" inner-dir-path))
- post-files (:: dir files [])
- post-directories (:: dir directories [])
-
- _ (:: file delete [])
- _ (:: inner-dir discard [])
- _ (:: dir discard [])]
- (wrap (and (and (n/= 0 (list.size pre-files))
- (n/= 0 (list.size pre-directories)))
- (and (n/= 1 (list.size post-files))
- (n/= 1 (list.size post-directories)))))))]
- (assert "Can list files/directories inside a directory."
- (error.default #0 result))))
- (wrap (do promise.monad
- [#let [path "temp_file_7"]
- result (promise.future
- (do (error.ErrorT io.monad)
- [file (:: @.system create-file path)
- _ (:: file over-write dataL)
- _ (:: file modify new-modified)
- old-modified (:: file last-modified [])
- _ (:: file delete [])]
- (wrap (:: instant.equivalence = new-modified old-modified))))]
- (assert "Can change the time of last modification."
- (error.default #0 result))))
- (wrap (do promise.monad
- [#let [path0 (format "temp_file_8+0")
- path1 (format "temp_file_8+1")]
- result (promise.future
- (do (error.ErrorT io.monad)
- [#let [check-existence! (: (-> Path (IO (Error Bit)))
- (|>> (@.exists? io.monad @.system) io.from-io))]
- file0 (:: @.system create-file path0)
- _ (:: file0 over-write dataL)
- pre! (check-existence! path0)
- file1 (: (IO (Error (File IO))) ## TODO: Remove :
- (:: file0 move path1))
- post! (check-existence! path0)
- confirmed? (check-existence! path1)
- _ (:: file1 delete [])]
- (wrap (and pre!
- (not post!)
- confirmed?))))]
- (assert "Can move a file from one path to another."
- (error.default #0 result))))
- )))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ (do r.monad
+ [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
+ dataL (_binary.binary file-size)
+ dataR (_binary.binary file-size)
+ new-modified (|> r.int (:: @ map (|>> (:: int.number abs)
+ truncate-millis
+ duration.from-millis
+ instant.absolute)))]
+ ($_ _.and
+ (creation-and-deletion 0)
+ (read-and-write 1 dataL)
+ (wrap (do promise.monad
+ [#let [path "temp_file_2"]
+ result (promise.future
+ (do (error.with io.monad)
+ [file (!.use (:: /.system create-file) path)
+ _ (!.use (:: file over-write) dataL)
+ read-size (!.use (:: file size) [])
+ _ (!.use (:: file delete) [])]
+ (wrap (n/= file-size read-size))))]
+ (_.assert "Can read file size."
+ (error.default #0 result))))
+ (wrap (do promise.monad
+ [#let [path "temp_file_3"]
+ result (promise.future
+ (do (error.with io.monad)
+ [file (!.use (:: /.system create-file) path)
+ _ (!.use (:: file over-write) dataL)
+ _ (!.use (:: file append) dataR)
+ content (!.use (:: file content) [])
+ read-size (!.use (:: file size) [])
+ _ (!.use (:: file delete) [])]
+ (wrap (and (n/= (n/* 2 file-size) read-size)
+ (:: binary.equivalence =
+ dataL
+ (error.assume (binary.slice 0 (dec file-size) content)))
+ (:: binary.equivalence =
+ dataR
+ (error.assume (binary.slice file-size (dec read-size) content)))))))]
+ (_.assert "Can append to files."
+ (error.default #0 result))))
+ (wrap (do promise.monad
+ [#let [path "temp_dir_4"]
+ result (promise.future
+ (do (error.with io.monad)
+ [#let [check-existence! (: (IO (Error Bit))
+ (error.lift io.monad (/.exists? io.monad /.system path)))]
+ pre! check-existence!
+ dir (!.use (:: /.system create-directory) path)
+ post! check-existence!
+ _ (!.use (:: dir discard) [])
+ remains? check-existence!]
+ (wrap (and (not pre!)
+ post!
+ (not remains?)))))]
+ (_.assert "Can create/delete directories."
+ (error.default #0 result))))
+ (wrap (do promise.monad
+ [#let [file-path "temp_file_5"
+ dir-path "temp_dir_5"]
+ result (promise.future
+ (do (error.with io.monad)
+ [dir (!.use (:: /.system create-directory) dir-path)
+ file (!.use (:: /.system create-file) (format dir-path "/" file-path))
+ _ (!.use (:: file over-write) dataL)
+ read-size (!.use (:: file size) [])
+ _ (!.use (:: file delete) [])
+ _ (!.use (:: dir discard) [])]
+ (wrap (n/= file-size read-size))))]
+ (_.assert "Can create files inside of directories."
+ (error.default #0 result))))
+ (wrap (do promise.monad
+ [#let [file-path "temp_file_6"
+ dir-path "temp_dir_6"
+ inner-dir-path "inner_temp_dir_6"]
+ result (promise.future
+ (do (error.with io.monad)
+ [dir (!.use (:: /.system create-directory) dir-path)
+ pre-files (!.use (:: dir files) [])
+ pre-directories (!.use (:: dir directories) [])
+
+ file (!.use (:: /.system create-file) (format dir-path "/" file-path))
+ inner-dir (!.use (:: /.system create-directory) (format dir-path "/" inner-dir-path))
+ post-files (!.use (:: dir files) [])
+ post-directories (!.use (:: dir directories) [])
+
+ _ (!.use (:: file delete) [])
+ _ (!.use (:: inner-dir discard) [])
+ _ (!.use (:: dir discard) [])]
+ (wrap (and (and (n/= 0 (list.size pre-files))
+ (n/= 0 (list.size pre-directories)))
+ (and (n/= 1 (list.size post-files))
+ (n/= 1 (list.size post-directories)))))))]
+ (_.assert "Can list files/directories inside a directory."
+ (error.default #0 result))))
+ (wrap (do promise.monad
+ [#let [path "temp_file_7"]
+ result (promise.future
+ (do (error.with io.monad)
+ [file (!.use (:: /.system create-file) path)
+ _ (!.use (:: file over-write) dataL)
+ _ (!.use (:: file modify) new-modified)
+ old-modified (!.use (:: file last-modified) [])
+ _ (!.use (:: file delete) [])]
+ (wrap (:: instant.equivalence = new-modified old-modified))))]
+ (_.assert "Can change the time of last modification."
+ (error.default #0 result))))
+ (wrap (do promise.monad
+ [#let [path0 (format "temp_file_8+0")
+ path1 (format "temp_file_8+1")]
+ result (promise.future
+ (do (error.with io.monad)
+ [#let [check-existence! (: (-> Path (IO (Error Bit)))
+ (|>> (/.exists? io.monad /.system)
+ (error.lift io.monad)))]
+ file0 (!.use (:: /.system create-file) path0)
+ _ (!.use (:: file0 over-write) dataL)
+ pre! (check-existence! path0)
+ file1 (: (IO (Error (File IO))) ## TODO: Remove :
+ (!.use (:: file0 move) path1))
+ post! (check-existence! path0)
+ confirmed? (check-existence! path1)
+ _ (!.use (:: file1 delete) [])]
+ (wrap (and pre!
+ (not post!)
+ confirmed?))))]
+ (_.assert "Can move a file from one path to another."
+ (error.default #0 result))))
+ ))))
diff --git a/stdlib/source/test/lux/world/net/tcp.lux b/stdlib/source/test/lux/world/net/tcp.lux
index 43a304a58..f7ec2eaef 100644
--- a/stdlib/source/test/lux/world/net/tcp.lux
+++ b/stdlib/source/test/lux/world/net/tcp.lux
@@ -1,25 +1,25 @@
(.module:
[lux #*
- ["." io]
+ data/text/format
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]
+ [control ["." monad (#+ do)]]
+ ["." io (#+ IO)]
[control
- [monad (#+ do)]
["ex" exception (#+ exception:)]
+ [concurrency
+ ["." promise (#+ Promise Resolver)]
+ ["." frp ("#@." functor)]]
[security
- ["." taint]]]
- [concurrency
- ["." promise (#+ Promise promise)]
- ["." frp ("#;." functor)]]
+ ["!" capability]]]
[data
- ["." error]
- ["." text
- format]]
+ ["." error (#+ Error)]
+ ["." text]]
[world
["." binary]
- ["." net
- ["@" tcp]]]
- [math
- ["r" random]]]
- lux/test
+ ["." net]]]
+ {1
+ ["." /]}
[///
["_." binary]])
@@ -32,40 +32,42 @@
(|>> (n/% 1000)
(n/+ 8000)))))
-(context: "TCP networking."
- (do @
- [port ..port
- size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
- from (_binary.binary size)
- to (_binary.binary size)]
- ($_ seq
- (wrap (do promise.monad
- [#let [from-worked? (: (Promise Bit)
- (promise #.Nil))]
- result (promise.future
- (do io.monad
- [[server-close server] (@.server port)
- #let [_ (frp;map (function (_ client)
- (promise.future
- (do @
- [[trasmission-size transmission] (:: client read size)
- #let [_ (io.run (promise.resolve (and (n/= size trasmission-size)
- (:: binary.equivalence = from (taint.trust transmission)))
- from-worked?))]]
- (:: client write to))))
- server)]
- client (@.client localhost port)
- _ (:: client write from)
- ####################
- [trasmission-size transmission] (:: client read size)
- #let [to-worked? (and (n/= size trasmission-size)
- (:: binary.equivalence = to (taint.trust transmission)))]
- ####################
- _ (:: client close [])
- _ (io.from-io (promise.resolve [] server-close))]
- (wrap to-worked?)))
- from-worked? from-worked?]
- (assert "Can communicate between client and server."
- (and from-worked?
- (error.default #0 result)))))
- )))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ (do r.monad
+ [port ..port
+ size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
+ from (_binary.binary size)
+ to (_binary.binary size)]
+ ($_ _.and
+ (wrap (do promise.monad
+ [#let [[from-worked? from-worked!] (: [(Promise Bit) (Resolver Bit)]
+ (promise.promise []))]
+ result (promise.future
+ (do (error.with io.monad)
+ [[close! server] (/.server port)
+ #let [_ (frp@map (function (_ client)
+ (promise.future
+ (do @
+ [[trasmission-size transmission] (!.use (:: client read) size)
+ #let [_ (io.run (from-worked! (and (n/= size trasmission-size)
+ (:: binary.equivalence = from transmission))))]]
+ (!.use (:: client write) to))))
+ server)]
+ client (/.client localhost port)
+ _ (!.use (:: client write) from)
+ ####################
+ [trasmission-size transmission] (!.use (:: client read) size)
+ #let [to-worked? (and (n/= size trasmission-size)
+ (:: binary.equivalence = to transmission))]
+ ####################
+ _ (!.use (:: client close) [])
+ _ (: (IO (Error Bit))
+ (error.lift io.monad (close! [])))]
+ (wrap to-worked?)))
+ from-worked? from-worked?]
+ (_.assert "Can communicate between client and server."
+ (and from-worked?
+ (error.default #0 result)))))
+ ))))
diff --git a/stdlib/source/test/lux/world/net/udp.lux b/stdlib/source/test/lux/world/net/udp.lux
index d3d2531f9..1740c861c 100644
--- a/stdlib/source/test/lux/world/net/udp.lux
+++ b/stdlib/source/test/lux/world/net/udp.lux
@@ -1,21 +1,23 @@
(.module:
[lux #*
+ data/text/format
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]
[control
- [monad (#+ do)]]
- [concurrency
- ["." promise]]
+ ["." monad (#+ do)]
+ [concurrency
+ ["." promise]]
+ [security
+ ["!" capability]]]
[data
["." error]
- ["." text
- format]]
+ ["." text]]
["." io]
[world
["." binary]
- ["." net
- ["@" udp]]]
- [math
- ["r" random]]]
- lux/test
+ ["." net]]]
+ {1
+ ["." /]}
[///
["_." binary]])
@@ -27,36 +29,38 @@
(|>> (n/% 1000)
(n/+ 8000)))))
-(context: "UDP networking."
- (do @
- [port ..port
- size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
- from (_binary.binary size)
- to (_binary.binary size)]
- ($_ seq
- (wrap (do promise.monad
- [result (promise.future
- (do io.monad
- [server (@.server port)
- client @.client
- ####################
- _ (:: client write [[localhost port] from])
- [bytes-from [from-address from-port] temp] (:: server read size)
- #let [from-worked? (and (n/= size bytes-from)
- (:: binary.equivalence = from temp))]
- ####################
- _ (:: server write [[from-address from-port] to])
- [bytes-to [to-address to-port] temp] (:: client read size)
- #let [to-worked? (and (n/= size bytes-to)
- (:: binary.equivalence = to temp)
- (n/= port to-port))]
- ####################
- _ (:: client close [])
- _ (:: server close [])]
- ## (wrap false)
- (wrap (and from-worked?
- to-worked?))
- ))]
- (assert "Can communicate between client and server."
- (error.default #0 result))))
- )))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ (do r.monad
+ [port ..port
+ size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
+ from (_binary.binary size)
+ to (_binary.binary size)]
+ ($_ _.and
+ (wrap (do promise.monad
+ [result (promise.future
+ (do (error.with io.monad)
+ [server (/.server port)
+ client /.client
+ ####################
+ _ (!.use (:: client write) [[localhost port] from])
+ [bytes-from [from-address from-port] temp] (!.use (:: server read) size)
+ #let [from-worked? (and (n/= size bytes-from)
+ (:: binary.equivalence = from temp))]
+ ####################
+ _ (!.use (:: server write) [[from-address from-port] to])
+ [bytes-to [to-address to-port] temp] (!.use (:: client read) size)
+ #let [to-worked? (and (n/= size bytes-to)
+ (:: binary.equivalence = to temp)
+ (n/= port to-port))]
+ ####################
+ _ (!.use (:: client close) [])
+ _ (!.use (:: server close) [])]
+ ## (wrap false)
+ (wrap (and from-worked?
+ to-worked?))
+ ))]
+ (_.assert "Can communicate between client and server."
+ (error.default #0 result))))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 01:11:22 +0000