aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2021-02-07 04:56:58 -0400
committerEduardo Julian2021-02-07 04:56:58 -0400
commitd99c47989a1047cd24019fd5ce434e701b5d3519 (patch)
tree19bfb0f5e4713e5dcd0c71bbd7b88d09d75dfe5d /stdlib
parent571d816dfd0b056a1649f5057867abbfa4421f5d (diff)
Mo' updates, less problems.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux.lux2
-rw-r--r--stdlib/source/lux/data/format/xml.lux55
-rw-r--r--stdlib/source/lux/target/lua.lux42
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux49
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux63
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux74
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux23
-rw-r--r--stdlib/source/lux/type/resource.lux52
-rw-r--r--stdlib/source/lux/type/unit.lux13
-rw-r--r--stdlib/source/program/aedifex/artifact.lux6
-rw-r--r--stdlib/source/program/aedifex/artifact/versioning.lux7
-rw-r--r--stdlib/source/program/aedifex/command/build.lux2
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux17
-rw-r--r--stdlib/source/program/aedifex/command/deps.lux42
-rw-r--r--stdlib/source/program/aedifex/command/install.lux20
-rw-r--r--stdlib/source/program/aedifex/dependency/deployment.lux51
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux137
-rw-r--r--stdlib/source/program/aedifex/local.lux9
-rw-r--r--stdlib/source/program/aedifex/metadata.lux6
-rw-r--r--stdlib/source/program/aedifex/metadata/artifact.lux4
-rw-r--r--stdlib/source/program/aedifex/metadata/snapshot.lux241
-rw-r--r--stdlib/source/program/aedifex/package.lux27
-rw-r--r--stdlib/source/program/aedifex/parser.lux6
-rw-r--r--stdlib/source/program/aedifex/pom.lux42
-rw-r--r--stdlib/source/program/aedifex/repository/local.lux22
-rw-r--r--stdlib/source/program/aedifex/repository/remote.lux34
-rw-r--r--stdlib/source/test/aedifex/artifact.lux12
-rw-r--r--stdlib/source/test/lux.lux66
-rw-r--r--stdlib/source/test/lux/data/name.lux2
-rw-r--r--stdlib/source/test/lux/data/text.lux2
-rw-r--r--stdlib/source/test/lux/macro/code.lux8
-rw-r--r--stdlib/source/test/lux/math/modular.lux4
-rw-r--r--stdlib/source/test/lux/type/resource.lux217
34 files changed, 764 insertions, 601 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 2b9d0b27e..de071c35a 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -4593,7 +4593,7 @@
(return (list (` ((let [(^open ".") (~ struct)] (~ (identifier$ member))) (~+ args)))))
_
- (fail "Wrong syntax for ::")))
+ (fail "Wrong syntax for \")))
(macro: #export (set@ tokens)
{#.doc (text$ ($_ "lux text concat"
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index 3683e9e57..bee2d2983 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -71,7 +71,7 @@
(def: xml_char^
(Parser Text)
- (<>.either (<text>.none_of ($_ text\compose "<>&'" text.double_quote))
+ (<>.either (<text>.none_of ($_ text\compose "<>&" text.double_quote))
xml_escape_char^))
(def: xml_identifier
@@ -134,7 +134,7 @@
(Parser Text)
(|> (<text>.not (<text>.this "--"))
<text>.some
- (<text>.enclosed ["<--" "-->"])
+ (<text>.enclosed ["<!--" "-->"])
spaced^))
(def: xml_header^
@@ -154,8 +154,8 @@
(def: text^
(Parser XML)
- (|> (<>.either cdata^
- (..spaced^ (<text>.many xml_char^)))
+ (|> (..spaced^ (<text>.many xml_char^))
+ (<>.either cdata^)
(<>\map (|>> #Text))))
(def: null^
@@ -166,28 +166,33 @@
(Parser XML)
(|> (<>.rec
(function (_ node^)
- (<>.either text^
- (spaced^
- (do <>.monad
- [_ (<text>.this "<")
- tag (spaced^ tag^)
- attrs (spaced^ attrs^)
- #let [no_children^ (do <>.monad
- [_ (<text>.this "/>")]
- (wrap (#Node tag attrs (list))))
- with_children^ (do <>.monad
- [_ (<text>.this ">")
- children (<>.some node^)
- _ (close_tag^ tag)]
- (wrap (#Node tag attrs children)))]]
- (<>.either no_children^
- with_children^))))))
- ## This is put outside of the call to "rec" because comments
- ## cannot be located inside of XML nodes.
- ## This way, the comments can only be before or after the main document.
- (<>.before (<>.some comment^))
+ (|> (spaced^
+ (do <>.monad
+ [_ (<text>.this "<")
+ tag (spaced^ tag^)
+ attrs (spaced^ attrs^)
+ #let [no_children^ (do <>.monad
+ [_ (<text>.this "/>")]
+ (wrap (#Node tag attrs (list))))
+ ## TODO: Find a way to make do without this hack. Without it, some POM files fail when parsing them in Aedifex. Something like this fails: <configuration> </configuration>
+ alternative_no_children^ (do <>.monad
+ [_ (<text>.this ">")
+ _ (<>.some <text>.space)
+ _ (..close_tag^ tag)]
+ (wrap (#Node tag attrs (list))))
+ with_children^ (do <>.monad
+ [_ (<text>.this ">")
+ children (<>.some node^)
+ _ (..close_tag^ tag)]
+ (wrap (#Node tag attrs children)))]]
+ ($_ <>.either
+ no_children^
+ alternative_no_children^
+ with_children^)))
+ (<>.before (<>.some ..comment^))
+ (<>.after (<>.some ..comment^))
+ (<>.either text^))))
(<>.before (<>.some ..null^))
- (<>.after (<>.some comment^))
(<>.after (<>.maybe xml_header^))))
(def: read
diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux
index be46169dd..c1bceb634 100644
--- a/stdlib/source/lux/target/lua.lux
+++ b/stdlib/source/lux/target/lua.lux
@@ -1,5 +1,8 @@
(.module:
[lux (#- Location Code int if cond function or and not let)
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]]
[control
[pipe (#+ case> cond> new>)]]
[data
@@ -27,6 +30,18 @@
(abstract: #export (Code brand)
Text
+ (structure: #export equivalence
+ (All [brand] (Equivalence (Code brand)))
+
+ (def: (= reference subject)
+ (\ text.equivalence = (:representation reference) (:representation subject))))
+
+ (structure: #export hash
+ (All [brand] (Hash (Code brand)))
+
+ (def: &equivalence ..equivalence)
+ (def: hash (|>> :representation (\ text.hash hash))))
+
(def: #export manual
(-> Text Code)
(|>> :abstraction))
@@ -225,6 +240,10 @@
(local vars)
(set vars value)))
+ (def: #export (local/1 var value)
+ (-> Var Expression Statement)
+ (:abstraction (format "local " (:representation var) " = " (:representation value) ..statement_suffix)))
+
(def: #export (if test then! else!)
(-> Expression Statement Statement Statement)
(:abstraction (format "if " (:representation test)
@@ -280,15 +299,20 @@
(text.enclose ["(" ")"])
:abstraction))
- (def: #export (function name args body!)
- (-> Var (List Var) Statement Statement)
- (:abstraction
- (format "function " (:representation name)
- (|> args
- ..locations
- (text.enclose ["(" ")"]))
- (..nest (:representation body!))
- text.new_line "end" ..statement_suffix)))
+ (template [<name> <code>]
+ [(def: #export (<name> name args body!)
+ (-> Var (List Var) Statement Statement)
+ (:abstraction
+ (format <code> " " (:representation name)
+ (|> args
+ ..locations
+ (text.enclose ["(" ")"]))
+ (..nest (:representation body!))
+ text.new_line "end" ..statement_suffix)))]
+
+ [function "function"]
+ [local_function "local function"]
+ )
(def: #export break
Statement
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
index 2f1917de9..7d7ce2fbf 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux
@@ -39,13 +39,13 @@
(/.install "or" (binary (product.uncurry _.bit_or)))
(/.install "xor" (binary (product.uncurry _.bit_xor)))
(/.install "left-shift" (binary (product.uncurry _.bit_shl)))
- (/.install "logical-right-shift" (binary (product.uncurry //runtime.i64//logic_right_shift)))
+ (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift)))
(/.install "=" (binary (product.uncurry _.=)))
(/.install "+" (binary (product.uncurry _.+)))
(/.install "-" (binary (product.uncurry _.-)))
(/.install "<" (binary (product.uncurry _.<)))
(/.install "*" (binary (product.uncurry _.*)))
- (/.install "/" (binary (product.uncurry _./)))
+ (/.install "/" (binary (product.uncurry _.//)))
(/.install "%" (binary (product.uncurry _.%)))
(/.install "f64" (unary (_./ (_.float +1.0))))
(/.install "char" (unary (!unary "string.char")))
@@ -97,8 +97,8 @@
(def: (io//log! messageO)
(Unary Expression)
- (_.or (_.apply/* (list messageO) (_.var "print"))
- //runtime.unit))
+ (|> (_.apply/* (list messageO) (_.var "print"))
+ (_.or //runtime.unit)))
(def: io_procs
Bundle
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
index e6dad82e5..3c56c2dfa 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
@@ -3,7 +3,8 @@
[abstract
["." monad (#+ do)]]
[data
- ["." text]
+ ["." text
+ ["%" format (#+ format)]]
[collection
["." list ("#\." functor fold)]
["." set]]]
@@ -20,9 +21,10 @@
["#/." case]]
["/#" // #_
["#." synthesis (#+ Member Synthesis Path)]
+ ["#." generation]
["//#" /// #_
[reference
- [variable (#+ Register)]]
+ ["#." variable (#+ Register)]]
["#." phase ("#\." monad)]
[meta
[archive (#+ Archive)]]]]]]])
@@ -31,6 +33,10 @@
(-> Register Var)
(|>> (///reference.local //reference.system) :assume))
+(def: #export capture
+ (-> Register Var)
+ (|>> (///reference.foreign //reference.system) :assume))
+
(def: #export (let generate archive [valueS register bodyS])
(Generator [Synthesis Register Synthesis])
(do ///////phase.monad
@@ -139,7 +145,7 @@
(///////phase\wrap ..pop!)
(#/////synthesis.Bind register)
- (///////phase\wrap (_.let (list (..register register)) ..peek))
+ (///////phase\wrap (_.local/1 (..register register) ..peek))
(#/////synthesis.Bit_Fork when thenP elseP)
(do {! ///////phase.monad}
@@ -195,7 +201,7 @@
(do ///////phase.monad
[then! (recur thenP)]
(///////phase\wrap ($_ _.then
- (_.let (list (..register register)) ..peek_and_pop)
+ (_.local/1 (..register register) ..peek_and_pop)
then!)))
(^template [<tag> <combinator>]
@@ -216,15 +222,34 @@
pattern_matching!)
(_.statement (|> (_.var "error") (_.apply/* (list (_.string ////synthesis/case.pattern_matching_error)))))))))
+(def: #export dependencies
+ (-> Path (List Var))
+ (|>> ////synthesis/case.storage
+ (get@ #////synthesis/case.dependencies)
+ set.to_list
+ (list\map (function (_ variable)
+ (.case variable
+ (#///////variable.Local register)
+ (..register register)
+
+ (#///////variable.Foreign register)
+ (..capture register))))))
+
(def: #export (case generate archive [valueS pathP])
(Generator [Synthesis Path])
(do ///////phase.monad
[initG (generate archive valueS)
- pattern_matching! (pattern_matching generate archive pathP)]
- (wrap (|> ($_ _.then
- (_.local (list @temp))
- (_.let (list @cursor) (_.array (list initG)))
- (_.let (list @savepoint) (_.array (list)))
- pattern_matching!)
- (_.closure (list))
- (_.apply/* (list))))))
+ [[case_module case_artifact] pattern_matching!] (/////generation.with_new_context archive
+ (pattern_matching generate archive pathP))
+ #let [@case (_.var (///reference.artifact [case_module case_artifact]))
+ @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS)
+ pathP))
+ directive (_.function @case @dependencies+
+ ($_ _.then
+ (_.local (list @temp))
+ (_.local/1 @cursor (_.array (list initG)))
+ (_.local/1 @savepoint (_.array (list)))
+ pattern_matching!))]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! (%.nat case_artifact) directive)]
+ (wrap (_.apply/* @dependencies+ @case))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
index 7c07c8c6d..c7fe7f51c 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
@@ -6,6 +6,8 @@
pipe]
[data
["." product]
+ [text
+ ["%" format (#+ format)]]
[collection
["." list ("#\." functor fold)]]]
[target
@@ -37,23 +39,24 @@
(-> Register Var)
(|>> (///reference.foreign //reference.system) :assume))
-(def: (with_closure function_name inits function_definition)
- (-> Text (List Expression) Statement (Operation Expression))
+(def: (with_closure function_name inits @function @args @body)
+ (-> Text (List Expression) Var (List Var) Statement (Operation Expression))
(case inits
#.Nil
(do ///////phase.monad
- [_ (/////generation.execute! function_definition)
+ [#let [function_definition (_.function @function @args @body)]
+ _ (/////generation.execute! function_definition)
_ (/////generation.save! function_name function_definition)]
- (wrap (|> (_.var function_name) (_.apply/* inits))))
+ (wrap (_.var function_name)))
_
(do {! ///////phase.monad}
- [@closure (\ ! map _.var (/////generation.gensym "closure"))
- #let [directive (_.function @closure
+ [#let [@closure (_.var (format function_name "_closure"))
+ directive (_.function @closure
(|> (list.enumeration inits)
(list\map (|>> product.left ..capture)))
($_ _.then
- function_definition
+ (_.local_function @function @args @body)
(_.return (_.var function_name))))]
_ (/////generation.execute! directive)
_ (/////generation.save! (_.code @closure) directive)]
@@ -77,35 +80,35 @@
arityO (|> arity .int _.int)
@num_args (_.var "num_args")
@self (_.var function_name)
- initialize_self! (_.let (list (//case.register 0)) @self)
+ initialize_self! (_.local/1 (//case.register 0) @self)
initialize! (list\fold (.function (_ post pre!)
($_ _.then
pre!
- (_.let (list (..input post)) (_.nth (|> post inc .int _.int) @curried))))
+ (_.local/1 (..input post) (_.nth (|> post inc .int _.int) @curried))))
initialize_self!
(list.indices arity))
- pack (|>> (list) _.apply/* (|> (_.var "table.pack")))
+ pack (|>> (list) _.array)
unpack (|>> (list) _.apply/* (|> (_.var "table.unpack")))
@var_args (_.var "...")]]
(with_closure function_name closureO+
- (_.function @self (list @var_args)
- ($_ _.then
- (_.let (list @curried) (pack @var_args))
- (_.let (list @num_args) (_.the "n" @curried))
- (_.cond (list [(|> @num_args (_.= (_.int +0)))
- (_.return @self)]
- [(|> @num_args (_.= arityO))
- ($_ _.then
- initialize!
- (_.return bodyO))]
- [(|> @num_args (_.> arityO))
- (let [arity_inputs (//runtime.array//sub (_.int +0) arityO @curried)
- extra_inputs (//runtime.array//sub arityO @num_args @curried)]
- (_.return (|> @self
- (_.apply/* (list (unpack arity_inputs)))
- (_.apply/* (list (unpack extra_inputs))))))])
- ## (|> @num_args (_.< arityO))
- (_.return (_.closure (list @var_args)
- (_.return (|> @self (_.apply/* (list (unpack (//runtime.array//concat @curried (pack @var_args))))))))))
- )))
+ @self (list @var_args)
+ ($_ _.then
+ (_.local/1 @curried (pack @var_args))
+ (_.local/1 @num_args (_.length @curried))
+ (_.cond (list [(|> @num_args (_.= (_.int +0)))
+ (_.return @self)]
+ [(|> @num_args (_.= arityO))
+ ($_ _.then
+ initialize!
+ (_.return bodyO))]
+ [(|> @num_args (_.> arityO))
+ (let [arity_inputs (//runtime.array//sub (_.int +0) arityO @curried)
+ extra_inputs (//runtime.array//sub arityO @num_args @curried)]
+ (_.return (|> @self
+ (_.apply/* (list (unpack arity_inputs)))
+ (_.apply/* (list (unpack extra_inputs))))))])
+ ## (|> @num_args (_.< arityO))
+ (_.return (_.closure (list @var_args)
+ (_.return (|> @self (_.apply/* (list (unpack (//runtime.array//concat @curried (pack @var_args))))))))))
+ ))
))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
index 817ba118a..b1b8a47cb 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux
@@ -7,22 +7,25 @@
[text
["%" format (#+ format)]]
[collection
- ["." list ("#\." functor)]]]
+ ["." list ("#\." functor)]
+ ["." set]]]
[math
[number
["n" nat]]]
[target
- ["_" lua (#+ Expression Var)]]]
+ ["_" lua (#+ Var Expression Statement)]]]
["." // #_
[runtime (#+ Operation Phase Phase! Generator Generator!)]
["#." case]
- ["///#" //// #_
- [synthesis (#+ Scope Synthesis)]
- ["#." generation]
+ ["/#" // #_
+ ["#." reference]
["//#" /// #_
- ["#." phase]
- [reference
- [variable (#+ Register)]]]]])
+ ["."synthesis (#+ Scope Synthesis)]
+ ["#." generation]
+ ["//#" /// #_
+ ["#." phase]
+ [reference
+ [variable (#+ Register)]]]]]])
(def: loop_name
(-> Nat Var)
@@ -30,18 +33,49 @@
(def: #export (scope generate archive [start initsS+ bodyS])
(Generator (Scope Synthesis))
- (do {! ///////phase.monad}
- [@loop (\ ! map ..loop_name /////generation.next)
- initsO+ (monad.map ! (generate archive) initsS+)
- bodyO (/////generation.with_anchor @loop
- (generate archive bodyS))
- #let [directive (_.function @loop (|> initsS+
- list.enumeration
- (list\map (|>> product.left (n.+ start) //case.register)))
- (_.return bodyO))]
- _ (/////generation.execute! directive)
- _ (/////generation.save! (_.code @loop) directive)]
- (wrap (_.apply/* initsO+ @loop))))
+ (case initsS+
+ ## function/false/non-independent loop
+ #.Nil
+ (generate archive bodyS)
+
+ ## true loop
+ _
+ (do {! ///////phase.monad}
+ [@loop (\ ! map ..loop_name /////generation.next)
+ initsO+ (monad.map ! (generate archive) initsS+)
+ [loop_name bodyO] (/////generation.with_new_context archive
+ (do !
+ [@loop (\ ! map (|>> ///reference.artifact _.var)
+ (/////generation.context archive))]
+ (/////generation.with_anchor @loop
+ (generate archive bodyS))))
+ #let [@loop (_.var (///reference.artifact loop_name))
+ locals (|> initsS+
+ list.enumeration
+ (list\map (|>> product.left (n.+ start) //case.register)))
+ [directive instantiation] (: [Statement Expression]
+ (case (|> (synthesis.path/then bodyS)
+ //case.dependencies
+ (set.from_list _.hash)
+ (set.difference (set.from_list _.hash locals))
+ set.to_list)
+ #.Nil
+ [(_.function @loop locals
+ (_.return bodyO))
+ @loop]
+
+ foreigns
+ (let [@context (_.var (format (///reference.artifact loop_name) "_context"))]
+ [(_.function @context foreigns
+ ($_ _.then
+ (<| (_.local_function @loop locals)
+ (_.return bodyO))
+ (_.return @loop)
+ ))
+ (_.apply/* foreigns @context)])))]
+ _ (/////generation.execute! directive)
+ _ (/////generation.save! (_.code @loop) directive)]
+ (wrap (_.apply/* initsO+ instantiation)))))
(def: #export (recur generate archive argsS+)
(Generator (List Synthesis))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
index 72f8576f5..d7b0f1cd3 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
@@ -58,7 +58,8 @@
(def: prefix
"LuxRuntime")
-(def: #export unit (_.string /////synthesis.unit))
+(def: #export unit
+ (_.string /////synthesis.unit))
(def: (flag value)
(-> Bit Literal)
@@ -232,7 +233,7 @@
(runtime: (array//concat left right)
(with_vars [temp idx]
(let [copy! (function (_ input output)
- (<| (_.for_step idx (_.int +1) (_.the "n" input) (_.int +1))
+ (<| (_.for_step idx (_.int +1) (_.length input) (_.int +1))
(_.statement (|> (_.var "table.insert") (_.apply/* (list output (_.nth idx input)))))))]
($_ _.then
(_.let (list temp) (_.array (list)))
@@ -277,7 +278,7 @@
@lux//program_args
))
-(runtime: (i64//logic_right_shift param subject)
+(runtime: (i64//right_shift param subject)
(let [mask (|> (_.int +1)
(_.bit_shl (_.- param (_.int +64)))
(_.- (_.int +1)))]
@@ -288,7 +289,7 @@
(def: runtime//i64
Statement
($_ _.then
- @i64//logic_right_shift
+ @i64//right_shift
))
(runtime: (text//index subject param start)
@@ -301,22 +302,16 @@
(_.return (..some idx))))))
(runtime: (text//clip text from to)
- (with_vars [size]
- ($_ _.then
- (_.let (list size) (_.apply/* (list text) (_.var "string.len")))
- (_.if (_.or (_.> size from)
- (_.> size to))
- (_.return ..none)
- (_.return (..some (_.apply/* (list text from to) (_.var "string.sub")))))
- )))
+ (_.return (_.apply/* (list text from to) (_.var "string.sub"))))
(runtime: (text//char idx text)
(with_vars [char]
($_ _.then
(_.let (list char) (_.apply/* (list text idx) (_.var "string.byte")))
(_.if (_.= _.nil char)
- (_.return ..none)
- (_.return (..some char))))))
+ (_.statement (_.apply/* (list (_.string "[Lux Error] Cannot get char from text."))
+ (_.var "error")))
+ (_.return char)))))
(def: runtime//text
Statement
diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux
index a6d60074b..07425c45b 100644
--- a/stdlib/source/lux/type/resource.lux
+++ b/stdlib/source/lux/type/resource.lux
@@ -9,8 +9,8 @@
["." io (#+ IO)]
[concurrency
["." promise (#+ Promise)]]
- ["p" parser
- ["s" code (#+ Parser)]]]
+ ["<>" parser
+ ["<.>" code (#+ Parser)]]]
[data
["." identity (#+ Identity)]
["." maybe]
@@ -80,25 +80,22 @@
[async Promise promise.monad run_async lift_async]
)
-(abstract: #export Ordered [])
+(abstract: #export Ordered Any)
-(abstract: #export Commutative [])
+(abstract: #export Commutative Any)
(abstract: #export (Key mode key)
- []
+ Any
(template [<name> <mode>]
[(def: <name>
- (Ex [k] (-> [] (Key <mode> k)))
+ (Ex [k] (-> Any (Key <mode> k)))
(|>> :abstraction))]
[ordered_key Ordered]
[commutative_key Commutative]
))
-(type: #export OK (Key Ordered))
-(type: #export CK (Key Commutative))
-
(abstract: #export (Res key value)
value
@@ -138,21 +135,22 @@
(def: indices
(Parser (List Nat))
- (s.tuple (loop [seen (set.new n.hash)]
- (do {! p.monad}
- [done? s.end?]
- (if done?
- (wrap (list))
- (do !
- [head s.nat
- _ (p.assert (exception.construct index_cannot_be_repeated head)
- (not (set.member? seen head)))
- tail (recur (set.add head seen))]
- (wrap (list& head tail))))))))
+ (<code>.tuple (loop [seen (set.new n.hash)]
+ (do {! <>.monad}
+ [done? <code>.end?]
+ (if done?
+ (wrap (list))
+ (do !
+ [head <code>.nat
+ _ (<>.assert (exception.construct ..index_cannot_be_repeated head)
+ (not (set.member? seen head)))
+ tail (recur (set.add head seen))]
+ (wrap (list& head tail))))))))
(def: (no_op Monad<m>)
(All [m] (-> (Monad m) (Linear m Any)))
- (function (_ context) (\ Monad<m> wrap [context []])))
+ (function (_ context)
+ (\ Monad<m> wrap [context []])))
(template [<name> <m> <monad>]
[(syntax: #export (<name> {swaps ..indices})
@@ -174,8 +172,8 @@
swaps)
maybe.assume
row.to_list)
- g!inputsT+ (list\map (|>> (~) ..CK (`)) g!inputs)
- g!outputsT+ (list\map (|>> (~) ..CK (`)) g!outputs)]]
+ g!inputsT+ (list\map (|>> (~) (..Key ..Commutative) (`)) g!inputs)
+ g!outputsT+ (list\map (|>> (~) (..Key ..Commutative) (`)) g!outputs)]]
(wrap (list (` (: (All [(~+ g!inputs) (~ g!context)]
(Procedure (~! <m>)
[(~+ g!inputsT+) (~ g!context)]
@@ -191,10 +189,10 @@
(def: amount
(Parser Nat)
- (do p.monad
- [raw s.nat
- _ (p.assert (exception.construct ..amount_cannot_be_zero [])
- (n.> 0 raw))]
+ (do <>.monad
+ [raw <code>.nat
+ _ (<>.assert (exception.construct ..amount_cannot_be_zero [])
+ (n.> 0 raw))]
(wrap raw)))
(template [<name> <m> <monad> <from> <to>]
diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux
index 0a3d5c61a..b45e32c37 100644
--- a/stdlib/source/lux/type/unit.lux
+++ b/stdlib/source/lux/type/unit.lux
@@ -103,6 +103,7 @@
(primitive (~ (code.text (scale_name name))) [(~' u)])))
(` (structure: (~+ (|export|.format export)) (~ (code.local_identifier (format "@" name)))
(..Scale (~ g!scale))
+
(def: (~' scale)
(|>> ..out
(i.* (~ (code.int (.int numerator))))
@@ -165,17 +166,23 @@
(unit: #export Litre)
(unit: #export Second)
-(structure: #export equivalence (All [unit] (Equivalence (Qty unit)))
+(structure: #export equivalence
+ (All [unit] (Equivalence (Qty unit)))
+
(def: (= reference sample)
(i.= (out reference) (out sample))))
-(structure: #export order (All [unit] (Order (Qty unit)))
+(structure: #export order
+ (All [unit] (Order (Qty unit)))
+
(def: &equivalence ..equivalence)
(def: (< reference sample)
(i.< (out reference) (out sample))))
-(structure: #export enum (All [unit] (Enum (Qty unit)))
+(structure: #export enum
+ (All [unit] (Enum (Qty unit)))
+
(def: &order ..order)
(def: succ (|>> ..out inc ..in))
(def: pred (|>> ..out dec ..in)))
diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux
index 07b53157f..9e87988ea 100644
--- a/stdlib/source/program/aedifex/artifact.lux
+++ b/stdlib/source/program/aedifex/artifact.lux
@@ -68,12 +68,12 @@
(text.split_all_with ..group_separator)
(text.join_with separator)))
-(def: #export (uri artifact)
- (-> Artifact URI)
+(def: #export (uri version artifact)
+ (-> Version Artifact URI)
(let [/ uri.separator
group (..directory / (get@ #group artifact))
name (get@ #name artifact)
- version (get@ #version artifact)
+ ## version (get@ #version artifact)
identity (..identity artifact)]
(%.format group / name / version / identity)))
diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux
index 41b3179d3..dab943145 100644
--- a/stdlib/source/program/aedifex/artifact/versioning.lux
+++ b/stdlib/source/program/aedifex/artifact/versioning.lux
@@ -89,9 +89,10 @@
(Parser Versioning)
(<| (..sub ..<versioning>)
($_ <>.and
- (<xml>.somewhere //snapshot.parser)
- (<xml>.somewhere ..last_updated_parser)
- (<| <xml>.somewhere
+ (<>.default #//snapshot.Local (<xml>.somewhere //snapshot.parser))
+ (<>.default instant.epoch (<xml>.somewhere ..last_updated_parser))
+ (<| (<>.default (list))
+ <xml>.somewhere
(..sub ..<snapshot_versions>)
(<>.some //snapshot/version.parser))
)))
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 7241b1de4..388a48c89 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -107,7 +107,7 @@
(All [!] (-> (file.System !) Path Artifact Path))
(let [/ (\ fs separator)]
(|> artifact
- ///local.uri
+ (///local.uri (get@ #///artifact.version artifact))
(text.replace_all uri.separator /)
(format home /))))
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index fe96055ef..758f87ab9 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -63,12 +63,13 @@
_ (///dependency/deployment.one
repository
[artifact ///artifact/type.lux_library]
- {#///package.origin (#///repository/origin.Remote "")
- #///package.library [library
- (///dependency/status.verified library)]
- #///package.pom [pom
- (|> pom
- (\ xml.codec encode)
- (\ encoding.utf8 encode)
- ///dependency/status.verified)]})]
+ (let [pom_data (|> pom
+ (\ xml.codec encode)
+ (\ encoding.utf8 encode))]
+ {#///package.origin (#///repository/origin.Remote "")
+ #///package.library [library
+ (///dependency/status.verified library)]
+ #///package.pom [pom
+ pom_data
+ (///dependency/status.verified pom_data)]}))]
(console.write_line //clean.success console)))
diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux
index 71dffeec1..14b5d803f 100644
--- a/stdlib/source/program/aedifex/command/deps.lux
+++ b/stdlib/source/program/aedifex/command/deps.lux
@@ -3,13 +3,16 @@
[abstract
[monad (#+ do)]]
[control
+ ["." exception]
[concurrency
["." promise (#+ Promise)]]]
[data
[collection
["." set (#+ Set)]
["." list ("#\." fold)]
- ["." dictionary]]]
+ ["." dictionary]]
+ [text
+ ["%" format (#+ format)]]]
[world
[program (#+ Program)]
["." file]
@@ -18,22 +21,39 @@
["#." clean]
["/#" // #_
[command (#+ Command)]
- [artifact (#+ Artifact)]
[repository (#+ Repository)]
["#" profile]
["#." action (#+ Action)]
- ["#." dependency #_
+ ["#." artifact (#+ Artifact)]
+ ["#." dependency (#+ Dependency)
["#/." resolution (#+ Resolution)]
["#/." deployment]]]])
+(def: %dependency
+ (%.Format Dependency)
+ (|>> (get@ #///dependency.artifact)
+ ///artifact.format
+ %.text))
+
(def: #export (do! console local remotes profile)
(-> (Console Promise) (Repository Promise) (List (Repository Promise)) (Command Resolution))
- (do ///action.monad
+ (do promise.monad
[#let [dependencies (set.to_list (get@ #///.dependencies profile))]
- cache (///dependency/resolution.all (list local) dependencies ///dependency/resolution.empty)
- resolution (///dependency/resolution.all remotes dependencies cache)
- cached (|> (dictionary.keys cache)
- (list\fold dictionary.remove resolution)
- (///dependency/deployment.all local))
- _ (console.write_line //clean.success console)]
- (wrap resolution)))
+ [local_successes local_failures cache] (///dependency/resolution.all (list local) dependencies ///dependency/resolution.empty)
+ [remote_successes remote_failures resolution] (///dependency/resolution.all remotes dependencies cache)]
+ (do ///action.monad
+ [cached (|> (dictionary.keys cache)
+ (list\fold dictionary.remove resolution)
+ (///dependency/deployment.all local))
+ _ (console.write_line //clean.success console)
+ _ (console.write_line (exception.report
+ ["Local successes" (exception.enumerate %dependency local_successes)]
+ ["Local failures" (exception.enumerate %dependency local_failures)]
+ ["Remote successes" (let [remote_successes (|> remote_successes
+ (set.from_list ///dependency.hash)
+ (set.difference (set.from_list ///dependency.hash local_successes))
+ set.to_list)]
+ (exception.enumerate %dependency remote_successes))]
+ ["Remote failures" (exception.enumerate %dependency remote_failures)])
+ console)]
+ (wrap resolution))))
diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux
index b051a4900..35ffcf72f 100644
--- a/stdlib/source/program/aedifex/command/install.lux
+++ b/stdlib/source/program/aedifex/command/install.lux
@@ -54,15 +54,17 @@
(do ///action.monad
[package (export.library system (set.to_list (get@ #/.sources profile)))
pom (\ promise.monad wrap (///pom.write profile))
- _ (///dependency/deployment.one repository [identity ///artifact/type.lux_library]
- {#///package.origin (#///origin.Local "")
- #///package.library (let [library (binary.run tar.writer package)]
- [library (///dependency/status.verified library)])
- #///package.pom [pom
- (|> pom
- (\ xml.codec encode)
- (\ encoding.utf8 encode)
- ///dependency/status.verified)]})]
+ _ (///dependency/deployment.one repository
+ [identity ///artifact/type.lux_library]
+ (let [pom_data (|> pom
+ (\ xml.codec encode)
+ (\ encoding.utf8 encode))]
+ {#///package.origin (#///origin.Local "")
+ #///package.library (let [library (binary.run tar.writer package)]
+ [library (///dependency/status.verified library)])
+ #///package.pom [pom
+ pom_data
+ (///dependency/status.verified pom_data)]}))]
(console.write_line //clean.success console))
_
diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux
index 1f3e776a9..04b82d7e2 100644
--- a/stdlib/source/program/aedifex/dependency/deployment.lux
+++ b/stdlib/source/program/aedifex/dependency/deployment.lux
@@ -32,7 +32,11 @@
["#." package (#+ Package)]
["#." artifact (#+ Artifact)
["#/." type]
- ["#/." extension (#+ Extension)]]
+ ["#/." extension (#+ Extension)]
+ ["#/." versioning]
+ ["#/." snapshot
+ ["#/." version (#+ Version)
+ ["#/." value]]]]
["#." metadata
["#/." artifact]
["#/." snapshot]]
@@ -42,9 +46,9 @@
["#." repository (#+ Repository)
["#/." origin]]])
-(def: (with_status repository [artifact type] [data status])
- (-> (Repository Promise) Dependency [Binary Status] (Promise (Try Any)))
- (let [artifact (format (///artifact.uri artifact)
+(def: (with_status repository version_template [artifact type] [data status])
+ (-> (Repository Promise) ///artifact.Version Dependency [Binary Status] (Promise (Try Any)))
+ (let [artifact (format (///artifact.uri version_template artifact)
(///artifact/extension.extension type))
deploy_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any))))
(function (_ codec extension hash)
@@ -91,29 +95,44 @@
(def: #export (one repository [artifact type] package)
(-> (Repository Promise) Dependency Package (Promise (Try Artifact)))
(do {! promise.monad}
- [now (promise.future instant.now)]
+ [now (promise.future instant.now)
+ #let [version_template (get@ #///artifact.version artifact)]]
(do (try.with !)
- [_ (with_status repository [artifact type] (get@ #///package.library package))
+ [_ (with_status repository version_template [artifact type] (get@ #///package.library package))
- _ (let [[pom status] (get@ #///package.pom package)]
+ _ (let [[pom pom_data status] (get@ #///package.pom package)]
(with_status repository
+ version_template
[artifact ///artifact/type.pom]
- [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
+ [pom_data
status]))
snapshot (///metadata/snapshot.read repository artifact)
+ #let [snapshot (|> snapshot
+ (update@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot]
+ (function (_ snapshot)
+ (case snapshot
+ #///artifact/snapshot.Local
+ #///artifact/snapshot.Local
+
+ (#///artifact/snapshot.Remote [_ build])
+ (#///artifact/snapshot.Remote [now (inc build)]))))
+ (set@ [#///metadata/snapshot.versioning #///artifact/versioning.last_updated] now))
+ versioning_snapshot (get@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot] snapshot)]
_ (|> snapshot
- (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.time_stamp] now)
- (update@ [#///metadata/snapshot.versioning #///metadata/snapshot.build] inc)
- (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.snapshot]
- (list\compose (..artifacts type (product.right (get@ #///package.library package)))
- (..artifacts ///artifact/type.pom (product.right (get@ #///package.pom package)))))
+ (set@ [#///metadata/snapshot.versioning #///artifact/versioning.versions]
+ (list {#///artifact/snapshot/version.extension type
+ #///artifact/snapshot/version.value (///artifact/snapshot/version/value.format
+ {#///artifact/snapshot/version/value.version version_template
+ #///artifact/snapshot/version/value.snapshot versioning_snapshot})
+ #///artifact/snapshot/version.updated now}))
+ ## (set@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot]
+ ## (list\compose (..artifacts type (product.right (get@ #///package.library package)))
+ ## (..artifacts ///artifact/type.pom (product.right (get@ #///package.pom package)))))
(///metadata/snapshot.write repository artifact))
-
project (///metadata/artifact.read repository artifact)
- #let [version (get@ #///artifact.version artifact)]
_ (|> project
- (set@ #///metadata/artifact.versions (list version))
+ (set@ #///metadata/artifact.versions (list version_template))
(set@ #///metadata/artifact.last_updated now)
(///metadata/artifact.write repository artifact))]
(wrap artifact))))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index e6b24b152..1be540298 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -1,12 +1,13 @@
(.module:
[lux (#- Name)
+ ["." debug]
["." host (#+ import:)]
[abstract
[codec (#+ Codec)]
[equivalence (#+ Equivalence)]
[monad (#+ Monad do)]]
[control
- ["." try (#+ Try)]
+ ["." try (#+ Try) ("#\." functor)]
["." exception (#+ Exception exception:)]
["<>" parser
["<.>" xml (#+ Parser)]]
@@ -16,14 +17,15 @@
["." binary (#+ Binary)]
["." name]
["." maybe]
- [text
+ ["." text
["%" format (#+ format)]
["." encoding]]
[format
["." xml (#+ Tag XML)]]
[collection
["." dictionary (#+ Dictionary)]
- ["." set]]]
+ ["." set]
+ ["." list ("#\." functor monoid)]]]
[math
[number
["n" nat]
@@ -38,11 +40,17 @@
["#." hash (#+ Hash SHA-1 MD5)]
["#." pom]
["#." package (#+ Package)]
- ["#." artifact (#+ Artifact)
- ["#/." extension (#+ Extension)]]
+ ["#." artifact (#+ Version Artifact)
+ ["#/." extension (#+ Extension)]
+ ["#/." versioning]
+ ["." snapshot
+ [version
+ ["." value]]]]
["#." repository (#+ Repository)
["#/." remote (#+ Address)]
- ["#/." origin (#+ Origin)]]]])
+ ["#/." origin (#+ Origin)]]
+ ["#." metadata
+ ["#/." snapshot]]]])
(template [<name>]
[(exception: #export (<name> {artifact Artifact} {extension Extension} {hash Text})
@@ -55,19 +63,30 @@
[md5_does_not_match]
)
-(def: (verified_hash library repository artifact extension hash codec exception)
+(import: java/lang/String
+ ["#::."
+ (trim [] java/lang/String)])
+
+(def: (verified_hash library repository version_template artifact extension hash codec exception)
(All [h]
- (-> Binary (Repository Promise) Artifact Extension
+ (-> Binary (Repository Promise) Version Artifact Extension
(-> Binary (Hash h)) (Codec Text (Hash h))
(Exception [Artifact Extension Text])
(Promise (Try (Maybe (Hash h))))))
(do promise.monad
- [?actual (\ repository download (///repository/remote.uri artifact extension))]
+ [?actual (\ repository download (///repository/remote.uri version_template artifact extension))]
(case ?actual
(#try.Success actual)
- (wrap (do try.monad
- [output (\ encoding.utf8 decode actual)
- actual (\ codec decode output)
+ (wrap (do {! try.monad}
+ [output (\ ! map (|>> (:coerce java/lang/String)
+ java/lang/String::trim
+ (:coerce Text))
+ (\ encoding.utf8 decode actual))
+ actual (|> output
+ (text.split_all_with " ")
+ list.head
+ (maybe.default output)
+ (\ codec decode))
_ (exception.assert exception [artifact extension output]
(\ ///hash.equivalence = (hash library) actual))]
(wrap (#.Some actual))))
@@ -75,15 +94,15 @@
(#try.Failure error)
(wrap (#try.Success #.None)))))
-(def: (hashed repository artifact extension)
- (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status])))
+(def: (hashed repository version_template artifact extension)
+ (-> (Repository Promise) Version Artifact Extension (Promise (Try [Binary Status])))
(do (try.with promise.monad)
- [data (\ repository download (///repository/remote.uri artifact extension))
+ [data (\ repository download (///repository/remote.uri version_template artifact extension))
?sha-1 (..verified_hash data
- repository artifact (format extension ///artifact/extension.sha-1)
+ repository version_template artifact (format extension ///artifact/extension.sha-1)
///hash.sha-1 ///hash.sha-1_codec ..sha-1_does_not_match)
?md5 (..verified_hash data
- repository artifact (format extension ///artifact/extension.md5)
+ repository version_template artifact (format extension ///artifact/extension.md5)
///hash.md5 ///hash.md5_codec ..md5_does_not_match)]
(wrap [data (case [?sha-1 ?md5]
[(#.Some sha-1) (#.Some md5)]
@@ -103,16 +122,21 @@
(let [[artifact type] dependency
extension (///artifact/extension.extension type)]
(do (try.with promise.monad)
- [[pom pom_status] (..hashed repository artifact ///artifact/extension.pom)
- library_&_status (..hashed repository artifact extension)]
+ [snapshot (///metadata/snapshot.read repository artifact)
+ #let [version_template (get@ [#///metadata/snapshot.artifact #///artifact.version] snapshot)
+ artifact_version (value.format {#value.version version_template
+ #value.snapshot (get@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot] snapshot)})
+ artifact (set@ #///artifact.version artifact_version artifact)]
+ [pom_data pom_status] (..hashed repository version_template artifact ///artifact/extension.pom)
+ library_&_status (..hashed repository version_template artifact extension)]
(\ promise.monad wrap
(do try.monad
- [pom (\ encoding.utf8 decode pom)
+ [pom (\ encoding.utf8 decode pom_data)
pom (\ xml.codec decode pom)
- profile (<xml>.run ///pom.parser pom)]
+ profile (<xml>.run ///pom.parser (list pom))]
(wrap {#///package.origin (#///repository/origin.Remote "")
#///package.library library_&_status
- #///package.pom [pom pom_status]}))))))
+ #///package.pom [pom pom_data pom_status]}))))))
(type: #export Resolution
(Dictionary Dependency Package))
@@ -149,21 +173,54 @@
(any alternatives dependency)))))
(def: #export (all repositories dependencies resolution)
- (-> (List (Repository Promise)) (List Dependency) Resolution (Promise (Try Resolution)))
- (case dependencies
- #.Nil
- (\ (try.with promise.monad) wrap resolution)
-
- (#.Cons head tail)
- (do (try.with promise.monad)
- [package (case (dictionary.get head resolution)
- (#.Some package)
- (wrap package)
-
- #.None
- (..any repositories head))
- sub_dependencies (\ promise.monad wrap (///package.dependencies package))
- resolution (|> resolution
- (dictionary.put head package)
- (all repositories (set.to_list sub_dependencies)))]
- (all repositories tail resolution))))
+ (-> (List (Repository Promise)) (List Dependency) Resolution
+ (Promise [(List Dependency)
+ (List Dependency)
+ Resolution]))
+ (loop [repositories repositories
+ successes (: (List Dependency) (list))
+ failures (: (List Dependency) (list))
+ dependencies dependencies
+ resolution resolution]
+ (case dependencies
+ #.Nil
+ (\ promise.monad wrap
+ [successes failures resolution])
+
+ (#.Cons head tail)
+ (case (get@ [#//.artifact #///artifact.version] head)
+ ## Skip if there is no version
+ "" (recur repositories
+ successes
+ failures
+ tail
+ resolution)
+ _ (do promise.monad
+ [?package (case (dictionary.get head resolution)
+ (#.Some package)
+ (wrap (#try.Success package))
+
+ #.None
+ (..any repositories head))]
+ (case ?package
+ (#try.Success package)
+ (let [sub_dependencies (|> package
+ ///package.dependencies
+ (try\map set.to_list)
+ (try.default (list)))
+ sub_repositories (|> package
+ ///package.repositories
+ (try\map set.to_list)
+ (try.default (list))
+ (list\map (|>> (///repository/remote.repository #.None)
+ ///repository.async))
+ (list\compose repositories))]
+ (|> resolution
+ (dictionary.put head package)
+ (recur sub_repositories
+ (#.Cons head successes)
+ failures
+ sub_dependencies)))
+
+ (#try.Failure error)
+ (wrap [successes (#.Cons head failures) resolution])))))))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index 279973c1a..bf8c0f780 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -7,7 +7,7 @@
[net
["." uri (#+ URI)]]]]
["." // #_
- ["#." artifact (#+ Artifact)]])
+ ["#." artifact (#+ Version Artifact)]])
(def: / uri.separator)
@@ -15,7 +15,6 @@
URI
(format ".m2" / "repository"))
-(def: #export uri
- (-> Artifact URI)
- (|>> //artifact.uri
- (format ..repository /)))
+(def: #export (uri version artifact)
+ (-> Version Artifact URI)
+ (format ..repository / (//artifact.uri version artifact)))
diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux
index 0eca976c0..08dab9ed3 100644
--- a/stdlib/source/program/aedifex/metadata.lux
+++ b/stdlib/source/program/aedifex/metadata.lux
@@ -3,6 +3,10 @@
[world
[file (#+ Path)]]])
-(def: #export file
+(def: #export remote_file
Path
"maven-metadata.xml")
+
+(def: #export local_file
+ Path
+ "maven-metadata-local.xml")
diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux
index c1d98a8b5..811713427 100644
--- a/stdlib/source/program/aedifex/metadata/artifact.lux
+++ b/stdlib/source/program/aedifex/metadata/artifact.lux
@@ -173,7 +173,7 @@
(let [/ uri.separator
group (///artifact.directory / (get@ #///artifact.group artifact))
name (get@ #///artifact.name artifact)]
- (%.format group / name / //.file)))
+ (%.format group / name / //.remote_file)))
(def: epoch
Instant
@@ -189,7 +189,7 @@
(do> try.monad
[(\ encoding.utf8 decode)]
[(\ xml.codec decode)]
- [(<xml>.run ..parser)])))
+ [list (<xml>.run ..parser)])))
(#try.Failure error)
(wrap (#try.Success
diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux
index 99ad25470..fa1bcb750 100644
--- a/stdlib/source/program/aedifex/metadata/snapshot.lux
+++ b/stdlib/source/program/aedifex/metadata/snapshot.lux
@@ -4,7 +4,7 @@
[monad (#+ do)]
[equivalence (#+ Equivalence)]]
[control
- [pipe (#+ do>)]
+ [pipe (#+ do> case>)]
["." try (#+ Try)]
["." exception (#+ exception:)]
["<>" parser
@@ -33,96 +33,25 @@
[net
["." uri (#+ URI)]]]]
["." //
- ["." artifact]
["/#" // #_
[repository (#+ Repository)]
["#." artifact (#+ Group Name Version Artifact)
- ["#/." type (#+ Type)]]]])
-
-(def: snapshot
- "SNAPSHOT")
-
-(type: #export Time_Stamp
- Instant)
-
-(type: #export Build
- Nat)
-
-(type: #export Versioning
- {#time_stamp Time_Stamp
- #build Build
- #snapshot (List Type)})
-
-(type: #export Value
- [Version Time_Stamp Build])
+ ["#/." type (#+ Type)]
+ ["#/." versioning (#+ Versioning)]
+ ["#/." snapshot
+ ["#/." version]]]]])
(type: #export Metadata
{#artifact Artifact
#versioning Versioning})
-(def: (pad value)
- (-> Nat Text)
- (if (n.< 10 value)
- (%.format "0" (%.nat value))
- (%.nat value)))
-
-(def: (date_format value)
- (%.Format Date)
- (%.format (|> value date.year year.value .nat %.nat)
- (|> value date.month month.number ..pad)
- (|> value date.day_of_month ..pad)))
-
-(def: (time_format value)
- (%.Format Time)
- (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)]
- (%.format (..pad hour)
- (..pad minute)
- (..pad second))))
-
-(def: (instant_format value)
- (%.Format Instant)
- (%.format (..date_format (instant.date value))
- (..time_format (instant.time value))))
-
-(template [<separator> <name>]
- [(def: <name>
- <separator>)]
-
- ["." time_stamp_separator]
- ["-" value_separator]
- )
-
-(def: (time_stamp_format value)
- (%.Format Time_Stamp)
- (%.format (..date_format (instant.date value))
- ..time_stamp_separator
- (..time_format (instant.time value))))
-
-(def: (value_format [version time_stamp build])
- (%.Format Value)
- (%.format (text.replace_all ..snapshot
- (..time_stamp_format time_stamp)
- version)
- ..value_separator
- (%.nat build)))
-
(template [<definition> <tag>]
[(def: <definition> xml.Tag ["" <tag>])]
[<group> "groupId"]
[<name> "artifactId"]
[<version> "version"]
- [<last_updated> "lastUpdated"]
[<metadata> "metadata"]
- [<versioning> "versioning"]
- [<snapshot> "snapshot"]
- [<timestamp> "timestamp"]
- [<build_number> "buildNumber"]
- [<snapshot_versions> "snapshotVersions"]
- [<snapshot_version> "snapshotVersion"]
- [<extension> "extension"]
- [<value> "value"]
- [<updated> "updated"]
)
(template [<name> <type> <tag> <pre>]
@@ -133,33 +62,8 @@
[format_group Group ..<group> (|>)]
[format_name Name ..<name> (|>)]
[format_version Version ..<version> (|>)]
- [format_last_updated Instant ..<last_updated> ..instant_format]
- [format_time_stamp Instant ..<timestamp> ..time_stamp_format]
- [format_build_number Nat ..<build_number> %.nat]
- [format_extension Type ..<extension> (|>)]
- [format_value Value ..<value> ..value_format]
- [format_updated Instant ..<updated> ..instant_format]
)
-(def: (format_snapshot value type)
- (-> Value Type XML)
- (<| (#xml.Node ..<snapshot_version> xml.attributes)
- (list (..format_extension type)
- (..format_value value)
- (let [[version time_stamp build] value]
- (..format_updated time_stamp)))))
-
-(def: (format_versioning version (^slots [#time_stamp #build #snapshot]))
- (-> Version Versioning XML)
- (<| (#xml.Node ..<versioning> xml.attributes)
- (list (<| (#xml.Node ..<snapshot> xml.attributes)
- (list (..format_time_stamp time_stamp)
- (..format_build_number build)))
- (..format_last_updated time_stamp)
- (<| (#xml.Node ..<snapshot_versions> xml.attributes)
- (list\map (..format_snapshot [version time_stamp build])
- snapshot)))))
-
(def: #export (format (^slots [#artifact #versioning]))
(-> Metadata XML)
(let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
@@ -168,7 +72,7 @@
(list (..format_group group)
(..format_name name)
(..format_version version)
- (..format_versioning version versioning)))))
+ (///artifact/versioning.format versioning)))))
(def: (sub tag parser)
(All [a] (-> xml.Tag (Parser a) (Parser a)))
@@ -180,135 +84,46 @@
(-> xml.Tag (Parser Text))
(..sub tag <xml>.text))
-(def: date_parser
- (<text>.Parser Date)
- (do <>.monad
- [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal))
- year (<>.lift (year.year (.int year)))
- month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
- month (<>.lift (month.by_number month))
- day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))]
- (<>.lift (date.date year month day_of_month))))
-
-(def: time_parser
- (<text>.Parser Time)
- (do <>.monad
- [hour (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
- minute (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
- second (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))]
- (<>.lift (time.time
- {#time.hour hour
- #time.minute minute
- #time.second second
- #time.milli_second 0}))))
-
-(def: last_updated_parser
- (Parser Instant)
- (<text>.embed (do <>.monad
- [date ..date_parser
- time ..time_parser]
- (wrap (instant.from_date_time date time)))
- (..text ..<last_updated>)))
-
-(def: time_stamp_parser
- (Parser Time_Stamp)
- (<text>.embed (do <>.monad
- [date ..date_parser
- _ (<text>.this ..time_stamp_separator)
- time ..time_parser]
- (wrap (instant.from_date_time date time)))
- (..text ..<timestamp>)))
-
-(def: build_parser
- (Parser Build)
- (<text>.embed (<>.codec n.decimal
- (<text>.many <text>.decimal))
- (..text ..<build_number>)))
-
-(exception: #export (time_stamp_mismatch {expected Time_Stamp} {actual Text})
- (exception.report
- ["Expected time-stamp" (instant_format expected)]
- ["Actual time-stamp" actual]))
-
-(exception: #export (value_mismatch {expected Value} {actual Text})
- (exception.report
- ["Expected" (..value_format expected)]
- ["Actual" actual]))
-
-(def: (snapshot_parser expected)
- (-> Value (Parser Type))
- (<| (..sub ..<snapshot_version>)
- (do <>.monad
- [#let [[version time_stamp build] expected]
- updated (<xml>.somewhere (..text ..<updated>))
- _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp updated])
- (\ text.equivalence = (instant_format time_stamp) updated))
- actual (<xml>.somewhere (..text ..<value>))
- _ (<>.assert (exception.construct ..value_mismatch [expected actual])
- (\ text.equivalence = (..value_format expected) actual))]
- (<xml>.somewhere (..text ..<extension>)))))
-
-(def: (versioning_parser version)
- (-> Version (Parser Versioning))
- (<| (..sub ..<versioning>)
- (do <>.monad
- [[time_stamp build] (<| <xml>.somewhere
- (..sub ..<snapshot>)
- (<>.and (<xml>.somewhere ..time_stamp_parser)
- (<xml>.somewhere ..build_parser)))
- last_updated (<xml>.somewhere ..last_updated_parser)
- _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp (instant_format last_updated)])
- (\ instant.equivalence = time_stamp last_updated))
- snapshot (<| <xml>.somewhere
- (..sub ..<snapshot_versions>)
- (<>.some (..snapshot_parser [version time_stamp build])))]
- (wrap {#time_stamp time_stamp
- #build build
- #snapshot snapshot}))))
-
(def: #export parser
(Parser Metadata)
(<| (..sub ..<metadata>)
- (do <>.monad
+ (do {! <>.monad}
[group (<xml>.somewhere (..text ..<group>))
name (<xml>.somewhere (..text ..<name>))
version (<xml>.somewhere (..text ..<version>))
- versioning (<xml>.somewhere (..versioning_parser version))]
+ versioning (\ ! map
+ (update@ #///artifact/versioning.versions
+ (: (-> (List ///artifact/snapshot/version.Version)
+ (List ///artifact/snapshot/version.Version))
+ (|>> (case> (^ (list))
+ (list {#///artifact/snapshot/version.extension ///artifact/type.jvm_library
+ #///artifact/snapshot/version.value version
+ #///artifact/snapshot/version.updated instant.epoch})
+
+ versions
+ versions))))
+ (<xml>.somewhere ///artifact/versioning.parser))]
(wrap {#artifact {#///artifact.group group
#///artifact.name name
#///artifact.version version}
#versioning versioning}))))
-(def: versioning_equivalence
- (Equivalence Versioning)
- ($_ product.equivalence
- instant.equivalence
- n.equivalence
- (list.equivalence text.equivalence)
- ))
-
(def: #export equivalence
(Equivalence Metadata)
($_ product.equivalence
///artifact.equivalence
- ..versioning_equivalence
+ ///artifact/versioning.equivalence
))
(def: #export (uri artifact)
(-> Artifact URI)
(let [/ uri.separator
- version (get@ #///artifact.version artifact)
- artifact (///artifact.uri artifact)]
- (%.format artifact / version / //.file)))
-
-(def: epoch
- Instant
- (instant.from_millis +0))
-
-(def: init_versioning
- {#time_stamp ..epoch
- #build 0
- #snapshot (list)})
+ group (|> artifact
+ (get@ #///artifact.group)
+ (///artifact.directory /))
+ name (get@ #///artifact.name artifact)
+ version (get@ #///artifact.version artifact)]
+ (%.format group / name / version / //.remote_file)))
(def: #export (read repository artifact)
(-> (Repository Promise) Artifact (Promise (Try Metadata)))
@@ -320,12 +135,12 @@
(do> try.monad
[(\ encoding.utf8 decode)]
[(\ xml.codec decode)]
- [(<xml>.run ..parser)])))
+ [list (<xml>.run ..parser)])))
(#try.Failure error)
(wrap (#try.Success
{#artifact artifact
- #versioning ..init_versioning})))))
+ #versioning ///artifact/versioning.init})))))
(def: #export (write repository artifact metadata)
(-> (Repository Promise) Artifact Metadata (Promise (Try Any)))
diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux
index f6ba87078..445c92987 100644
--- a/stdlib/source/program/aedifex/package.lux
+++ b/stdlib/source/program/aedifex/package.lux
@@ -10,6 +10,8 @@
["." sum]
["." product]
["." binary (#+ Binary)]
+ [text
+ ["." encoding]]
[format
["." xml (#+ XML)]]
[collection
@@ -21,12 +23,13 @@
[dependency (#+ Dependency)
["#." status (#+ Status)]]
[repository
+ [remote (#+ Address)]
["#." origin (#+ Origin)]]])
(type: #export Package
{#origin Origin
#library [Binary Status]
- #pom [XML Status]})
+ #pom [XML Binary Status]})
(template [<name> <tag>]
[(def: #export (<name> package)
@@ -46,19 +49,35 @@
(-> XML Binary Package)
{#origin (#//origin.Local "")
#library [library #//status.Unverified]
- #pom [pom #//status.Unverified]})
+ #pom [pom
+ (|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
+ #//status.Unverified]})
(def: #export dependencies
(-> Package (Try (Set Dependency)))
(|>> (get@ #pom)
product.left
+ list
(<xml>.run //pom.parser)
(try\map (get@ #/.dependencies))))
+(def: #export repositories
+ (-> Package (Try (Set Address)))
+ (|>> (get@ #pom)
+ product.left
+ list
+ (<xml>.run //pom.parser)
+ (try\map (get@ #/.repositories))))
+
(def: #export equivalence
(Equivalence Package)
($_ product.equivalence
//origin.equivalence
- (product.equivalence binary.equivalence //status.equivalence)
- (product.equivalence xml.equivalence //status.equivalence)
+ ($_ product.equivalence
+ binary.equivalence
+ //status.equivalence)
+ ($_ product.equivalence
+ xml.equivalence
+ binary.equivalence
+ //status.equivalence)
))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 4a21b341a..411b4665b 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -171,6 +171,9 @@
(<>.and <c>.text
..repository))))
+(def: default_repository
+ "https://repo1.maven.org/maven2/")
+
(def: profile
(Parser /.Profile)
(do {! <>.monad}
@@ -190,7 +193,8 @@
^repositories (: (Parser (Set //repository.Address))
(|> (..plural input "repositories" ..repository)
(\ ! map (set.from_list text.hash))
- (<>.default (set.new text.hash))))
+ (<>.default (set.new text.hash))
+ (\ ! map (set.add ..default_repository))))
^dependencies (: (Parser (Set //dependency.Dependency))
(|> (..plural input "dependencies" ..dependency)
(\ ! map (set.from_list //dependency.hash))
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index f085e2808..f105f07b6 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -11,6 +11,7 @@
[data
["." name]
["." maybe ("#\." functor)]
+ ["." text]
[format
["_" xml (#+ Tag XML)]]
[collection
@@ -150,8 +151,8 @@
(<>.and <xml>.tag
(<xml>.children <xml>.text)))
-(def: parse_dependency
- (Parser Dependency)
+(def: (parse_dependency own_version parent_version)
+ (-> Text Text (Parser Dependency))
(do {! <>.monad}
[properties (\ ! map (dictionary.from_list name.hash)
(<xml>.children (<>.some ..parse_property)))]
@@ -159,28 +160,47 @@
try.from_maybe
(do maybe.monad
[group (dictionary.get ["" ..group_tag] properties)
- artifact (dictionary.get ["" ..artifact_tag] properties)
- version (dictionary.get ["" ..version_tag] properties)]
+ artifact (dictionary.get ["" ..artifact_tag] properties)]
(wrap {#//dependency.artifact {#//artifact.group group
#//artifact.name artifact
- #//artifact.version version}
+ #//artifact.version (|> properties
+ (dictionary.get ["" ..version_tag])
+ (maybe.default "")
+ (text.replace_all "${project.version}" own_version)
+ (text.replace_all "${project.parent.version}" parent_version))}
#//dependency.type (|> properties
(dictionary.get ["" "type"])
- (maybe.default //artifact/type.lux_library))})))))
+ (maybe.default //artifact/type.jvm_library))})))))
-(def: parse_dependencies
- (Parser (List Dependency))
+(def: (parse_dependencies own_version parent_version)
+ (-> Text Text (Parser (List Dependency)))
(do {! <>.monad}
[_ (<xml>.node ["" ..dependencies_tag])]
- (<xml>.children (<>.some ..parse_dependency))))
+ (<xml>.children (<>.some (..parse_dependency own_version parent_version)))))
+
+(def: own_version
+ (Parser Text)
+ (do <>.monad
+ [_ (<xml>.node ["" ..version_tag])]
+ (<xml>.children <xml>.text)))
+
+(def: parent_version
+ (Parser Text)
+ (do <>.monad
+ [_ (<xml>.node ["" "parent"])]
+ ..own_version))
(def: #export parser
(Parser /.Profile)
(do {! <>.monad}
- [_ (<xml>.node ["" ..project_tag])]
+ [own_version (<>.default "" (<xml>.somewhere ..own_version))
+ parent_version (<>.default "" (<xml>.somewhere ..parent_version))
+ _ (<xml>.node ["" ..project_tag])]
(<xml>.children
(do !
- [dependencies (<xml>.somewhere ..parse_dependencies)
+ [dependencies (|> (..parse_dependencies own_version parent_version)
+ <xml>.somewhere
+ (<>.default (list)))
_ (<>.some <xml>.ignore)]
(wrap (|> (\ /.monoid identity)
(update@ #/.dependencies (function (_ empty)
diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux
index f313b3176..7ac384efa 100644
--- a/stdlib/source/program/aedifex/repository/local.lux
+++ b/stdlib/source/program/aedifex/repository/local.lux
@@ -19,7 +19,8 @@
["." uri (#+ URI)]]]]
["." //
["/#" // #_
- ["#." local]]])
+ ["#." local]
+ ["#." metadata]]])
(def: (root /)
(-> Text Path)
@@ -29,18 +30,23 @@
(-> Text URI Path)
(text.replace_all uri.separator))
-(def: (file program system uri)
+(def: (file program system create? uri)
(-> (Program Promise)
(file.System Promise)
+ Bit
URI
(Promise (Try (File Promise))))
(do {! promise.monad}
- [home (\ program home [])
+ [#let [uri (text.replace_once ///metadata.remote_file ///metadata.local_file uri)]
+ home (\ program home [])
#let [/ (\ system separator)
absolute_path (format home / (..root /) / (..path / uri))]]
- (do {! (try.with !)}
- [_ (: (Promise (Try Path))
- (file.make_directories promise.monad system (file.parent system absolute_path)))]
+ (if create?
+ (do {! (try.with !)}
+ [_ (: (Promise (Try Path))
+ (file.make_directories promise.monad system (file.parent system absolute_path)))]
+ (: (Promise (Try (File Promise)))
+ (file.get_file promise.monad system absolute_path)))
(: (Promise (Try (File Promise)))
(!.use (\ system file) absolute_path)))))
@@ -49,10 +55,10 @@
(def: (download uri)
(do {! (try.with promise.monad)}
- [file (..file program system uri)]
+ [file (..file program system false uri)]
(!.use (\ file content) [])))
(def: (upload uri content)
(do {! (try.with promise.monad)}
- [file (..file program system uri)]
+ [file (..file program system true uri)]
(!.use (\ file over_write) [content]))))
diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux
index 4979e5429..4b61bc36c 100644
--- a/stdlib/source/program/aedifex/repository/remote.lux
+++ b/stdlib/source/program/aedifex/repository/remote.lux
@@ -26,7 +26,7 @@
["." //
["#." identity (#+ Identity)]
["/#" // #_
- ["#." artifact (#+ Artifact)
+ ["#." artifact (#+ Version Artifact)
[extension (#+ Extension)]]]])
(type: #export Address
@@ -75,9 +75,9 @@
(exception.report
["Code" (%.int code)]))
-(def: #export (uri artifact extension)
- (-> Artifact Extension URI)
- (format (///artifact.uri artifact) extension))
+(def: #export (uri version_template artifact extension)
+ (-> Version Artifact Extension URI)
+ (format (///artifact.uri version_template artifact) extension))
(def: buffer_size
(n.* 512 1,024))
@@ -99,19 +99,21 @@
input (|> connection
java/net/URLConnection::getInputStream
(\ ! map (|>> java/io/BufferedInputStream::new)))
- #let [buffer (binary.create ..buffer_size)]]
- (loop [output (\ binary.monoid identity)]
- (do !
- [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)]
- (case bytes_read
- -1 (do !
- [_ (java/lang/AutoCloseable::close input)]
- (wrap output))
- _ (if (n.= ..buffer_size bytes_read)
- (recur (\ binary.monoid compose output buffer))
+ #let [buffer (binary.create ..buffer_size)]
+ output (loop [output (\ binary.monoid identity)]
(do !
- [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes_read) buffer))]
- (recur (\ binary.monoid compose output chunk)))))))))
+ [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)]
+ (case bytes_read
+ -1 (do !
+ [_ (java/lang/AutoCloseable::close input)]
+ (wrap output))
+ +0 (recur output)
+ _ (if (n.= ..buffer_size bytes_read)
+ (recur (\ binary.monoid compose output buffer))
+ (do !
+ [chunk (\ io.monad wrap (binary.slice 0 (dec (.nat bytes_read)) buffer))]
+ (recur (\ binary.monoid compose output chunk)))))))]
+ (wrap output)))
(def: (upload uri content)
(case identity
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index 7d91ebed7..9d2cf9069 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -21,11 +21,9 @@
["." / #_
["#." type]
["#." extension]
- ["#." value]
+ ["#." time]
["#." versioning]
- ["#." time_stamp
- ["#/." date]
- ["#/." time]]]
+ ["#." snapshot]]
{#program
["." /]})
@@ -47,9 +45,7 @@
/type.test
/extension.test
- /value.test
+ /time.test
/versioning.test
- /time_stamp.test
- /time_stamp/date.test
- /time_stamp/time.test
+ /snapshot.test
))))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index f1200381a..a39671ea4 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -93,38 +93,9 @@
(check_neighbors odd? value)
(check_neighbors even? value))))))
-(type: (Choice a)
- (-> a a a))
-
-(type: (Order a)
- (-> a a Bit))
-
(type: (Equivalence a)
(-> a a Bit))
-(def: (choice rand_gen = [< choose])
- (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test))
- (do random.monad
- [left rand_gen
- right rand_gen
- #let [choice (choose left right)]]
- ($_ _.and
- (_.test "The choice between 2 values is one of them."
- (or (= left choice)
- (= right choice)))
- (_.test "The choice between 2 values implies an order relationship between them."
- (if (= left choice)
- (< right choice)
- (< left choice))))))
-
-(def: (minimum_and_maximum rand_gen = min' max')
- (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] [(Order a) (Choice a)] Test))
- ($_ _.and
- (<| (_.context "Minimum.")
- (choice rand_gen = min'))
- (<| (_.context "Maximum.")
- (choice rand_gen = max'))))
-
(def: (conversion rand_gen forward backward =)
(All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test))
(do random.monad
@@ -213,6 +184,18 @@
@.js on_valid_host}
on_default))))))
+(def: conversion_tests
+ Test
+ (`` ($_ _.and
+ (~~ (template [<=> <forward> <backward> <gen>]
+ [(<| (_.context (format (%.name (name_of <forward>))
+ " " (%.name (name_of <backward>))))
+ (..conversion <gen> <forward> <backward> <=>))]
+
+ [i.= .nat .int (random\map (i.% +1,000,000) random.int)]
+ [n.= .int .nat (random\map (n.% 1,000,000) random.nat)]
+ )))))
+
(def: sub_tests
Test
(let [tail (: (List Test)
@@ -236,6 +219,7 @@
))))
(def: test
+ Test
(<| (_.context (name.module (name_of /._)))
($_ _.and
(<| (_.context "Identity.")
@@ -248,30 +232,8 @@
(..even_or_odd random.nat n.even? n.odd?))
(<| (_.context "Integers.")
(..even_or_odd random.int i.even? i.odd?))))
- (<| (_.context "Minimum and maximum.")
- (`` ($_ _.and
- (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>]
- [(<| (_.context <context>)
- (..minimum_and_maximum <gen> <=> [<lt> <min>] [<gt> <max>]))]
-
- [i.= i.< i.min i.> i.max random.int "Integers."]
- [n.= n.< n.min n.> n.max random.nat "Natural numbers."]
- [r.= r.< r.min r.> r.max random.rev "Revolutions."]
- [f.= f.< f.min f.> f.max random.safe_frac "Fractions."]
- )))))
(<| (_.context "Conversion.")
- (`` ($_ _.and
- (~~ (template [<=> <forward> <backward> <gen>]
- [(<| (_.context (format (%.name (name_of <forward>))
- " " (%.name (name_of <backward>))))
- (..conversion <gen> <forward> <backward> <=>))]
-
- [i.= .nat .int (random\map (i.% +1,000,000) random.int)]
- [n.= .int .nat (random\map (n.% 1,000,000) random.nat)]
- [i.= i.frac f.int (random\map (i.% +1,000,000) random.int)]
- [f.= f.int i.frac (random\map (|>> (i.% +1,000,000) i.frac) random.int)]
- [r.= r.frac f.rev frac_rev]
- )))))
+ ..conversion_tests)
(<| (_.context "Prelude macros.")
..prelude_macros)
(<| (_.context "Templates.")
diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux
index 62c576d27..e413afc95 100644
--- a/stdlib/source/test/lux/data/name.lux
+++ b/stdlib/source/test/lux/data/name.lux
@@ -42,7 +42,7 @@
(_.for [/.equivalence]
($equivalence.spec /.equivalence (..random sizeM1 sizeS1)))
(_.for [/.hash]
- (|> (random.ascii 2)
+ (|> (random.ascii 1)
(\ ! map (|>> [""]))
($hash.spec /.hash)))
(_.for [/.order]
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index c89ca97ba..983649a89 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -240,7 +240,7 @@
(_.for [/.equivalence]
($equivalence.spec /.equivalence (random.ascii 2)))
(_.for [/.hash]
- (|> (random.ascii 2)
+ (|> (random.ascii 1)
($hash.spec /.hash)))
(_.for [/.order]
($order.spec /.order (random.ascii 2)))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index 0f217e335..730671b5b 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -170,8 +170,12 @@
[/.local_identifier ..random_text #.Identifier]
)))))
(do {! random.monad}
- [[original substitute] (random.and ..random ..random)
- [sample expected] (..replace_simulation [original substitute])]
+ [[original substitute] (random.filter (function (_ [original substitute])
+ (not (\ /.equivalence = original substitute)))
+ (random.and ..random ..random))
+ [sample expected] (random.filter (function (_ [sample expected])
+ (not (\ /.equivalence = sample expected)))
+ (..replace_simulation [original substitute]))]
(_.cover [/.replace]
(\ /.equivalence =
expected
diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux
index b0c69b814..461d5bfac 100644
--- a/stdlib/source/test/lux/math/modular.lux
+++ b/stdlib/source/test/lux/math/modular.lux
@@ -4,6 +4,7 @@
["." type ("#\." equivalence)]
[abstract
[monad (#+ do)]
+ ["." predicate]
{[0 #spec]
[/
["$." equivalence]
@@ -41,7 +42,8 @@
[param\\% ($//.random +1,000,000)
param (..random param\\%)
- subject\\% (random.filter (|>> (//.= param\\%) not)
+ subject\\% (random.filter (predicate.intersect (|>> //.divisor (i.> +2))
+ (|>> (//.= param\\%) not))
($//.random +1,000,000))
subject (..random subject\\%)
another (..random subject\\%)]
diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux
index 54150772e..1a56d8d08 100644
--- a/stdlib/source/test/lux/type/resource.lux
+++ b/stdlib/source/test/lux/type/resource.lux
@@ -1,53 +1,192 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
+ ["." meta]
[abstract
- [monad
+ ["." monad
[indexed (#+ do)]]]
[control
- ["." io]]
+ ["." io]
+ ["." try]
+ ["." exception (#+ Exception)]
+ [concurrency
+ ["." promise]]
+ [parser
+ ["<.>" code]]]
+ [data
+ ["." text ("#\." equivalence)
+ ["%" format (#+ format)]]]
+ ["." macro
+ [syntax (#+ syntax:)]
+ ["." code]]
[math
- [number
- ["n" nat]]]]
+ ["." random]]]
{1
["." / (#+ Res)]})
+(def: pure
+ Test
+ (monad.do {! random.monad}
+ [pre (\ ! map %.nat random.nat)
+ post (\ ! map %.nat random.nat)]
+ (_.for [/.Linear /.pure /.run_pure]
+ (`` ($_ _.and
+ (~~ (template [<coverage> <bindings>]
+ [(_.cover <coverage>
+ (<| (text\= (format pre post))
+ /.run_pure
+ (do /.pure
+ <bindings>
+ (wrap (format left right)))))]
+
+ [[/.Affine /.Key /.Res /.Ordered /.ordered_pure
+ /.Relevant /.read_pure]
+ [res|left (/.ordered_pure pre)
+ res|right (/.ordered_pure post)
+ right (/.read_pure res|right)
+ left (/.read_pure res|left)]]
+ [[/.Commutative /.commutative_pure /.exchange_pure]
+ [res|left (/.commutative_pure pre)
+ res|right (/.commutative_pure post)
+ _ (/.exchange_pure [1 0])
+ left (/.read_pure res|left)
+ right (/.read_pure res|right)]]
+ [[/.group_pure /.un_group_pure]
+ [res|left (/.commutative_pure pre)
+ res|right (/.commutative_pure post)
+ _ (/.group_pure 2)
+ _ (/.un_group_pure 2)
+ right (/.read_pure res|right)
+ left (/.read_pure res|left)]]
+ [[/.lift_pure]
+ [left (/.lift_pure pre)
+ right (/.lift_pure post)]]
+ ))
+ )))))
+
+(def: sync
+ Test
+ (monad.do {! random.monad}
+ [pre (\ ! map %.nat random.nat)
+ post (\ ! map %.nat random.nat)]
+ (_.for [/.Linear /.sync /.run_sync]
+ (`` ($_ _.and
+ (~~ (template [<coverage> <bindings>]
+ [(_.cover <coverage>
+ (<| (text\= (format pre post))
+ io.run
+ /.run_sync
+ (do /.sync
+ <bindings>
+ (wrap (format left right)))))]
+
+ [[/.Affine /.Key /.Res /.Ordered /.ordered_sync
+ /.Relevant /.read_sync]
+ [res|left (/.ordered_sync pre)
+ res|right (/.ordered_sync post)
+ right (/.read_sync res|right)
+ left (/.read_sync res|left)]]
+ [[/.Commutative /.commutative_sync /.exchange_sync]
+ [res|left (/.commutative_sync pre)
+ res|right (/.commutative_sync post)
+ _ (/.exchange_sync [1 0])
+ left (/.read_sync res|left)
+ right (/.read_sync res|right)]]
+ [[/.group_sync /.un_group_sync]
+ [res|left (/.commutative_sync pre)
+ res|right (/.commutative_sync post)
+ _ (/.group_sync 2)
+ _ (/.un_group_sync 2)
+ right (/.read_sync res|right)
+ left (/.read_sync res|left)]]
+ [[/.lift_sync]
+ [left (/.lift_sync (io.io pre))
+ right (/.lift_sync (io.io post))]]
+ ))
+ )))))
+
+(def: async
+ Test
+ (monad.do {! random.monad}
+ [pre (\ ! map %.nat random.nat)
+ post (\ ! map %.nat random.nat)]
+ (_.for [/.Linear /.async /.run_async]
+ (`` ($_ _.and
+ (~~ (template [<coverage> <bindings>]
+ [(wrap (monad.do promise.monad
+ [outcome (/.run_async
+ (do /.async
+ <bindings>
+ (wrap (format left right))))]
+ (_.cover' <coverage>
+ (text\= (format pre post)
+ outcome))))]
+
+ [[/.Affine /.Key /.Res /.Ordered /.ordered_async
+ /.Relevant /.read_async]
+ [res|left (/.ordered_async pre)
+ res|right (/.ordered_async post)
+ right (/.read_async res|right)
+ left (/.read_async res|left)]]
+ [[/.Commutative /.commutative_async /.exchange_async]
+ [res|left (/.commutative_async pre)
+ res|right (/.commutative_async post)
+ _ (/.exchange_async [1 0])
+ left (/.read_async res|left)
+ right (/.read_async res|right)]]
+ [[/.group_async /.un_group_async]
+ [res|left (/.commutative_async pre)
+ res|right (/.commutative_async post)
+ _ (/.group_async 2)
+ _ (/.un_group_async 2)
+ right (/.read_async res|right)
+ left (/.read_async res|left)]]
+ [[/.lift_async]
+ [left (/.lift_async (promise.resolved pre))
+ right (/.lift_async (promise.resolved post))]]
+ ))
+ )))))
+
+(syntax: (with_error {exception <code>.identifier} to_expand)
+ (monad.do meta.monad
+ [[_ _ _ exception] (meta.find_export exception)]
+ (function (_ compiler)
+ (#.Right [compiler
+ (list (code.bit (case ((macro.expand_once to_expand) compiler)
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ true)))]))))
+
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
+ (_.for [/.Procedure])
($_ _.and
- (_.test "Can produce and consume keys in an ordered manner."
- (<| (n.= (n.+ 123 456))
- io.run
- /.run_sync
- (do /.sync
- [res|left (/.ordered_sync 123)
- res|right (/.ordered_sync 456)
- right (/.read_sync res|right)
- left (/.read_sync res|left)]
- (wrap (n.+ left right)))))
- (_.test "Can exchange commutative keys."
- (<| (n.= (n.+ 123 456))
- io.run
- /.run_sync
- (do /.sync
- [res|left (/.commutative_sync 123)
- res|right (/.commutative_sync 456)
- _ (/.exchange_sync [1 0])
- left (/.read_sync res|left)
- right (/.read_sync res|right)]
- (wrap (n.+ left right)))))
- (_.test "Can group and un-group keys."
- (<| (n.= (n.+ 123 456))
- io.run
- /.run_sync
- (do /.sync
- [res|left (/.commutative_sync 123)
- res|right (/.commutative_sync 456)
- _ (/.group_sync 2)
- _ (/.un_group_sync 2)
- right (/.read_sync res|right)
- left (/.read_sync res|left)]
- (wrap (n.+ left right)))))
+ ..pure
+ ..sync
+ ..async
+
+ (_.cover [/.amount_cannot_be_zero]
+ (`` (and (~~ (template [<group|un_group>]
+ [(with_error /.amount_cannot_be_zero
+ (<group|un_group> 0))]
+
+ [/.group_pure]
+ [/.group_sync]
+ [/.group_async]
+ [/.un_group_pure]
+ [/.un_group_sync]
+ [/.un_group_async]
+ )))))
+ (_.cover [/.index_cannot_be_repeated]
+ (`` (and (~~ (template [<exchange>]
+ [(with_error /.index_cannot_be_repeated
+ (<exchange> [0 0]))]
+
+ [/.exchange_pure]
+ [/.exchange_sync]
+ [/.exchange_async]
+ )))))
)))