aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/parser/xml.lux25
-rw-r--r--stdlib/source/lux/data/format/xml.lux5
-rw-r--r--stdlib/source/lux/data/text.lux27
-rw-r--r--stdlib/source/lux/data/text/unicode.lux212
-rw-r--r--stdlib/source/lux/data/text/unicode/set.lux213
-rw-r--r--stdlib/source/lux/macro/syntax/common/check.lux31
-rw-r--r--stdlib/source/lux/math/random.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/syntax.lux469
-rw-r--r--stdlib/source/lux/type/dynamic.lux8
-rw-r--r--stdlib/source/program/aedifex/artifact.lux16
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux118
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux6
-rw-r--r--stdlib/source/program/aedifex/metadata.lux12
-rw-r--r--stdlib/source/program/aedifex/metadata/artifact.lux17
-rw-r--r--stdlib/source/program/aedifex/metadata/snapshot.lux12
-rw-r--r--stdlib/source/program/aedifex/repository.lux104
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux2
-rw-r--r--stdlib/source/test/lux/control/concurrency/thread.lux16
-rw-r--r--stdlib/source/test/lux/control/parser/text.lux3
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux3
-rw-r--r--stdlib/source/test/lux/data/text.lux3
-rw-r--r--stdlib/source/test/lux/data/text/unicode/set.lux (renamed from stdlib/source/test/lux/data/text/unicode.lux)18
-rw-r--r--stdlib/source/test/lux/macro/syntax/common.lux6
-rw-r--r--stdlib/source/test/lux/macro/syntax/common/check.lux35
24 files changed, 795 insertions, 569 deletions
diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux
index bec2b80fe..bc8c6ad93 100644
--- a/stdlib/source/lux/control/parser/xml.lux
+++ b/stdlib/source/lux/control/parser/xml.lux
@@ -22,14 +22,15 @@
(exception: #export empty-input)
(exception: #export unexpected-input)
-(template [<exception> <type> <header> <format>]
- [(exception: #export (<exception> {label <type>})
- (exception.report
- [<header> (%.text (<format> label))]))]
+(exception: #export (wrong-tag {expected Tag} {actual Tag})
+ (exception.report
+ ["Expected" (%.text (/.tag expected))]
+ ["Actual" (%.text (/.tag actual))]))
- [wrong-tag Tag "Tag" /.tag]
- [unknown-attribute Attribute "Attribute" /.attribute]
- )
+(exception: #export (unknown-attribute {expected Attribute} {available (List Attribute)})
+ (exception.report
+ ["Expected" (%.text (/.attribute expected))]
+ ["Available" (exception.enumerate (|>> /.attribute %.text) available)]))
(exception: #export (unconsumed-inputs {inputs (List XML)})
(exception.report
@@ -50,7 +51,7 @@
(#/.Node _)
(exception.throw ..unexpected-input [])))))
-(def: #export (node tag)
+(def: #export (node expected)
(-> Tag (Parser Any))
(function (_ docs)
(case docs
@@ -62,10 +63,10 @@
(#/.Text _)
(exception.throw ..unexpected-input [])
- (#/.Node _tag _attributes _children)
- (if (name\= tag _tag)
+ (#/.Node actual _attributes _children)
+ (if (name\= expected actual)
(#try.Success [docs []])
- (exception.throw ..wrong-tag tag))))))
+ (exception.throw ..wrong-tag [expected actual]))))))
(def: #export tag
(Parser Tag)
@@ -97,7 +98,7 @@
(#/.Node tag attributes children)
(case (dictionary.get name attributes)
#.None
- (exception.throw ..unknown-attribute [name])
+ (exception.throw ..unknown-attribute [name (dictionary.keys attributes)])
(#.Some value)
(#try.Success [docs value]))))))
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index 13f272c4b..4f79fb4c9 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -157,6 +157,10 @@
(..spaced^ (<text>.many xml-char^)))
(<>\map (|>> #Text))))
+(def: null^
+ (Parser Any)
+ (<text>.this (text.from-code 0)))
+
(def: xml^
(Parser XML)
(|> (<>.rec
@@ -181,6 +185,7 @@
## cannot be located inside of XML nodes.
## This way, the comments can only be before or after the main document.
(<>.before (<>.some comment^))
+ (<>.before (<>.some ..null^))
(<>.after (<>.some comment^))
(<>.after (<>.maybe xml-header^))))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 81e6e6bd5..042919c24 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -275,14 +275,19 @@
(def: #export (space? char)
{#.doc "Checks whether the character is white-space."}
(-> Char Bit)
- (`` (case char
- (^or (^ (char (~~ (static ..tab))))
- (^ (char (~~ (static ..vertical-tab))))
- (^ (char (~~ (static ..space))))
- (^ (char (~~ (static ..new-line))))
- (^ (char (~~ (static ..carriage-return))))
- (^ (char (~~ (static ..form-feed)))))
- true
-
- _
- false)))
+ (with-expansions [<options> (template [<char>]
+ [(^ (char (~~ (static <char>))))]
+
+ [..tab]
+ [..vertical-tab]
+ [..space]
+ [..new-line]
+ [..carriage-return]
+ [..form-feed]
+ )]
+ (`` (case char
+ (^or <options>)
+ true
+
+ _
+ false))))
diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux
deleted file mode 100644
index 2aad089b9..000000000
--- a/stdlib/source/lux/data/text/unicode.lux
+++ /dev/null
@@ -1,212 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [equivalence (#+ Equivalence)]]
- [data
- [collection
- ["." list ("#\." fold functor)]
- ["." set ("#\." equivalence)]
- ["." tree #_
- ["#" finger (#+ Tree)]]]]
- [type (#+ :by-example)
- abstract]]
- ["." / #_
- ["#." segment (#+ Segment)]
- [// (#+ Char)]])
-
-(def: builder
- (tree.builder /segment.monoid))
-
-(def: :@:
- (:by-example [@]
- {(tree.Builder @ Segment)
- ..builder}
- @))
-
-(abstract: #export Set
- (Tree :@: Segment [])
-
- (def: #export (compose left right)
- (-> Set Set Set)
- (:abstraction
- (\ builder branch
- (:representation left)
- (:representation right))))
-
- (def: (singleton segment)
- (-> Segment Set)
- (:abstraction
- (\ builder leaf segment [])))
-
- (def: #export (set [head tail])
- (-> [Segment (List Segment)] Set)
- (list\fold ..compose (..singleton head) (list\map ..singleton tail)))
-
- (def: half/0
- (..set [/segment.basic-latin
- (list /segment.latin-1-supplement
- /segment.latin-extended-a
- /segment.latin-extended-b
- /segment.ipa-extensions
- /segment.spacing-modifier-letters
- /segment.combining-diacritical-marks
- /segment.greek-and-coptic
- /segment.cyrillic
- /segment.cyrillic-supplementary
- /segment.armenian
- /segment.hebrew
- /segment.arabic
- /segment.syriac
- /segment.thaana
- /segment.devanagari
- /segment.bengali
- /segment.gurmukhi
- /segment.gujarati
- /segment.oriya
- /segment.tamil
- /segment.telugu
- /segment.kannada
- /segment.malayalam
- /segment.sinhala
- /segment.thai
- /segment.lao
- /segment.tibetan
- /segment.myanmar
- /segment.georgian
- /segment.hangul-jamo
- /segment.ethiopic
- /segment.cherokee
- /segment.unified-canadian-aboriginal-syllabics
- /segment.ogham
- /segment.runic
- /segment.tagalog
- /segment.hanunoo
- /segment.buhid
- /segment.tagbanwa
- /segment.khmer
- /segment.mongolian
- /segment.limbu
- /segment.tai-le
- /segment.khmer-symbols
- /segment.phonetic-extensions
- /segment.latin-extended-additional
- /segment.greek-extended
- /segment.general-punctuation
- /segment.superscripts-and-subscripts
- /segment.currency-symbols
- /segment.combining-diacritical-marks-for-symbols
- /segment.letterlike-symbols
- /segment.number-forms
- /segment.arrows
- /segment.mathematical-operators
- /segment.miscellaneous-technical
- /segment.control-pictures
- /segment.optical-character-recognition
- /segment.enclosed-alphanumerics
- /segment.box-drawing
- )]))
-
- (def: half/1
- (..set [/segment.block-elements
- (list /segment.geometric-shapes
- /segment.miscellaneous-symbols
- /segment.dingbats
- /segment.miscellaneous-mathematical-symbols-a
- /segment.supplemental-arrows-a
- /segment.braille-patterns
- /segment.supplemental-arrows-b
- /segment.miscellaneous-mathematical-symbols-b
- /segment.supplemental-mathematical-operators
- /segment.miscellaneous-symbols-and-arrows
- /segment.cjk-radicals-supplement
- /segment.kangxi-radicals
- /segment.ideographic-description-characters
- /segment.cjk-symbols-and-punctuation
- /segment.hiragana
- /segment.katakana
- /segment.bopomofo
- /segment.hangul-compatibility-jamo
- /segment.kanbun
- /segment.bopomofo-extended
- /segment.katakana-phonetic-extensions
- /segment.enclosed-cjk-letters-and-months
- /segment.cjk-compatibility
- /segment.cjk-unified-ideographs-extension-a
- /segment.yijing-hexagram-symbols
- /segment.cjk-unified-ideographs
- /segment.yi-syllables
- /segment.yi-radicals
- /segment.hangul-syllables
- ## /segment.high-surrogates
- ## /segment.high-private-use-surrogates
- ## /segment.low-surrogates
- ## /segment.private-use-area
- /segment.cjk-compatibility-ideographs
- /segment.alphabetic-presentation-forms
- /segment.arabic-presentation-forms-a
- /segment.variation-selectors
- /segment.combining-half-marks
- /segment.cjk-compatibility-forms
- /segment.small-form-variants
- /segment.arabic-presentation-forms-b
- /segment.halfwidth-and-fullwidth-forms
- /segment.specials
- ## /segment.linear-b-syllabary
- ## /segment.linear-b-ideograms
- ## /segment.aegean-numbers
- ## /segment.old-italic
- ## /segment.gothic
- ## /segment.ugaritic
- ## /segment.deseret
- ## /segment.shavian
- ## /segment.osmanya
- ## /segment.cypriot-syllabary
- ## /segment.byzantine-musical-symbols
- ## /segment.musical-symbols
- ## /segment.tai-xuan-jing-symbols
- ## /segment.mathematical-alphanumeric-symbols
- ## /segment.cjk-unified-ideographs-extension-b
- ## /segment.cjk-compatibility-ideographs-supplement
- ## /segment.tags
- )]))
-
- (def: #export full
- (..compose ..half/0 ..half/1))
-
- (def: #export (range set)
- (-> Set [Char Char])
- (let [tag (tree.tag (:representation set))]
- [(/segment.start tag)
- (/segment.end tag)]))
-
- (def: #export (member? set character)
- (-> Set Char Bit)
- (loop [tree (:representation set)]
- (if (/segment.within? (tree.tag tree) character)
- (case (tree.root tree)
- (0 #0 _)
- true
-
- (0 #1 left right)
- (or (recur left)
- (recur right)))
- false)))
-
- (structure: #export equivalence
- (Equivalence Set)
-
- (def: (= reference subject)
- (set\= (set.from-list /segment.hash (tree.tags (:representation reference)))
- (set.from-list /segment.hash (tree.tags (:representation subject))))))
- )
-
-(template [<name> <segments>]
- [(def: #export <name>
- (..set <segments>))]
-
- [ascii [/segment.basic-latin (list)]]
- [ascii/alpha [/segment.basic-latin/upper-alpha (list /segment.basic-latin/lower-alpha)]]
- [ascii/alpha-num [/segment.basic-latin/upper-alpha (list /segment.basic-latin/lower-alpha /segment.basic-latin/decimal)]]
- [ascii/upper-alpha [/segment.basic-latin/upper-alpha (list)]]
- [ascii/lower-alpha [/segment.basic-latin/lower-alpha (list)]]
- )
diff --git a/stdlib/source/lux/data/text/unicode/set.lux b/stdlib/source/lux/data/text/unicode/set.lux
new file mode 100644
index 000000000..f1563d13a
--- /dev/null
+++ b/stdlib/source/lux/data/text/unicode/set.lux
@@ -0,0 +1,213 @@
+(.module:
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]]
+ [data
+ [collection
+ ["." list ("#\." fold functor)]
+ ["." set ("#\." equivalence)]
+ ["." tree #_
+ ["#" finger (#+ Tree)]]]]
+ [type (#+ :by-example)
+ abstract]]
+ ["." / #_
+ ["/#" // #_
+ [// (#+ Char)]
+ ["#." segment (#+ Segment)]]])
+
+(def: builder
+ (tree.builder //segment.monoid))
+
+(def: :@:
+ (:by-example [@]
+ {(tree.Builder @ Segment)
+ ..builder}
+ @))
+
+(abstract: #export Set
+ (Tree :@: Segment [])
+
+ (def: #export (compose left right)
+ (-> Set Set Set)
+ (:abstraction
+ (\ builder branch
+ (:representation left)
+ (:representation right))))
+
+ (def: (singleton segment)
+ (-> Segment Set)
+ (:abstraction
+ (\ builder leaf segment [])))
+
+ (def: #export (set [head tail])
+ (-> [Segment (List Segment)] Set)
+ (list\fold ..compose (..singleton head) (list\map ..singleton tail)))
+
+ (def: half/0
+ (..set [//segment.basic-latin
+ (list //segment.latin-1-supplement
+ //segment.latin-extended-a
+ //segment.latin-extended-b
+ //segment.ipa-extensions
+ //segment.spacing-modifier-letters
+ //segment.combining-diacritical-marks
+ //segment.greek-and-coptic
+ //segment.cyrillic
+ //segment.cyrillic-supplementary
+ //segment.armenian
+ //segment.hebrew
+ //segment.arabic
+ //segment.syriac
+ //segment.thaana
+ //segment.devanagari
+ //segment.bengali
+ //segment.gurmukhi
+ //segment.gujarati
+ //segment.oriya
+ //segment.tamil
+ //segment.telugu
+ //segment.kannada
+ //segment.malayalam
+ //segment.sinhala
+ //segment.thai
+ //segment.lao
+ //segment.tibetan
+ //segment.myanmar
+ //segment.georgian
+ //segment.hangul-jamo
+ //segment.ethiopic
+ //segment.cherokee
+ //segment.unified-canadian-aboriginal-syllabics
+ //segment.ogham
+ //segment.runic
+ //segment.tagalog
+ //segment.hanunoo
+ //segment.buhid
+ //segment.tagbanwa
+ //segment.khmer
+ //segment.mongolian
+ //segment.limbu
+ //segment.tai-le
+ //segment.khmer-symbols
+ //segment.phonetic-extensions
+ //segment.latin-extended-additional
+ //segment.greek-extended
+ //segment.general-punctuation
+ //segment.superscripts-and-subscripts
+ //segment.currency-symbols
+ //segment.combining-diacritical-marks-for-symbols
+ //segment.letterlike-symbols
+ //segment.number-forms
+ //segment.arrows
+ //segment.mathematical-operators
+ //segment.miscellaneous-technical
+ //segment.control-pictures
+ //segment.optical-character-recognition
+ //segment.enclosed-alphanumerics
+ //segment.box-drawing
+ )]))
+
+ (def: half/1
+ (..set [//segment.block-elements
+ (list //segment.geometric-shapes
+ //segment.miscellaneous-symbols
+ //segment.dingbats
+ //segment.miscellaneous-mathematical-symbols-a
+ //segment.supplemental-arrows-a
+ //segment.braille-patterns
+ //segment.supplemental-arrows-b
+ //segment.miscellaneous-mathematical-symbols-b
+ //segment.supplemental-mathematical-operators
+ //segment.miscellaneous-symbols-and-arrows
+ //segment.cjk-radicals-supplement
+ //segment.kangxi-radicals
+ //segment.ideographic-description-characters
+ //segment.cjk-symbols-and-punctuation
+ //segment.hiragana
+ //segment.katakana
+ //segment.bopomofo
+ //segment.hangul-compatibility-jamo
+ //segment.kanbun
+ //segment.bopomofo-extended
+ //segment.katakana-phonetic-extensions
+ //segment.enclosed-cjk-letters-and-months
+ //segment.cjk-compatibility
+ //segment.cjk-unified-ideographs-extension-a
+ //segment.yijing-hexagram-symbols
+ //segment.cjk-unified-ideographs
+ //segment.yi-syllables
+ //segment.yi-radicals
+ //segment.hangul-syllables
+ ## //segment.high-surrogates
+ ## //segment.high-private-use-surrogates
+ ## //segment.low-surrogates
+ ## //segment.private-use-area
+ //segment.cjk-compatibility-ideographs
+ //segment.alphabetic-presentation-forms
+ //segment.arabic-presentation-forms-a
+ //segment.variation-selectors
+ //segment.combining-half-marks
+ //segment.cjk-compatibility-forms
+ //segment.small-form-variants
+ //segment.arabic-presentation-forms-b
+ //segment.halfwidth-and-fullwidth-forms
+ //segment.specials
+ ## //segment.linear-b-syllabary
+ ## //segment.linear-b-ideograms
+ ## //segment.aegean-numbers
+ ## //segment.old-italic
+ ## //segment.gothic
+ ## //segment.ugaritic
+ ## //segment.deseret
+ ## //segment.shavian
+ ## //segment.osmanya
+ ## //segment.cypriot-syllabary
+ ## //segment.byzantine-musical-symbols
+ ## //segment.musical-symbols
+ ## //segment.tai-xuan-jing-symbols
+ ## //segment.mathematical-alphanumeric-symbols
+ ## //segment.cjk-unified-ideographs-extension-b
+ ## //segment.cjk-compatibility-ideographs-supplement
+ ## //segment.tags
+ )]))
+
+ (def: #export full
+ (..compose ..half/0 ..half/1))
+
+ (def: #export (range set)
+ (-> Set [Char Char])
+ (let [tag (tree.tag (:representation set))]
+ [(//segment.start tag)
+ (//segment.end tag)]))
+
+ (def: #export (member? set character)
+ (-> Set Char Bit)
+ (loop [tree (:representation set)]
+ (if (//segment.within? (tree.tag tree) character)
+ (case (tree.root tree)
+ (0 #0 _)
+ true
+
+ (0 #1 left right)
+ (or (recur left)
+ (recur right)))
+ false)))
+
+ (structure: #export equivalence
+ (Equivalence Set)
+
+ (def: (= reference subject)
+ (set\= (set.from-list //segment.hash (tree.tags (:representation reference)))
+ (set.from-list //segment.hash (tree.tags (:representation subject))))))
+ )
+
+(template [<name> <segments>]
+ [(def: #export <name>
+ (..set <segments>))]
+
+ [ascii [//segment.basic-latin (list)]]
+ [ascii/alpha [//segment.basic-latin/upper-alpha (list //segment.basic-latin/lower-alpha)]]
+ [ascii/alpha-num [//segment.basic-latin/upper-alpha (list //segment.basic-latin/lower-alpha //segment.basic-latin/decimal)]]
+ [ascii/upper-alpha [//segment.basic-latin/upper-alpha (list)]]
+ [ascii/lower-alpha [//segment.basic-latin/lower-alpha (list)]]
+ )
diff --git a/stdlib/source/lux/macro/syntax/common/check.lux b/stdlib/source/lux/macro/syntax/common/check.lux
new file mode 100644
index 000000000..dcb8f6c26
--- /dev/null
+++ b/stdlib/source/lux/macro/syntax/common/check.lux
@@ -0,0 +1,31 @@
+(.module:
+ [lux #*
+ ["." meta]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." exception (#+ exception:)]
+ ["<>" parser
+ ["<.>" code (#+ Parser)]]]
+ [macro
+ ["." code]]])
+
+(def: extension
+ "lux check")
+
+(type: #export Check
+ {#type Code
+ #value Code})
+
+(def: #export (write (^slots [#type #value]))
+ (-> Check Code)
+ (` ((~ (code.text ..extension))
+ (~ type)
+ (~ value))))
+
+(def: #export parser
+ (Parser Check)
+ (<| <code>.form
+ (<>.after (<code>.text! ..extension))
+ (<>.and <code>.any
+ <code>.any)))
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 45985a41a..e1f34cd32 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -16,7 +16,8 @@
["c" complex]
["f" frac]]
["." text (#+ Char) ("#\." monoid)
- ["." unicode]]
+ ["." unicode #_
+ ["#" set]]]
[collection
["." list ("#\." fold)]
["." array (#+ Array)]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
index 2b5cfd4a8..1916cfe15 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
@@ -90,39 +90,50 @@
[!n/- "lux i64 -"]
)
-(type: #export Aliases (Dictionary Text Text))
-(def: #export no-aliases Aliases (dictionary.new text.hash))
+(type: #export Aliases
+ (Dictionary Text Text))
+
+(def: #export no-aliases
+ Aliases
+ (dictionary.new text.hash))
(def: #export prelude "lux")
(def: #export text-delimiter text.double-quote)
-(def: #export open-form "(")
-(def: #export close-form ")")
+(template [<char> <definition>]
+ [(def: #export <definition> <char>)]
+
+ ## Form delimiters
+ ["(" open-form]
+ [")" close-form]
-(def: #export open-tuple "[")
-(def: #export close-tuple "]")
+ ## Tuple delimiters
+ ["[" open-tuple]
+ ["]" close-tuple]
-(def: #export open-record "{")
-(def: #export close-record "}")
+ ## Record delimiters
+ ["{" open-record]
+ ["}" close-record]
-(def: #export sigil "#")
+ ["#" sigil]
-(def: #export digit-separator ",")
+ ["," digit-separator]
-(def: #export positive-sign "+")
-(def: #export negative-sign "-")
+ ["+" positive-sign]
+ ["-" negative-sign]
-(def: #export frac-separator ".")
+ ["." frac-separator]
-## The parts of a name are separated by a single mark.
-## E.g. module.short.
-## Only one such mark may be used in an name, since there
-## can only be 2 parts to a name (the module [before the
-## mark], and the short [after the mark]).
-## There are also some extra rules regarding name syntax,
-## encoded in the parser.
-(def: #export name-separator ".")
+ ## The parts of a name are separated by a single mark.
+ ## E.g. module.short.
+ ## Only one such mark may be used in an name, since there
+ ## can only be 2 parts to a name (the module [before the
+ ## mark], and the short [after the mark]).
+ ## There are also some extra rules regarding name syntax,
+ ## encoded in the parser.
+ ["." name-separator]
+ )
(exception: #export (end-of-file {module Text})
(exception.report
@@ -130,8 +141,8 @@
(def: amount-of-input-shown 64)
-(def: (input-at start input)
- (-> Offset Text Text)
+(template: (input-at start input)
+ ## (-> Offset Text Text)
(let [end (|> start (!n/+ amount-of-input-shown) (n.min ("lux text size" input)))]
(!clip start end input)))
@@ -197,48 +208,42 @@
(!inc offset)
source-code])
-(def: close-signal
- (template.with-locals [g!close-signal]
- (template.text [g!close-signal])))
-
-(template [<name> <close> <tag> <context>]
- [(def: (<name> parse source)
- (-> (Parser Code) (Parser Code))
- (let [[where offset source-code] source]
- (loop [source (: Source [(!forward 1 where) offset source-code])
- stack (: (List Code) #.Nil)]
- (case (parse source)
- (#.Right [source' top])
- (recur source' (#.Cons top stack))
-
- (#.Left [source' error])
- (if (is? <close> error)
- (#.Right [source'
- [where (<tag> (list.reverse stack))]])
- (#.Left [source' error]))))))]
+(template [<name> <close> <tag>]
+ [(template: (<name> parse where offset source-code)
+ ## (-> (Parser Code) (Parser Code))
+ (loop [source (: Source [(!forward 1 where) offset source-code])
+ stack (: (List Code) #.Nil)]
+ (case (parse source)
+ (#.Right [source' top])
+ (recur source' (#.Cons top stack))
+
+ (#.Left [source' error])
+ (if (is? <close> error)
+ (#.Right [source'
+ [where (<tag> (list.reverse stack))]])
+ (#.Left [source' error])))))]
## Form and tuple syntax is mostly the same, differing only in the
## delimiters involved.
## They may have an arbitrary number of arbitrary Code nodes as elements.
- [parse-form ..close-form #.Form "Form"]
- [parse-tuple ..close-tuple #.Tuple "Tuple"]
+ [parse-form ..close-form #.Form]
+ [parse-tuple ..close-tuple #.Tuple]
)
-(def: (parse-record parse source)
- (-> (Parser Code) (Parser Code))
- (let [[where offset source-code] source]
- (loop [source (: Source [(!forward 1 where) offset source-code])
- stack (: (List [Code Code]) #.Nil)]
- (case (parse source)
- (#.Right [sourceF field])
- (!letE [sourceFV value] (parse sourceF)
- (recur sourceFV (#.Cons [field value] stack)))
-
- (#.Left [source' error])
- (if (is? ..close-record error)
- (#.Right [source'
- [where (#.Record (list.reverse stack))]])
- (#.Left [source' error]))))))
+(template: (parse-record parse where offset source-code)
+ ## (-> (Parser Code) (Parser Code))
+ (loop [source (: Source [(!forward 1 where) offset source-code])
+ stack (: (List [Code Code]) #.Nil)]
+ (case (parse source)
+ (#.Right [sourceF field])
+ (!letE [sourceFV value] (parse sourceF)
+ (recur sourceFV (#.Cons [field value] stack)))
+
+ (#.Left [source' error])
+ (if (is? ..close-record error)
+ (#.Right [source'
+ [where (#.Record (list.reverse stack))]])
+ (#.Left [source' error])))))
(template: (!guarantee-no-new-lines where offset source-code content body)
(case ("lux text index" 0 (static text.new-line) content)
@@ -253,185 +258,202 @@
(-> Location Nat Text (Either [Source Text] [Source Code]))
(case ("lux text index" offset (static ..text-delimiter) source-code)
(#.Some g!end)
- (let [g!content (!clip offset g!end source-code)]
- (<| (!guarantee-no-new-lines where offset source-code g!content)
- (#.Right [[(let [size (!n/- offset g!end)]
- (update@ #.column (|>> (!n/+ size) (!n/+ 2)) where))
- (!inc g!end)
- source-code]
- [where
- (#.Text g!content)]])))
+ (<| (let [g!content (!clip offset g!end source-code)])
+ (!guarantee-no-new-lines where offset source-code g!content)
+ (#.Right [[(let [size (!n/- offset g!end)]
+ (update@ #.column (|>> (!n/+ size) (!n/+ 2)) where))
+ (!inc g!end)
+ source-code]
+ [where
+ (#.Text g!content)]]))
_
(!failure ..parse-text where offset source-code)))
-(def: digit-bottom Nat (!dec (char "0")))
-(def: digit-top Nat (!inc (char "9")))
-
-(template: (!digit? char)
- (and (!i/< (:coerce Int char) (:coerce Int (static ..digit-bottom)))
- (!i/< (:coerce Int (static ..digit-top)) (:coerce Int char))))
-
-(`` (template: (!digit?+ char)
- (or (!digit? char)
- ("lux i64 =" (.char (~~ (static ..digit-separator))) char))))
-
-(with-expansions [<non-name-chars> (template [<char>]
+(with-expansions [<digits> (as-is "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
+ <non-name-chars> (template [<char>]
[(~~ (static <char>))]
[text.space]
- [text.new-line]
+ [text.new-line] [text.carriage-return]
[..name-separator]
[..open-form] [..close-form]
[..open-tuple] [..close-tuple]
[..open-record] [..close-record]
[..text-delimiter]
- [..sigil])]
- (`` (template: (!strict-name-char? char)
- ("lux syntax char case!" char
+ [..sigil])
+ <digit-separator> (static ..digit-separator)]
+ (template: (!if-digit? @char @then @else)
+ ("lux syntax char case!" @char
+ [[<digits>]
+ @then]
+
+ ## else
+ @else))
+
+ (template: (!if-digit?+ @char @then @else-options @else)
+ (`` ("lux syntax char case!" @char
+ [[<digits> <digit-separator>]
+ @then
+
+ (~~ (template.splice @else-options))]
+
+ ## else
+ @else)))
+
+ (`` (template: (!if-name-char?|tail @char @then @else)
+ ("lux syntax char case!" @char
[[<non-name-chars>]
- #0]
+ @else]
## else
- #1))))
+ @then)))
-(template: (!name-char?|head char)
- (and (!strict-name-char? char)
- (not (!digit? char))))
+ (`` (template: (!if-name-char?|head @char @then @else)
+ ("lux syntax char case!" @char
+ [[<non-name-chars> <digits>]
+ @else]
-(template: (!name-char? char)
- (!strict-name-char? char))
+ ## else
+ @then)))
+ )
-(template: (!number-output <start> <end> <codec> <tag>)
- (case (|> source-code
+(template: (!number-output <source-code> <start> <end> <codec> <tag>)
+ (case (|> <source-code>
(!clip <start> <end>)
(text.replace-all ..digit-separator "")
(\ <codec> decode))
(#.Right output)
- (#.Right [[(update@ #.column (|>> (!n/+ (!n/- <start> <end>))) where)
+ (#.Right [[(let [[where::file where::line where::column] where]
+ [where::file where::line (!n/+ (!n/- <start> <end>) where::column)])
<end>
- source-code]
+ <source-code>]
[where (<tag> output)]])
(#.Left error)
- (#.Left [[where <start> source-code]
+ (#.Left [[where <start> <source-code>]
error])))
(def: no-exponent Offset 0)
-(with-expansions [<int-output> (as-is (!number-output start end int.decimal #.Int))
- <frac-output> (as-is (!number-output start end frac.decimal #.Frac))
- <failure> (!failure ..parse-frac where offset source-code)]
- (def: (parse-frac source-code//size start [where offset source-code])
- (-> Nat Offset (Parser Code))
+(with-expansions [<int-output> (as-is (!number-output source-code start end int.decimal #.Int))
+ <frac-output> (as-is (!number-output source-code start end frac.decimal #.Frac))
+ <failure> (!failure ..parse-frac where offset source-code)
+ <frac-separator> (static ..frac-separator)
+ <signs> (template [<sign>]
+ [(~~ (static <sign>))]
+
+ [..positive-sign]
+ [..negative-sign])]
+ (template: (parse-frac source-code//size start where offset source-code)
+ ## (-> Nat Offset (Parser Code))
(loop [end offset
- exponent ..no-exponent]
+ exponent (static ..no-exponent)]
(<| (!with-char+ source-code//size source-code end char/0 <frac-output>)
- (cond (!digit?+ char/0)
- (recur (!inc end) exponent)
-
- (and (or (!n/= (char "e") char/0)
- (!n/= (char "E") char/0))
- (is? ..no-exponent exponent))
- (<| (!with-char+ source-code//size source-code (!inc end) char/1 <failure>)
- (if (or (!n/= (`` (char (~~ (static ..positive-sign)))) char/1)
- (!n/= (`` (char (~~ (static ..negative-sign)))) char/1))
- (<| (!with-char+ source-code//size source-code (!n/+ 2 end) char/2 <failure>)
- (if (!digit?+ char/2)
- (recur (!n/+ 3 end) char/0)
- <failure>))
- <failure>))
-
- ## else
- <frac-output>))))
-
- (def: (parse-signed start [where offset source-code])
- (-> Offset (Parser Code))
- (let [source-code//size ("lux text size" source-code)]
- (loop [end offset]
- (<| (!with-char+ source-code//size source-code end char <int-output>)
- (cond (!digit?+ char)
- (recur (!inc end))
-
- (!n/= (`` (.char (~~ (static ..frac-separator))))
- char)
- (parse-frac source-code//size start [where (!inc end) source-code])
-
- ## else
- <int-output>))))))
+ (!if-digit?+ char/0
+ (recur (!inc end) exponent)
+
+ [["e" "E"]
+ (if (is? (static ..no-exponent) exponent)
+ (<| (!with-char+ source-code//size source-code (!inc end) char/1 <failure>)
+ (`` ("lux syntax char case!" char/1
+ [[<signs>]
+ (<| (!with-char+ source-code//size source-code (!n/+ 2 end) char/2 <failure>)
+ (!if-digit?+ char/2
+ (recur (!n/+ 3 end) char/0)
+ []
+ <failure>))]
+ ## else
+ <failure>)))
+ <frac-output>)]
+
+ <frac-output>))))
+
+ (template: (parse-signed source-code//size start where offset source-code)
+ ## (-> Nat Offset (Parser Code))
+ (loop [end offset]
+ (<| (!with-char+ source-code//size source-code end char <int-output>)
+ (!if-digit?+ char
+ (recur (!inc end))
+
+ [[<frac-separator>]
+ (parse-frac source-code//size start where (!inc end) source-code)]
+
+ <int-output>))))
+ )
(template [<parser> <codec> <tag>]
- [(def: (<parser> source-code//size start where offset source-code)
- (-> Nat Nat Location Nat Text (Either [Source Text] [Source Code]))
+ [(template: (<parser> source-code//size start where offset source-code)
+ ## (-> Nat Nat Location Nat Text (Either [Source Text] [Source Code]))
(loop [g!end offset]
- (<| (!with-char+ source-code//size source-code g!end g!char (!number-output start g!end <codec> <tag>))
- (if (!digit?+ g!char)
- (recur (!inc g!end))
- (!number-output start g!end <codec> <tag>)))))]
+ (<| (!with-char+ source-code//size source-code g!end g!char (!number-output source-code start g!end <codec> <tag>))
+ (!if-digit?+ g!char
+ (recur (!inc g!end))
+ []
+ (!number-output source-code start g!end <codec> <tag>)))))]
[parse-nat n.decimal #.Nat]
[parse-rev rev.decimal #.Rev]
)
(template: (!parse-signed source-code//size offset where source-code @aliases @end)
- (let [g!offset/1 (!inc offset)]
- (<| (!with-char+ source-code//size source-code g!offset/1 g!char/1 @end)
- (if (!digit? g!char/1)
- (parse-signed offset [where (!inc/2 offset) source-code])
- (!parse-full-name offset [where (!inc offset) source-code] where @aliases #.Identifier)))))
+ (<| (let [g!offset/1 (!inc offset)])
+ (!with-char+ source-code//size source-code g!offset/1 g!char/1 @end)
+ (!if-digit? g!char/1
+ (parse-signed source-code//size offset where (!inc/2 offset) source-code)
+ (!parse-full-name offset [where (!inc offset) source-code] where @aliases #.Identifier))))
(with-expansions [<output> (#.Right [[(update@ #.column (|>> (!n/+ (!n/- start end))) where)
end
source-code]
(!clip start end source-code)])]
- (def: (parse-name-part start [where offset source-code])
- (-> Offset (Parser Text))
+ (template: (parse-name-part start where offset source-code)
+ ## (-> Offset (Parser Text))
(let [source-code//size ("lux text size" source-code)]
(loop [end offset]
(<| (!with-char+ source-code//size source-code end char <output>)
- (if (!name-char? char)
- (recur (!inc end))
- <output>))))))
+ (!if-name-char?|tail char
+ (recur (!inc end))
+ <output>))))))
(template: (!parse-half-name @offset @char @module)
- (cond (!name-char?|head @char)
- (!letE [source' name] (..parse-name-part @offset [where (!inc @offset) source-code])
- (#.Right [source' [@module name]]))
-
- ## else
- (!failure ..!parse-half-name where @offset source-code)))
-
-(`` (def: (parse-short-name current-module [where offset/0 source-code])
- (-> Text (Parser Name))
- (<| (!with-char source-code offset/0 char/0
- (!end-of-file where offset/0 source-code current-module))
+ (!if-name-char?|head @char
+ (!letE [source' name] (..parse-name-part @offset where (!inc @offset) source-code)
+ (#.Right [source' [@module name]]))
+ (!failure ..!parse-half-name where @offset source-code)))
+
+(`` (def: (parse-short-name source-code//size current-module [where offset/0 source-code])
+ (-> Nat Text (Parser Name))
+ (<| (!with-char+ source-code//size source-code offset/0 char/0
+ (!end-of-file where offset/0 source-code current-module))
(if (!n/= (char (~~ (static ..name-separator))) char/0)
- (let [offset/1 (!inc offset/0)]
- (<| (!with-char source-code offset/1 char/1
- (!end-of-file where offset/1 source-code current-module))
- (!parse-half-name offset/1 char/1 current-module)))
- (!parse-half-name offset/0 char/0 ..prelude)))))
-
-(template: (!parse-short-name @current-module @source @where @tag)
- (!letE [source' name] (..parse-short-name @current-module @source)
+ (<| (let [offset/1 (!inc offset/0)])
+ (!with-char+ source-code//size source-code offset/1 char/1
+ (!end-of-file where offset/1 source-code current-module))
+ (!parse-half-name offset/1 char/1 current-module))
+ (!parse-half-name offset/0 char/0 (static ..prelude))))))
+
+(template: (!parse-short-name source-code//size @current-module @source @where @tag)
+ (!letE [source' name] (..parse-short-name source-code//size @current-module @source)
(#.Right [source' [@where (@tag name)]])))
(with-expansions [<simple> (as-is (#.Right [source' ["" simple]]))]
(`` (def: (parse-full-name aliases start source)
(-> Aliases Offset (Parser Name))
- (<| (!letE [source' simple] (..parse-name-part start source))
+ (<| (!letE [source' simple] (let [[where offset source-code] source]
+ (..parse-name-part start where offset source-code)))
(let [[where' offset' source-code'] source'])
(!with-char source-code' offset' char/separator <simple>)
(if (!n/= (char (~~ (static ..name-separator))) char/separator)
- (let [offset'' (!inc offset')]
- (!letE [source'' complex] (..parse-name-part offset'' [(!forward 1 where') offset'' source-code'])
- (if ("lux text =" "" complex)
- (let [[where offset source-code] source]
- (!failure ..parse-full-name where offset source-code))
- (#.Right [source'' [(|> aliases
- (dictionary.get simple)
- (maybe.default simple))
- complex]]))))
+ (<| (let [offset'' (!inc offset')])
+ (!letE [source'' complex] (..parse-name-part offset'' (!forward 1 where') offset'' source-code'))
+ (if ("lux text =" "" complex)
+ (let [[where offset source-code] source]
+ (!failure ..parse-full-name where offset source-code))
+ (#.Right [source'' [(|> aliases
+ (dictionary.get simple)
+ (maybe.default simple))
+ complex]])))
<simple>)))))
(template: (!parse-full-name @offset @source @where @aliases @tag)
@@ -443,7 +465,7 @@
## [expression ...]
## [form "(" [#* expression] ")"])
-(with-expansions [<consume-1> (as-is [where (!inc offset/0) source-code])
+(with-expansions [<consume-1> (as-is where (!inc offset/0) source-code)
<move-1> (as-is [(!forward 1 where) (!inc offset/0) source-code])
<move-2> (as-is [(!forward 1 where) (!inc/2 offset/0) source-code])
<recur> (as-is (parse current-module aliases source-code//size))
@@ -488,47 +510,48 @@
## Special code
[(~~ (static ..sigil))]
- (let [offset/1 (!inc offset/0)]
- (<| (!with-char+ source-code//size source-code offset/1 char/1
- (!end-of-file where offset/1 source-code current-module))
- ("lux syntax char case!" char/1
- [[(~~ (static ..name-separator))]
- (!parse-short-name current-module <move-2> where #.Tag)
-
- ## Single-line comment
- [(~~ (static ..sigil))]
- (case ("lux text index" (!inc offset/1) (static text.new-line) source-code)
- (#.Some end)
- (recur (!vertical where end source-code))
-
- _
- (!end-of-file where offset/1 source-code current-module))
-
- (~~ (template [<char> <bit>]
- [[<char>]
- (#.Right [[(update@ #.column (|>> !inc/2) where)
- (!inc offset/1)
- source-code]
- [where (#.Bit <bit>)]])]
-
- ["0" #0]
- ["1" #1]))]
-
- ## else
- (cond (!name-char?|head char/1) ## Tag
- (!parse-full-name offset/1 <move-2> where aliases #.Tag)
-
- ## else
- (!failure ..parse where offset/0 source-code)))))
+ (<| (let [offset/1 (!inc offset/0)])
+ (!with-char+ source-code//size source-code offset/1 char/1
+ (!end-of-file where offset/1 source-code current-module))
+ ("lux syntax char case!" char/1
+ [[(~~ (static ..name-separator))]
+ (!parse-short-name source-code//size current-module <move-2> where #.Tag)
+
+ ## Single-line comment
+ [(~~ (static ..sigil))]
+ (case ("lux text index" (!inc offset/1) (static text.new-line) source-code)
+ (#.Some end)
+ (recur (!vertical where end source-code))
+
+ _
+ (!end-of-file where offset/1 source-code current-module))
+
+ (~~ (template [<char> <bit>]
+ [[<char>]
+ (#.Right [[(update@ #.column (|>> !inc/2) where)
+ (!inc offset/1)
+ source-code]
+ [where (#.Bit <bit>)]])]
+
+ ["0" #0]
+ ["1" #1]))]
+
+ ## else
+ (!if-name-char?|head char/1
+ ## Tag
+ (!parse-full-name offset/1 <move-2> where aliases #.Tag)
+ (!failure ..parse where offset/0 source-code))))
## Coincidentally (= ..name-separator ..frac-separator)
- [(~~ (static ..name-separator))]
- (let [offset/1 (!inc offset/0)]
- (<| (!with-char+ source-code//size source-code offset/1 char/1
- (!end-of-file where offset/1 source-code current-module))
- (if (!digit? char/1)
- (parse-rev source-code//size offset/0 where (!inc offset/1) source-code)
- (!parse-short-name current-module [where offset/1 source-code] where #.Identifier))))
+ [(~~ (static ..name-separator))
+ ## (~~ (static ..frac-separator))
+ ]
+ (<| (let [offset/1 (!inc offset/0)])
+ (!with-char+ source-code//size source-code offset/1 char/1
+ (!end-of-file where offset/1 source-code current-module))
+ (!if-digit? char/1
+ (parse-rev source-code//size offset/0 where (!inc offset/1) source-code)
+ (!parse-short-name source-code//size current-module [where offset/1 source-code] where #.Identifier)))
[(~~ (static ..positive-sign))
(~~ (static ..negative-sign))]
@@ -536,11 +559,11 @@
(!end-of-file where offset/0 source-code current-module))]
## else
- (if (!digit? char/0)
- ## Natural number
- (parse-nat source-code//size offset/0 where (!inc offset/0) source-code)
- ## Identifier
- (!parse-full-name offset/0 <consume-1> where aliases #.Identifier))
+ (!if-digit? char/0
+ ## Natural number
+ (parse-nat source-code//size offset/0 where (!inc offset/0) source-code)
+ ## Identifier
+ (!parse-full-name offset/0 [<consume-1>] where aliases #.Identifier))
)))
)))
))
diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux
index 3d0d96ee9..9d9027e72 100644
--- a/stdlib/source/lux/type/dynamic.lux
+++ b/stdlib/source/lux/type/dynamic.lux
@@ -23,21 +23,21 @@
{#.doc "A value coupled with its type, so it can be checked later."}
- (def: dynamic-abstraction (-> [Type Any] Dynamic) (|>> :abstraction))
- (def: dynamic-representation (-> Dynamic [Type Any]) (|>> :representation))
+ (def: abstraction (-> [Type Any] Dynamic) (|>> :abstraction))
+ (def: representation (-> Dynamic [Type Any]) (|>> :representation))
(syntax: #export (:dynamic value)
{#.doc (doc (: Dynamic
(:dynamic 123)))}
(with-gensyms [g!value]
(wrap (list (` (let [(~ g!value) (~ value)]
- ((~! ..dynamic-abstraction) [(:of (~ g!value)) (~ g!value)])))))))
+ ((~! ..abstraction) [(:of (~ g!value)) (~ g!value)])))))))
(syntax: #export (:check type value)
{#.doc (doc (: (try.Try Nat)
(:check Nat (:dynamic 123))))}
(with-gensyms [g!type g!value]
- (wrap (list (` (let [[(~ g!type) (~ g!value)] ((~! ..dynamic-representation) (~ value))]
+ (wrap (list (` (let [[(~ g!type) (~ g!value)] ((~! ..representation) (~ value))]
(: ((~! try.Try) (~ type))
(if (\ (~! type.equivalence) (~' =)
(.type (~ type)) (~ g!type))
diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux
index a26e70e50..e4fe812f1 100644
--- a/stdlib/source/program/aedifex/artifact.lux
+++ b/stdlib/source/program/aedifex/artifact.lux
@@ -2,8 +2,9 @@
[lux (#- Name)
[abstract
[equivalence (#+ Equivalence)]
- ["." hash (#+ Hash)]]
+ [hash (#+ Hash)]]
[data
+ ["." product]
["." text
["%" format (#+ Format)]]
[collection
@@ -29,7 +30,7 @@
(def: #export hash
(Hash Artifact)
- ($_ hash.product
+ ($_ product.hash
text.hash
text.hash
text.hash
@@ -61,12 +62,15 @@
..identity-separator
(..identity value)))
+(def: #export (directory separator group)
+ (-> Text Group Text)
+ (|> group
+ (text.split-all-with ..group-separator)
+ (text.join-with separator)))
+
(def: (address separator artifact)
(-> Text Artifact Text)
- (let [directory (%.format (|> artifact
- (get@ #group)
- (text.split-all-with ..group-separator)
- (text.join-with separator))
+ (let [directory (%.format (..directory separator (get@ #group artifact))
separator
(get@ #name artifact)
separator
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index dbe4a88cb..4e33b145a 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -3,11 +3,16 @@
[abstract
[monad (#+ do)]]
[control
+ [pipe (#+ do>)]
+ ["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise) ("#\." monad)]]]
+ ["." promise (#+ Promise) ("#\." monad)]]
+ ["<>" parser
+ ["<.>" xml]]]
[data
[binary (#+ Binary)]
[text
+ ["%" format (#+ format)]
["." encoding]]
[collection
["." set]]
@@ -15,6 +20,8 @@
["." binary]
["." tar]
["." xml]]]
+ [time
+ ["." instant (#+ Instant)]]
[world
["." file]
["." console (#+ Console)]]]
@@ -24,28 +31,107 @@
["." // #_
["#." clean]
["/#" // #_
- [repository (#+ Identity Repository)]
[command (#+ Command)]
["/" profile]
["#." action (#+ Action)]
["#." pom]
["#." hash]
+ ["#." repository (#+ Identity Repository)]
+ ["#." metadata
+ ["#/." artifact]
+ ["#/." snapshot]]
["#." artifact (#+ Artifact)
- ["#/." extension (#+ Extension)]]]])
+ ["#/." extension (#+ Extension)]
+ ["#/." type]]]])
+
+(def: epoch
+ Instant
+ (instant.from-millis +0))
+
+(template [<name> <type> <uri> <parser> <default>]
+ [(def: (<name> repository artifact)
+ (-> (Repository Promise) Artifact (Promise (Try <type>)))
+ (do promise.monad
+ [project (\ repository download (<uri> artifact))]
+ (case project
+ (#try.Success project)
+ (wrap (|> project
+ (do> try.monad
+ [(\ encoding.utf8 decode)]
+ [(\ xml.codec decode)]
+ [(<xml>.run <parser>)])))
+
+ (#try.Failure error)
+ (wrap (#try.Success <default>)))))]
+
+ [read-project-metadata ///metadata/artifact.Metadata ///metadata.project ///metadata/artifact.parser
+ (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
+ {#///metadata/artifact.group group
+ #///metadata/artifact.name name
+ #///metadata/artifact.versions (list)
+ #///metadata/artifact.last-updated ..epoch})]
+ [read-version-metadata ///metadata/snapshot.Metadata ///metadata.version ///metadata/snapshot.parser
+ (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
+ {#///metadata/snapshot.group group
+ #///metadata/snapshot.name name
+ #///metadata/snapshot.version version
+ #///metadata/snapshot.versioning {#///metadata/snapshot.time-stamp ..epoch
+ #///metadata/snapshot.build 0
+ #///metadata/snapshot.snapshot (list)}})]
+ )
+
+(def: snapshot-artifacts
+ (List ///artifact/type.Type)
+ (list ///artifact/type.pom
+ (format ///artifact/type.pom ///artifact/extension.sha-1)
+ (format ///artifact/type.pom ///artifact/extension.md5)
+ ///artifact/type.lux-library
+ (format ///artifact/type.lux-library ///artifact/extension.sha-1)
+ (format ///artifact/type.lux-library ///artifact/extension.md5)))
(def: #export (do! console repository fs identity artifact profile)
(-> (Console Promise) (Repository Promise) (file.System Promise) Identity Artifact (Command Any))
(let [deploy! (: (-> Extension Binary (Action Any))
- (\ repository upload identity artifact))]
- (do {! ///action.monad}
- [library (|> profile
- (get@ #/.sources)
- set.to-list
- (export.library fs)
- (\ ! map (binary.run tar.writer)))
- pom (promise\wrap (///pom.write profile))
- _ (deploy! ///artifact/extension.pom (|> pom (\ xml.codec encode) encoding.to-utf8))
- _ (deploy! ///artifact/extension.lux-library library)
- _ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library)))
- _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))]
- (console.write-line //clean.success console))))
+ (|>> (///repository.uri artifact)
+ (\ repository upload identity)))
+ fully-deploy! (: (-> Extension Binary (Action Any))
+ (function (_ extension payload)
+ (do ///action.monad
+ [_ (deploy! extension payload)
+ _ (deploy! (format extension ///artifact/extension.sha-1)
+ (///hash.data (///hash.sha-1 payload)))
+ _ (deploy! (format extension ///artifact/extension.md5)
+ (///hash.data (///hash.md5 payload)))]
+ (wrap []))))
+ (^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
+ (do promise.monad
+ [now (promise.future instant.now)]
+ (do {! ///action.monad}
+ [project (..read-project-metadata repository artifact)
+ snapshot (..read-version-metadata repository artifact)
+ pom (\ ! map (|>> (\ xml.codec encode) (\ encoding.utf8 encode))
+ (promise\wrap (///pom.write profile)))
+ library (|> profile
+ (get@ #/.sources)
+ set.to-list
+ (export.library fs)
+ (\ ! map (binary.run tar.writer)))
+
+ _ (fully-deploy! ///artifact/extension.pom pom)
+ _ (fully-deploy! ///artifact/extension.lux-library library)
+ _ (|> 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] ..snapshot-artifacts)
+ ///metadata/snapshot.write
+ (\ xml.codec encode)
+ (\ encoding.utf8 encode)
+ (\ repository upload identity (///metadata.version artifact)))
+ _ (|> project
+ (set@ #///metadata/artifact.versions (list version))
+ (set@ #///metadata/artifact.last-updated now)
+ ///metadata/artifact.write
+ (\ xml.codec encode)
+ (\ encoding.utf8 encode)
+ (\ repository upload identity (///metadata.project artifact)))]
+ (console.write-line //clean.success console)))))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index e8b0f2dba..2131495b9 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -58,7 +58,7 @@
(Exception [Dependency Text])
(Promise (Try (///hash.Hash h)))))
(do (try.with promise.monad)
- [actual (\ repository download artifact extension)]
+ [actual (\ repository download (///repository.uri artifact extension))]
(\ promise.monad wrap
(do try.monad
[output (\ encoding.utf8 decode actual)
@@ -72,14 +72,14 @@
(let [[artifact type] dependency
extension (///artifact/extension.extension type)]
(do (try.with promise.monad)
- [library (\ repository download artifact extension)
+ [library (\ repository download (///repository.uri artifact extension))
sha-1 (..verified-hash dependency library
repository artifact ///artifact/extension.sha-1
///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
md5 (..verified-hash dependency library
repository artifact ///artifact/extension.md5
///hash.md5 ///hash.md5-codec ..md5-does-not-match)
- pom (\ repository download artifact ///artifact/extension.pom)]
+ pom (\ repository download (///repository.uri artifact ///artifact/extension.pom))]
(\ promise.monad wrap
(do try.monad
[pom (\ encoding.utf8 decode pom)
diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux
index 937fea4a3..11a792528 100644
--- a/stdlib/source/program/aedifex/metadata.lux
+++ b/stdlib/source/program/aedifex/metadata.lux
@@ -7,22 +7,22 @@
[file (#+ Path)]
[net
["." uri (#+ URI)]]]]
- ["." //
+ [//
["." artifact (#+ Artifact)]])
(def: #export file
Path
"maven-metadata.xml")
-(def: (project separator artifact)
+(def: (project' separator artifact)
(-> Text Artifact Text)
(format (artifact.directory separator (get@ #artifact.group artifact))
separator
(get@ #artifact.name artifact)))
-(def: (version separator artifact)
+(def: (version' separator artifact)
(-> Text Artifact Text)
- (format (..project separator artifact)
+ (format (..project' separator artifact)
separator
(get@ #artifact.version artifact)))
@@ -32,6 +32,6 @@
(let [/ uri.separator]
(format (<private> / artifact) / ..file)))]
- [for-project ..project]
- [for-version ..version]
+ [project ..project']
+ [version ..version']
)
diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux
index 1f8068111..aa7b9abce 100644
--- a/stdlib/source/program/aedifex/metadata/artifact.lux
+++ b/stdlib/source/program/aedifex/metadata/artifact.lux
@@ -61,6 +61,7 @@
[<group> "groupId"]
[<name> "artifactId"]
[<version> "version"]
+ [<versioning> "versioning"]
[<versions> "versions"]
[<last-updated> "lastUpdated"]
[<metadata> "metadata"]
@@ -87,8 +88,10 @@
xml.attributes
(list (..write-group (get@ #group value))
(..write-name (get@ #name value))
- (..write-versions (get@ #versions value))
- (..write-last-updated (get@ #last-updated value)))))
+ (#xml.Node ..<versioning>
+ xml.attributes
+ (list (..write-versions (get@ #versions value))
+ (..write-last-updated (get@ #last-updated value)))))))
(def: (sub tag parser)
(All [a] (-> xml.Tag (Parser a) (Parser a)))
@@ -136,9 +139,13 @@
($_ <>.and
(<xml>.somewhere (..text ..<group>))
(<xml>.somewhere (..text ..<name>))
- (<xml>.somewhere (<| (..sub ..<versions>)
- (<>.many (..text ..<version>))))
- (<xml>.somewhere ..last-updated-parser)
+ (<| (..sub ..<versioning>)
+ ($_ <>.and
+ (<| <xml>.somewhere
+ (..sub ..<versions>)
+ (<>.many (..text ..<version>)))
+ (<xml>.somewhere ..last-updated-parser)
+ ))
)))
(def: #export equivalence
diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux
index a94ac33c4..1919d06ca 100644
--- a/stdlib/source/program/aedifex/metadata/snapshot.lux
+++ b/stdlib/source/program/aedifex/metadata/snapshot.lux
@@ -212,7 +212,7 @@
(Parser Build)
(<text>.embed (<>.codec n.decimal
(<text>.many <text>.decimal))
- (..text ..<timestamp>)))
+ (..text ..<build-number>)))
(exception: #export (time-stamp-mismatch {expected Time-Stamp} {actual Text})
(exception.report
@@ -226,7 +226,7 @@
(def: (snapshot-parser expected)
(-> Value (Parser Type))
- (<| (..sub ..<snapshot-versions>)
+ (<| (..sub ..<snapshot-version>)
(do <>.monad
[#let [[version time-stamp build] expected]
updated (<xml>.somewhere (..text ..<updated>))
@@ -243,8 +243,8 @@
(do <>.monad
[[time-stamp build] (<| <xml>.somewhere
(..sub ..<snapshot>)
- (<>.and ..time-stamp-parser
- ..build-parser))
+ (<>.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))
@@ -268,7 +268,7 @@
#version version
#versioning versioning}))))
-(def: versioning
+(def: versioning-equivalence
(Equivalence Versioning)
($_ product.equivalence
instant.equivalence
@@ -282,5 +282,5 @@
text.equivalence
text.equivalence
text.equivalence
- ..versioning
+ ..versioning-equivalence
))
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux
index 7ec522a10..c351e9d0c 100644
--- a/stdlib/source/program/aedifex/repository.lux
+++ b/stdlib/source/program/aedifex/repository.lux
@@ -17,9 +17,15 @@
["." encoding]]
[number
["n" nat]]]
+ [tool
+ [compiler
+ ["." version]
+ ["." language #_
+ ["#/." lux #_
+ ["#" version]]]]]
[world
[net (#+ URL)
- ["." uri]]]]
+ ["." uri (#+ URI)]]]]
["." // #_
["#." artifact (#+ Artifact)
["#/." extension (#+ Extension)]]])
@@ -38,38 +44,36 @@
#password Password})
(signature: #export (Repository !)
- (: (-> Artifact Extension (! (Try Binary)))
+ (: (-> URI (! (Try Binary)))
download)
- (: (-> Identity Artifact Extension Binary (! (Try Any)))
+ (: (-> Identity URI Binary (! (Try Any)))
upload))
(def: #export (async repository)
(-> (Repository IO) (Repository Promise))
(structure
- (def: (download artifact extension)
- (promise.future (\ repository download artifact extension)))
+ (def: (download uri)
+ (promise.future (\ repository download uri)))
- (def: (upload identity artifact extension content)
- (promise.future (\ repository upload identity artifact extension content)))
+ (def: (upload identity uri content)
+ (promise.future (\ repository upload identity uri content)))
))
(signature: #export (Simulation s)
- (: (-> Artifact Extension s
- (Try [s Binary]))
+ (: (-> URI s (Try [s Binary]))
on-download)
- (: (-> Identity Artifact Extension Binary s
- (Try s))
+ (: (-> Identity URI Binary s (Try s))
on-upload))
(def: #export (mock simulation init)
(All [s] (-> (Simulation s) s (Repository Promise)))
(let [state (stm.var init)]
(structure
- (def: (download artifact extension)
+ (def: (download uri)
(stm.commit
(do {! stm.monad}
[|state| (stm.read state)]
- (case (\ simulation on-download artifact extension |state|)
+ (case (\ simulation on-download uri |state|)
(#try.Success [|state| output])
(do !
[_ (stm.write |state| state)]
@@ -78,11 +82,11 @@
(#try.Failure error)
(wrap (#try.Failure error))))))
- (def: (upload identity artifact extension content)
+ (def: (upload identity uri content)
(stm.commit
(do {! stm.monad}
[|state| (stm.read state)]
- (case (\ simulation on-upload identity artifact extension content |state|)
+ (case (\ simulation on-upload identity uri content |state|)
(#try.Success |state|)
(do !
[_ (stm.write |state| state)]
@@ -98,6 +102,8 @@
["#::."
(close [] #io #try void)])
+(import: java/io/InputStream)
+
(import: java/io/OutputStream
["#::."
(flush [] #io #try void)
@@ -107,6 +113,7 @@
["#::."
(setDoOutput [boolean] #io #try void)
(setRequestProperty [java/lang/String java/lang/String] #io #try void)
+ (getInputStream [] #io #try java/io/InputStream)
(getOutputStream [] #io #try java/io/OutputStream)])
(import: java/net/HttpURLConnection
@@ -117,8 +124,7 @@
(import: java/net/URL
["#::."
(new [java/lang/String])
- (openConnection [] #io #try java/net/URLConnection)
- (openStream [] #io #try java/io/InputStream)])
+ (openConnection [] #io #try java/net/URLConnection)])
(import: java/util/Base64$Encoder
["#::."
@@ -128,8 +134,6 @@
["#::."
(#static getEncoder [] java/util/Base64$Encoder)])
-(import: java/io/InputStream)
-
(import: java/io/BufferedInputStream
["#::."
(new [java/io/InputStream])
@@ -141,42 +145,50 @@
(def: (basic-auth user password)
(-> User Password Text)
- (format "Basic " (java/util/Base64$Encoder::encodeToString (encoding.to-utf8 (format user ":" password))
+ (format "Basic " (java/util/Base64$Encoder::encodeToString (\ encoding.utf8 encode (format user ":" password))
(java/util/Base64::getEncoder))))
-(def: (url address artifact extension)
- (-> Address Artifact Extension URL)
- (format address uri.separator (//artifact.uri artifact) extension))
+(def: #export (uri artifact extension)
+ (-> Artifact Extension URI)
+ (format (//artifact.uri artifact) extension))
(def: buffer-size
(n.* 512 1,024))
+(def: user-agent
+ (format "LuxAedifex/" (version.format language/lux.version)))
+
(structure: #export (remote address)
(All [s] (-> Address (Repository IO)))
- (def: (download artifact extension)
- (let [url (..url address artifact extension)]
- (do {! (try.with io.monad)}
- [input (|> (java/net/URL::new url)
- java/net/URL::openStream
- (\ ! 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))
- (do !
- [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
- (recur (\ binary.monoid compose output chunk))))))))))
-
- (def: (upload [user password] artifact extension content)
+ (def: (download uri)
+ (do {! (try.with io.monad)}
+ [connection (|> (format address uri)
+ java/net/URL::new
+ java/net/URL::openConnection)
+ #let [connection (:coerce java/net/HttpURLConnection connection)]
+ _ (java/net/HttpURLConnection::setRequestMethod "GET" connection)
+ _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user-agent connection)
+ 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))
+ (do !
+ [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
+ (recur (\ binary.monoid compose output chunk)))))))))
+
+ (def: (upload [user password] uri content)
(do (try.with io.monad)
- [connection (|> (..url address artifact extension)
+ [connection (|> (format address uri)
java/net/URL::new
java/net/URL::openConnection)
#let [connection (:coerce java/net/HttpURLConnection connection)]
@@ -189,6 +201,6 @@
_ (java/lang/AutoCloseable::close stream)
code (java/net/HttpURLConnection::getResponseCode connection)]
(case code
- +200 (wrap [])
+ +201 (wrap [])
_ (\ io.monad wrap (exception.throw ..deployment-failure [code])))))
)
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 3e0aee4f0..933a599c0 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -171,7 +171,7 @@
actual))))
(let [polling-delay 1
amount-of-polls 5
- wiggle-room ($_ n.* amount-of-polls 2 polling-delay)
+ wiggle-room ($_ n.* amount-of-polls 4 polling-delay)
total-delay (|> polling-delay
(n.* amount-of-polls)
(n.+ wiggle-room))]
diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux
index 210ff4b1d..f8abf6a84 100644
--- a/stdlib/source/test/lux/control/concurrency/thread.lux
+++ b/stdlib/source/test/lux/control/concurrency/thread.lux
@@ -26,7 +26,8 @@
(do {! random.monad}
[dummy random.nat
expected random.nat
- delay (|> random.nat (\ ! map (n.% 100)))]
+ delay (\ ! map (|>> (n.% 5) (n.+ 5))
+ random.nat)]
($_ _.and
(_.cover [/.parallelism]
(n.> 0 /.parallelism))
@@ -37,10 +38,15 @@
(/.schedule delay (do io.monad
[execution-time instant.now]
(atom.write [execution-time expected] box))))
- _ (promise.wait delay)
+ _ (promise.wait (n.* 2 delay))
[execution-time actual] (promise.future (atom.read box))]
(_.cover' [/.schedule]
- (and (i.>= (.int delay)
- (duration.to-millis (instant.span reference-time execution-time)))
- (n.= expected actual)))))
+ (let [expected-delay!
+ (i.>= (.int delay)
+ (duration.to-millis (instant.span reference-time execution-time)))
+
+ correct-value!
+ (n.= expected actual)]
+ (and expected-delay!
+ correct-value!)))))
))))
diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux
index 7c1f5d932..dd5f4d6a8 100644
--- a/stdlib/source/test/lux/control/parser/text.lux
+++ b/stdlib/source/test/lux/control/parser/text.lux
@@ -11,7 +11,8 @@
["." maybe]
["." text ("#\." equivalence)
["%" format (#+ format)]
- ["." unicode
+ ["." unicode #_
+ ["#" set]
["#/." segment]]]
[number
["n" nat]]
diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux
index 73ccec27f..92f5915c7 100644
--- a/stdlib/source/test/lux/data/format/tar.lux
+++ b/stdlib/source/test/lux/data/format/tar.lux
@@ -15,7 +15,8 @@
["." text ("#\." equivalence)
["%" format (#+ format)]
["." encoding]
- ["." unicode
+ ["." unicode #_
+ ["#" set]
["#/." segment]]]
[number
["n" nat]
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index b9dfdb1a9..c751e6a78 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -24,7 +24,8 @@
["#." encoding]
["#." format]
["#." regex]
- ["#." unicode]]
+ ["#." unicode #_
+ ["#" set]]]
{1
["." /]})
diff --git a/stdlib/source/test/lux/data/text/unicode.lux b/stdlib/source/test/lux/data/text/unicode/set.lux
index 1b47c8cdb..21c5a90f1 100644
--- a/stdlib/source/test/lux/data/text/unicode.lux
+++ b/stdlib/source/test/lux/data/text/unicode/set.lux
@@ -16,16 +16,18 @@
[math
["." random (#+ Random)]]]
["." / #_
- ["#." segment]]
+ ["/#" // #_
+ ["#." segment]]]
{1
["." /
- ["." segment]]})
+ [//
+ ["." segment]]]})
(def: #export random
(Random /.Set)
(do {! random.monad}
- [left /segment.random
- right /segment.random]
+ [left //segment.random
+ right //segment.random]
(wrap (/.set [left (list right)]))))
(def: #export test
@@ -33,13 +35,13 @@
(<| (_.covering /._)
(_.for [/.Set])
(do {! random.monad}
- [segment /segment.random
+ [segment //segment.random
inside (\ ! map
(|>> (n.% (segment.size segment))
(n.+ (segment.start segment)))
random.nat)
- left /segment.random
- right /segment.random
+ left //segment.random
+ right //segment.random
#let [equivalence (product.equivalence n.equivalence
n.equivalence)]]
(`` ($_ _.and
@@ -87,5 +89,5 @@
[/.full]
))
- /segment.test
+ //segment.test
)))))
diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux
index 998671dd5..9fcb10006 100644
--- a/stdlib/source/test/lux/macro/syntax/common.lux
+++ b/stdlib/source/test/lux/macro/syntax/common.lux
@@ -27,7 +27,9 @@
["#." reader]
["#." writer]]}
["." /// #_
- ["#." code]])
+ ["#." code]]
+ ["." / #_
+ ["#." check]])
(def: annotations-equivalence
(Equivalence /.Annotations)
@@ -132,4 +134,6 @@
(#try.Failure error)
false))))
+
+ /check.test
)))
diff --git a/stdlib/source/test/lux/macro/syntax/common/check.lux b/stdlib/source/test/lux/macro/syntax/common/check.lux
new file mode 100644
index 000000000..63d042620
--- /dev/null
+++ b/stdlib/source/test/lux/macro/syntax/common/check.lux
@@ -0,0 +1,35 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ ["<>" parser
+ ["<.>" code]]]
+ [math
+ ["." random (#+ Random)]]
+ [macro
+ ["." code ("#\." equivalence)]]]
+ {1
+ ["." /]}
+ ["$." //// #_
+ ["#." code]])
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Check])
+ (do random.monad
+ [type $////code.random
+ value $////code.random]
+ (_.cover [/.write /.parser]
+ (case (<code>.run /.parser
+ (list (/.write {#/.type type
+ #/.value value})))
+ (#try.Failure _)
+ false
+
+ (#try.Success check)
+ (and (code\= type (get@ #/.type check))
+ (code\= value (get@ #/.value check))))))))