aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/aedifex.lux4
-rw-r--r--stdlib/source/test/aedifex/cli.lux2
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux129
-rw-r--r--stdlib/source/test/aedifex/repository.lux6
-rw-r--r--stdlib/source/test/lux/data/collection.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/tree/finger.lux133
6 files changed, 271 insertions, 5 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index c9994aafa..e3a2717cd 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -11,7 +11,8 @@
["#." command #_
["#/." clean]
["#/." pom]
- ["#/." install]]
+ ["#/." install]
+ ["#/." deploy]]
["#." local]
["#." cache]
["#." dependency]
@@ -32,6 +33,7 @@
/command/clean.test
/command/pom.test
/command/install.test
+ /command/deploy.test
/local.test
/cache.test
/dependency.test
diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux
index 1edfb381f..b7be4e8bf 100644
--- a/stdlib/source/test/aedifex/cli.lux
+++ b/stdlib/source/test/aedifex/cli.lux
@@ -60,7 +60,7 @@
#/.POM (list "pom")
#/.Dependencies (list "deps")
#/.Install (list "install")
- (#/.Deploy repository user password) (list "deploy" repository user password)
+ (#/.Deploy repository [user password]) (list "deploy" repository user password)
(#/.Compilation compilation) (..format-compilation compilation)
(#/.Auto compilation) (list& "auto" (..format-compilation compilation))))
diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux
new file mode 100644
index 000000000..20718f915
--- /dev/null
+++ b/stdlib/source/test/aedifex/command/deploy.lux
@@ -0,0 +1,129 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." try (#+ Try) ("#@." functor)]
+ ["." exception]
+ [concurrency
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
+ [data
+ ["." maybe]
+ ["." binary]
+ ["." text ("#@." equivalence)
+ ["%" format (#+ format)]
+ ["." encoding]]
+ ["." format #_
+ ["#" binary]
+ ["." tar]
+ ["." xml]]
+ [collection
+ ["." set (#+ Set)]
+ ["." dictionary (#+ Dictionary)]]]
+ [math
+ ["." random (#+ Random)]]
+ [world
+ ["." file (#+ Path File)]]]
+ [program
+ [compositor
+ ["." export]]]
+ [///
+ ["@." profile]
+ ["@." repository]]
+ {#program
+ ["." /
+ ["//#" /// #_
+ ["#" profile]
+ ["#." action]
+ ["#." pom]
+ ["#." local]
+ ["#." hash]
+ ["#." repository (#+ Identity Repository)]
+ ["#." artifact (#+ Artifact)
+ ["#/." extension]]]]})
+
+(def: (make-sources! fs sources)
+ (-> (file.System Promise) (Set Path) (Promise (Try Any)))
+ (loop [sources (set.to-list sources)]
+ (case sources
+ #.Nil
+ (|> []
+ (:: try.monad wrap)
+ (:: promise.monad wrap))
+
+ (#.Cons head tail)
+ (do (try.with promise.monad)
+ [_ (: (Promise (Try Path))
+ (file.make-directories promise.monad fs head))
+ _ (: (Promise (Try (File Promise)))
+ (file.get-file promise.monad fs (format head (:: fs separator) head ".lux")))]
+ (recur tail)))))
+
+(def: (execute! repository fs identity artifact profile)
+ (-> (Repository Promise) (file.System Promise)
+ Identity Artifact ///.Profile
+ (Promise (Try Any)))
+ (do ///action.monad
+ [_ (..make-sources! fs (get@ #///.sources profile))
+ _ (: (Promise (Try Path))
+ (file.make-directories promise.monad fs (///local.repository fs)))]
+ (/.do! repository fs identity artifact profile)))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [[artifact expected-pom profile]
+ (random.one (function (_ profile)
+ (do maybe.monad
+ [artifact (get@ #///.identity profile)
+ expected-pom (try.to-maybe (///pom.write profile))]
+ (wrap [artifact expected-pom profile])))
+ @profile.random)
+
+ identity @repository.identity
+ #let [repository (///repository.mock (@repository.simulation identity)
+ @repository.empty)
+ fs (file.mock (:: file.default separator))]]
+ (wrap (do {! promise.monad}
+ [verdict (do {! ///action.monad}
+ [_ (..execute! repository fs identity artifact profile)
+ expected-library (|> profile
+ (get@ #///.sources)
+ set.to-list
+ (export.library fs)
+ (:: ! map (format.run tar.writer)))
+
+ actual-pom (:: repository download artifact ///artifact/extension.pom)
+ actual-library (:: repository download artifact ///artifact/extension.lux-library)
+ actual-sha-1 (:: repository download artifact ///artifact/extension.sha-1)
+ actual-md5 (:: repository download artifact ///artifact/extension.md5)
+
+ #let [deployed-library!
+ (:: binary.equivalence =
+ expected-library
+ actual-library)
+
+ deployed-pom!
+ (:: binary.equivalence =
+ (|> expected-pom (:: xml.codec encode) encoding.to-utf8)
+ actual-pom)
+
+ deployed-sha-1!
+ (:: binary.equivalence =
+ (///hash.data (///hash.sha-1 expected-library))
+ actual-sha-1)
+
+ deployed-md5!
+ (:: binary.equivalence =
+ (///hash.data (///hash.md5 expected-library))
+ actual-md5)]]
+ (wrap (and deployed-library!
+ deployed-pom!
+ deployed-sha-1!
+ deployed-md5!)))]
+ (_.claim [/.do!]
+ (try.default false verdict)))))))
diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux
index 4f96d9329..5f05d342e 100644
--- a/stdlib/source/test/aedifex/repository.lux
+++ b/stdlib/source/test/aedifex/repository.lux
@@ -27,7 +27,7 @@
["#." artifact (#+ Version Artifact)
["#/." extension (#+ Extension)]]]]})
-(def: identity
+(def: #export identity
(Random Identity)
(random.and (random.ascii/alpha 10)
(random.ascii/alpha 10)))
@@ -59,11 +59,11 @@
(type: Store
(Dictionary [Artifact Extension] Binary))
-(def: empty
+(def: #export empty
Store
(dictionary.new ..item-hash))
-(structure: (simulation identity)
+(structure: #export (simulation identity)
(-> Identity (/.Simulation Store))
(def: (on-download artifact extension state)
diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux
index 497123614..bcbda46b9 100644
--- a/stdlib/source/test/lux/data/collection.lux
+++ b/stdlib/source/test/lux/data/collection.lux
@@ -17,6 +17,7 @@
["#/." multi]
["#/." ordered]]
["#." tree
+ ["#/." finger]
["#/." zipper]]])
(def: dictionary
@@ -46,6 +47,7 @@
Test
($_ _.and
/tree.test
+ /tree/finger.test
/tree/zipper.test
))
diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux
new file mode 100644
index 000000000..a0dfabb54
--- /dev/null
+++ b/stdlib/source/test/lux/data/collection/tree/finger.lux
@@ -0,0 +1,133 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [data
+ ["." maybe ("#@." functor)]
+ ["." text ("#@." equivalence monoid)]
+ [number
+ ["n" nat]]]
+ [math
+ ["." random]]
+ [type (#+ :by-example)]]
+ {1
+ ["." /]})
+
+(def: builder
+ (/.builder text.monoid))
+
+(def: :@:
+ (:by-example [@]
+ {(/.Builder @ Text)
+ ..builder}
+ @))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Tree])
+ (do {! random.monad}
+ [tag-left (random.ascii/alpha-num 1)
+ tag-right (random.filter (|>> (text@= tag-left) not)
+ (random.ascii/alpha-num 1))
+ expected-left random.nat
+ expected-right random.nat]
+ ($_ _.and
+ (_.cover [/.Builder /.builder]
+ (exec (/.builder text.monoid)
+ true))
+ (_.cover [/.tag]
+ (and (text@= tag-left
+ (/.tag (:: ..builder leaf tag-left expected-left)))
+ (text@= (text@compose tag-left tag-right)
+ (/.tag (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right))))))
+ (_.cover [/.root]
+ (and (case (/.root (:: ..builder leaf tag-left expected-left))
+ (#.Left actual)
+ (n.= expected-left actual)
+
+ (#.Right _)
+ false)
+ (case (/.root (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right)))
+ (#.Left _)
+ false
+
+ (#.Right [left right])
+ (case [(/.root left)
+ (/.root right)]
+ [(#.Left actual-left) (#.Left actual-right)]
+ (and (n.= expected-left actual-left)
+ (n.= expected-right actual-right))
+
+ _
+ false))))
+ (_.cover [/.value]
+ (and (n.= expected-left
+ (/.value (:: ..builder leaf tag-left expected-left)))
+ (n.= expected-left
+ (/.value (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right))))))
+ (_.cover [/.search]
+ (let [can-find-correct-one!
+ (|> (:: ..builder leaf tag-left expected-left)
+ (/.search (text.contains? tag-left))
+ (maybe@map (n.= expected-left))
+ (maybe.default false))
+
+ cannot-find-incorrect-one!
+ (|> (:: ..builder leaf tag-right expected-right)
+ (/.search (text.contains? tag-left))
+ (maybe@map (n.= expected-left))
+ (maybe.default false)
+ not)
+
+ can-find-left!
+ (|> (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right))
+ (/.search (text.contains? tag-left))
+ (maybe@map (n.= expected-left))
+ (maybe.default false))
+
+ can-find-right!
+ (|> (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right))
+ (/.search (text.contains? tag-right))
+ (maybe@map (n.= expected-right))
+ (maybe.default false))]
+ (and can-find-correct-one!
+ cannot-find-incorrect-one!
+ can-find-left!
+ can-find-right!)))
+ (_.cover [/.found?]
+ (let [can-find-correct-one!
+ (/.found? (text.contains? tag-left)
+ (:: ..builder leaf tag-left expected-left))
+
+ cannot-find-incorrect-one!
+ (not (/.found? (text.contains? tag-left)
+ (:: ..builder leaf tag-right expected-right)))
+
+ can-find-left!
+ (/.found? (text.contains? tag-left)
+ (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right)))
+
+ can-find-right!
+ (/.found? (text.contains? tag-right)
+ (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right)))]
+ (and can-find-correct-one!
+ cannot-find-incorrect-one!
+ can-find-left!
+ can-find-right!)))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-11 00:06:48 +0000