aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/dependency
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test/aedifex/dependency')
-rw-r--r--stdlib/source/test/aedifex/dependency/resolution.lux371
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
+ )))