aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/tool.lux2
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux48
-rw-r--r--stdlib/source/test/lux/world/file.lux252
-rw-r--r--stdlib/source/test/lux/world/net/http/client.lux142
4 files changed, 374 insertions, 70 deletions
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 99db7ef1a..6dc3eabd9 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -22,6 +22,7 @@
]]]
["[1][0]" meta "_"
["[1]/[0]" archive "_"
+ ["[1]/[0]" artifact]
["[1]/[0]" signature]
["[1]/[0]" key]
["[1]/[0]" document]]]
@@ -37,6 +38,7 @@
/analysis/simple.test
/analysis/composite.test
/analysis/pattern.test
+ /meta/archive/artifact.test
/meta/archive/signature.test
/meta/archive/key.test
/meta/archive/document.test
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux
new file mode 100644
index 000000000..b241b0c46
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux
@@ -0,0 +1,48 @@
+(.using
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [\\specification
+ ["$[0]" equivalence]]]
+ [math
+ ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]]
+ [\\library
+ ["[0]" /]])
+
+(def: random_category
+ (Random /.Category)
+ ($_ random.or
+ (random#in [])
+ (random.ascii/lower 1)
+ (random.ascii/lower 2)
+ (random.ascii/lower 3)
+ (random.ascii/lower 4)
+ (random.ascii/lower 5)
+ (random.ascii/lower 6)
+ ))
+
+(def: random_dependency
+ (Random /.Dependency)
+ ($_ random.and
+ random.nat
+ random.nat
+ ))
+
+(def: .public random
+ (Random /.Artifact)
+ ($_ random.and
+ random.nat
+ ..random_category
+ random.bit
+ (random.set /.dependency_hash 5 ..random_dependency)
+ ))
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Artifact /.ID])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+ )))
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index 39e8d13dd..ee313599f 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -1,19 +1,239 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" io]]
- [math
- ["[0]" random]]]]
- ["[0]" / "_"
- ["[1][0]" watch]]
- [\\library
- ["[0]" /]]
- [\\specification
- ["$[0]" /]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["[0]" io {"+" IO}]
+ ["[0]" try {"+" Try}]
+ [concurrency
+ [async {"+" Async}]
+ ["[0]" atom {"+" Atom}]]]
+ [data
+ ["[0]" binary {"+" Binary} ("[1]#[0]" monoid)]
+ ["[0]" text ("[1]#[0]" equivalence)]
+ [collection
+ ["[0]" dictionary {"+" Dictionary}]
+ ["[0]" list]]]
+ [math
+ ["[0]" random]]
+ [time
+ ["[0]" instant {"+" Instant}]]]]
+ ["[0]" / "_"
+ ["[1][0]" watch]]
+ [\\library
+ ["[0]" /]]
+ [\\specification
+ ["$[0]" /]])
+
+(type: Disk
+ (Dictionary /.Path (Either [Instant Binary] (List Text))))
+
+(def: (file? disk @)
+ (-> (Atom Disk) (-> /.Path (IO Bit)))
+ (do io.monad
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#None} false
+ {.#Some {.#Left _}} true
+ {.#Some {.#Right _}} false))))
+
+(def: (directory? disk @)
+ (-> (Atom Disk) (-> /.Path (IO Bit)))
+ (do io.monad
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#None} false
+ {.#Some {.#Left _}} false
+ {.#Some {.#Right _}} true))))
+
+(def: (alert_parent! disk alert @)
+ (-> (Atom Disk)
+ (-> (List /.Path) (List /.Path))
+ (-> /.Path (IO (Try Any))))
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Right siblings}}
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Right (alert siblings)} disk') disk)]
+ (in {try.#Success []}))
+
+ _
+ (in {try.#Failure ""}))))
+
+(def: (write fs disk it @)
+ (-> (/.System Async) (Atom Disk) (-> Binary /.Path (IO (Try Any))))
+ (do [! io.monad]
+ [now instant.now
+ disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ (^or {.#None}
+ {.#Some {.#Left _}})
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Left [now it]} disk') disk)]
+ (case (/.parent fs @)
+ {.#Some parent}
+ (alert_parent! disk (|>> (list& @)) parent)
+
+ {.#None}
+ (in {try.#Success []})))
+
+ _
+ (in {try.#Failure ""}))))
+
+(def: (read disk @)
+ (-> (Atom Disk) (-> /.Path (IO (Try Binary))))
+ (do io.monad
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#Some {.#Left [_ it]}}
+ {try.#Success it}
+
+ _
+ {try.#Failure ""}))))
+
+(def: (delete fs disk @)
+ (-> (/.System Async) (Atom Disk)
+ (-> /.Path (IO (Try Any))))
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Right children}}
+ (if (list.empty? children)
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.lacks @ disk') disk)]
+ (in {try.#Success []}))
+ (in {try.#Failure ""}))
+
+ {.#Some {.#Left [_ data]}}
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.lacks @ disk') disk)]
+ (case (/.parent fs @)
+ {.#Some parent}
+ (alert_parent! disk (list.only (|>> (text#= @) not)) parent)
+
+ {.#None}
+ (in {try.#Success []})))
+
+ _
+ (in {try.#Failure ""}))))
+
+(def: (fs /)
+ (-> Text (/.System IO))
+ (let [disk (: (Atom Disk)
+ (atom.atom (dictionary.empty text.hash)))
+ mock (/.mock /)]
+ (implementation
+ (def: separator /)
+
+ (def: file? (..file? disk))
+ (def: directory? (..directory? disk))
+ (def: write (..write mock disk))
+ (def: read (..read disk))
+ (def: delete (..delete mock disk))
+
+ (def: (file_size @)
+ (do [! io.monad]
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#Some {.#Left [_ it]}}
+ {try.#Success (binary.size it)}
+
+ _
+ {try.#Failure ""}))))
+ (def: (last_modified @)
+ (do [! io.monad]
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#Some {.#Left [it _]}}
+ {try.#Success it}
+
+ _
+ {try.#Failure ""}))))
+ (def: (can_execute? @)
+ (do [! io.monad]
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#Some {.#Left _}}
+ {try.#Success false}
+
+ _
+ {try.#Failure ""}))))
+
+ (def: (make_directory @)
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#None}
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Right (list)} disk') disk)]
+ (case (/.parent mock @)
+ {.#Some parent}
+ (alert_parent! disk (|>> (list& @)) parent)
+
+ {.#None}
+ (in {try.#Success []})))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (directory_files @)
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Right children}}
+ (|> children
+ (monad.only ! (..file? disk))
+ (# ! each (|>> {try.#Success})))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (sub_directories @)
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Right children}}
+ (|> children
+ (monad.only ! (..directory? disk))
+ (# ! each (|>> {try.#Success})))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (append it @)
+ (do [! io.monad]
+ [now instant.now
+ disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#None}
+ (..write mock disk it @)
+
+ {.#Some {.#Left [_ old]}}
+ (do !
+ [_ (atom.compare_and_swap! disk'
+ (dictionary.has @ {.#Left [now (binary#composite old it)]} disk')
+ disk)]
+ (in {try.#Success []}))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (modify it @)
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Left [_ data]}}
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Left [it data]} disk') disk)]
+ (in {try.#Success []}))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (move it @)
+ (do [! (try.with io.monad)]
+ [data (..read disk @)
+ write (..write mock disk data it)]
+ (..delete mock disk @)))
+ )))
(def: .public test
Test
@@ -23,6 +243,8 @@
($_ _.and
(_.for [/.mock]
($/.spec (io.io (/.mock /))))
+ (_.for [/.async]
+ ($/.spec (io.io (/.async (..fs /)))))
/watch.test
))))
diff --git a/stdlib/source/test/lux/world/net/http/client.lux b/stdlib/source/test/lux/world/net/http/client.lux
index 474d1ea08..fdc32834b 100644
--- a/stdlib/source/test/lux/world/net/http/client.lux
+++ b/stdlib/source/test/lux/world/net/http/client.lux
@@ -1,31 +1,55 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- [abstract
- [monad {"+" do}]]
- [control
- [pipe {"+" do>}]
- ["[0]" io {"+" IO}]
- ["[0]" try]
- ["[0]" function]]
- [data
- ["[0]" binary]
- ["[0]" product]
- ["[0]" text
- ["%" format {"+" format}]
- [encoding
- ["[0]" utf8]]]
- [collection
- ["[0]" dictionary]]]
- [math
- ["[0]" random {"+" Random}]
- [number
- ["[0]" nat]]]]]
- [\\library
- ["[0]" /
- ["/[1]" //
- ["[1][0]" status]]]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" Monad do}]]
+ [control
+ [pipe {"+" do>}]
+ ["[0]" io {"+" IO}]
+ ["[0]" try {"+" Try}]
+ ["[0]" function]
+ [concurrency
+ ["[0]" async ("[1]#[0]" functor)]]]
+ [data
+ ["[0]" binary]
+ ["[0]" product]
+ ["[0]" text
+ ["%" format {"+" format}]
+ [encoding
+ ["[0]" utf8]]]
+ [collection
+ ["[0]" dictionary]]]
+ [math
+ ["[0]" random {"+" Random}]
+ [number
+ ["[0]" nat]]]]]
+ [\\library
+ ["[0]" /
+ ["/[1]" //
+ ["[1][0]" status]]]])
+
+(def: (verification ! expected response)
+ (All (_ !)
+ (-> (Monad !) Nat (! (Try (//.Response !)))
+ (! Bit)))
+ (do !
+ [response response]
+ (case response
+ {try.#Success response}
+ (|> response
+ product.right
+ (value@ //.#body)
+ (function.on {.#None})
+ (# ! each (|>> (do> try.monad
+ []
+ [product.right (# utf8.codec decoded)]
+ [(# nat.decimal decoded)]
+ [(nat.= expected) in])
+ (try.else false))))
+
+ {try.#Failure error}
+ (in false))))
(def: .public test
Test
@@ -64,32 +88,40 @@
//.#body (function (_ ?wanted_bytes)
(io.io {try.#Success [(binary.size data)
data]}))]]})))))]]
- (`` ($_ _.and
- (~~ (template [<definition> <expected>]
- [(_.cover [<definition>]
- (|> (<definition> "" //.empty {.#None} mock)
- (do> try.monad
- [io.run!]
- [product.right (value@ //.#body) (function.on {.#None}) io.run!]
- [product.right (# utf8.codec decoded)]
- [(# nat.decimal decoded)]
- [(nat.= <expected>) in])
- (try.else false)))]
+ (with_expansions [<cases> (as_is [/.post on_post]
+ [/.get on_get]
+ [/.put on_put]
+ [/.patch on_patch]
+ [/.delete on_delete]
+ [/.head on_head]
+ [/.connect on_connect]
+ [/.options on_options]
+ [/.trace on_trace])]
+ (`` ($_ _.and
+ (~~ (template [<definition> <expected>]
+ [(_.cover [<definition>]
+ (|> (<definition> "" //.empty {.#None} mock)
+ (verification io.monad <expected>)
+ io.run!))]
+
+ <cases>
+ ))
+ (_.cover [/.headers]
+ (nat.= (dictionary.size headers)
+ (|> headers
+ dictionary.entries
+ /.headers
+ dictionary.size)))
+ (in (do [! async.monad]
+ [.let [mock (/.async mock)]
+ (~~ (template [<definition> <expected>]
+ [<expected> (|> (<definition> "" //.empty {.#None} mock)
+ (verification ! <expected>))]
+
+ <cases>))]
+ (_.cover' [/.async]
+ (and (~~ (template [<definition> <expected>]
+ [<expected>]
- [/.post on_post]
- [/.get on_get]
- [/.put on_put]
- [/.patch on_patch]
- [/.delete on_delete]
- [/.head on_head]
- [/.connect on_connect]
- [/.options on_options]
- [/.trace on_trace]
- ))
- (_.cover [/.headers]
- (nat.= (dictionary.size headers)
- (|> headers
- dictionary.entries
- /.headers
- dictionary.size)))
- )))))
+ <cases>))))))
+ ))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-11 15:03:20 +0000