diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/aedifex/dependency/resolution.lux | 371 |
1 files changed, 371 insertions, 0 deletions
diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux new file mode 100644 index 000000000..0b2fbe2e2 --- /dev/null +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -0,0 +1,371 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + ["." predicate] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try] + ["." exception] + [concurrency + ["." promise]]] + [data + ["." product] + ["." binary] + ["." text ("#\." equivalence) + ["." encoding]] + [format + ["." xml]] + [collection + ["." dictionary] + ["." set]]] + [math + ["." random (#+ Random)]]] + ["$." /// #_ + ["#." package] + ["#." repository] + ["#." artifact] + [// + [lux + [data + ["$." binary]]]]] + {#program + ["." / + ["//#" /// #_ + ["#" profile] + ["#." package (#+ Package)] + ["#." hash] + ["#." repository (#+ Simulation)] + ["#." dependency] + ["#." pom] + ["#." artifact (#+ Artifact) + ["#/." type] + ["#/." extension]]]]}) + +(def: random + (Random /.Resolution) + (do {! random.monad} + [artifact $///artifact.random + [_ package] $///package.random] + (wrap (dictionary.put {#///dependency.artifact artifact + #///dependency.type ///artifact/type.lux-library} + package + /.empty)))) + +(def: #export (single artifact package) + (-> Artifact Package (Simulation Any)) + (structure + (def: (on-download request extension state) + (if (:: ///artifact.equivalence = artifact request) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE")))) + +(def: one + Test + (do {! random.monad} + [expected-artifact $///artifact.random + [_ expected-package] $///package.random + [_ dummy-package] (random.filter (|>> product.right + (set@ #///package.pom (get@ #///package.pom expected-package)) + (:: ///package.equivalence = expected-package) + not) + $///package.random) + #let [good (..single expected-artifact expected-package) + bad-sha-1 (: (Simulation Any) + (structure + (def: (on-download actual-artifact extension state) + (if (:: ///artifact.equivalence = expected-artifact actual-artifact) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library expected-package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> expected-package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> dummy-package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> expected-package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE")))) + bad-md5 (: (Simulation Any) + (structure + (def: (on-download actual-artifact extension state) + (if (:: ///artifact.equivalence = expected-artifact actual-artifact) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library expected-package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> expected-package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> expected-package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> dummy-package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE"))))]] + (`` ($_ _.and + (wrap + (do promise.monad + [actual-package (/.one (///repository.mock good []) + {#///dependency.artifact expected-artifact + #///dependency.type ///artifact/type.lux-library})] + (_.claim [/.one] + (case actual-package + (#try.Success actual-package) + (:: ///package.equivalence = + (set@ #///package.origin #///package.Remote expected-package) + actual-package) + + (#try.Failure _) + false)))) + (~~ (template [<exception> <bad>] + [(wrap + (do promise.monad + [actual-package (/.one (///repository.mock <bad> []) + {#///dependency.artifact expected-artifact + #///dependency.type ///artifact/type.lux-library})] + (_.claim [<exception>] + (case actual-package + (#try.Failure error) + (exception.match? <exception> error) + + (#try.Success _) + false))))] + + [/.sha-1-does-not-match bad-sha-1] + [/.md5-does-not-match bad-md5] + )) + )))) + +(def: any + Test + (do {! random.monad} + [expected-artifact $///artifact.random + [_ expected-package] $///package.random + [_ dummy-package] (random.filter (|>> product.right + (set@ #///package.pom (get@ #///package.pom expected-package)) + (:: ///package.equivalence = expected-package) + not) + $///package.random) + #let [good (..single expected-artifact expected-package) + bad-sha-1 (: (Simulation Any) + (structure + (def: (on-download actual-artifact extension state) + (if (:: ///artifact.equivalence = expected-artifact actual-artifact) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library expected-package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> expected-package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> dummy-package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> expected-package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE")))) + bad-md5 (: (Simulation Any) + (structure + (def: (on-download actual-artifact extension state) + (if (:: ///artifact.equivalence = expected-artifact actual-artifact) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library expected-package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> expected-package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> expected-package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> dummy-package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE"))))]] + ($_ _.and + (wrap + (do promise.monad + [actual-package (/.any (list (///repository.mock bad-sha-1 []) + (///repository.mock bad-md5 []) + (///repository.mock good [])) + {#///dependency.artifact expected-artifact + #///dependency.type ///artifact/type.lux-library})] + (_.claim [/.any] + (case actual-package + (#try.Success actual-package) + (:: ///package.equivalence = + (set@ #///package.origin #///package.Remote expected-package) + actual-package) + + (#try.Failure _) + false)))) + (wrap + (do promise.monad + [actual-package (/.any (list (///repository.mock bad-sha-1 []) + (///repository.mock bad-md5 [])) + {#///dependency.artifact expected-artifact + #///dependency.type ///artifact/type.lux-library})] + (_.claim [/.cannot-resolve] + (case actual-package + (#try.Failure error) + (exception.match? /.cannot-resolve error) + + (#try.Success _) + false)))) + ))) + +(def: all + Test + (do {! random.monad} + [dependee-artifact $///artifact.random + depender-artifact (random.filter (predicate.complement + (:: ///artifact.equivalence = dependee-artifact)) + $///artifact.random) + ignored-artifact (random.filter (predicate.complement + (predicate.unite (:: ///artifact.equivalence = dependee-artifact) + (:: ///artifact.equivalence = depender-artifact))) + $///artifact.random) + + [_ dependee-package] $///package.random + [_ depender-package] $///package.random + [_ ignored-package] $///package.random + + #let [dependee {#///dependency.artifact dependee-artifact + #///dependency.type ///artifact/type.lux-library} + depender {#///dependency.artifact depender-artifact + #///dependency.type ///artifact/type.lux-library} + ignored {#///dependency.artifact ignored-artifact + #///dependency.type ///artifact/type.lux-library} + + dependee-pom (|> (:: ///.monoid identity) + (set@ #///.identity (#.Some dependee-artifact)) + ///pom.write + try.assume) + depender-pom (|> (:: ///.monoid identity) + (set@ #///.identity (#.Some depender-artifact)) + (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee))) + ///pom.write + try.assume) + ignored-pom (|> (:: ///.monoid identity) + (set@ #///.identity (#.Some ignored-artifact)) + ///pom.write + try.assume) + + dependee-package (set@ #///package.pom dependee-pom dependee-package) + depender-package (set@ #///package.pom depender-pom depender-package) + ignored-package (set@ #///package.pom ignored-pom ignored-package)]] + ($_ _.and + (wrap + (do promise.monad + [resolution (/.all (list (///repository.mock (..single dependee-artifact dependee-package) []) + (///repository.mock (..single depender-artifact depender-package) []) + (///repository.mock (..single ignored-artifact ignored-package) [])) + (list depender) + /.empty)] + (_.claim [/.all] + (case resolution + (#try.Success resolution) + (and (dictionary.contains? depender resolution) + (dictionary.contains? dependee resolution) + (not (dictionary.contains? ignored resolution))) + + (#try.Failure error) + false)))) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Resolution]) + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.empty] + (dictionary.empty? /.empty)) + + ..one + ..any + ..all + ))) |