diff options
81 files changed, 1265 insertions, 973 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index f73182c03..0d258fd5a 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -6,19 +6,20 @@ ["." monad (#+ do)]] [control ["." try (#+ Try)]] - [target - ["/" jvm]] [data [identity (#+ Identity)] ["." product] - [number - ["." nat]] [text ["%" format (#+ format)]] [collection ["." list ("#@." fold)] ["." dictionary (#+ Dictionary)] ["." row (#+ Row) ("#@." functor fold)]]] + [math + [number + ["." nat]]] + [target + ["/" jvm]] [tool [compiler ["." phase] diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index 12e2fe412..212d9d854 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -5,13 +5,14 @@ ["." function]] [data ["." product] - [number - ["i" int]] ["." text ["%" format (#+ format)]] [collection ["." array (#+ Array)] ["." list ("#@." functor)]]] + [math + [number + ["i" int]]] [target [jvm [encoding diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index 341ded0e4..1f9e93c71 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -11,15 +11,16 @@ [data ["." product] ["." maybe] - [number - ["n" nat] - ["i" int]] [collection ["." list ("#@." functor)]]] [macro + [syntax (#+ syntax:)] ["." code] - ["." template] - [syntax (#+ syntax:)]] + ["." template]] + [math + [number + ["n" nat] + ["i" int]]] [target [jvm [encoding diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index b9d6ec6d1..f3bbb2a1c 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -6,10 +6,11 @@ ["." function] ["ex" exception (#+ exception:)]] [data - [number - ["n" nat]] [collection ["." list ("#@." fold)]]] + [math + [number + ["n" nat]]] [target [jvm ["." type (#+ Type) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux index ff56c7824..add0eefcc 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -8,11 +8,12 @@ ["<s>" synthesis (#+ Parser)]]] [data ["." product] - [number - ["f" frac]] [collection ["." list ("#@." monad)] ["." dictionary]]] + [math + [number + ["f" frac]]] [target [jvm ["." type]]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index d83a6d841..c3c522bfa 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -14,12 +14,13 @@ ["." maybe ("#@." functor)] ["." text ("#@." equivalence) ["%" format (#+ format)]] - [number - ["." nat]] [collection ["." list ("#@." monad)] ["." dictionary (#+ Dictionary)] ["." set]]] + [math + [number + ["." nat]]] [target [jvm ["." type (#+ Type Typed Argument) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index 0fe7717fb..6c03bd482 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -10,11 +10,12 @@ ["." product] [text ["%" format (#+ format)]] - [number - ["n" nat] - ["i" int]] [collection ["." list ("#@." functor monoid)]]] + [math + [number + ["n" nat] + ["i" int]]] [target [jvm ["." type (#+ Type) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux index 4b44561c7..5ad997539 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux @@ -5,10 +5,11 @@ [control ["." function]] [data - [number - ["n" nat]] [collection ["." list ("#@." functor monoid)]]] + [math + [number + ["n" nat]]] [tool [compiler ["." phase] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux index 2d8bff828..b42f63c4d 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -1,7 +1,7 @@ (.module: [lux (#- i64) ["." host (#+ import:)] - [data + [math [number ["i" int]]] [target diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index 061972df1..782187339 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -10,10 +10,10 @@ ["%" format (#+ format)]] [collection ["." list ("#@." functor)] - ["." row]] + ["." row]]] + ["." math [number ["n" nat]]] - ["." math] [target [jvm ["." type (#+ Type) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index a93b4845f..b3daed102 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -6,13 +6,14 @@ [control ["." exception (#+ exception:)]] [data - [number - ["n" nat] - ["i" int]] [text ["%" format (#+ format)]] [collection ["." list]]] + [math + [number + ["n" nat] + ["i" int]]] [target [jvm ["." type (#+ Type) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 2185bbb99..8aa5b344b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5877,4 +5877,4 @@ (..fail ":let requires an even number of parts")) _ - (..fail "Wrong syntax for :let"))) + (..fail (..wrong_syntax_error (name_of ..:let))))) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index faa7b77d9..fba2fe53e 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -15,7 +15,8 @@ ["cs" common ["csr" reader] ["csw" writer] - ["|.|" export]]]] + ["|.|" export] + ["|.|" annotations]]]] [math [number ["n" nat] @@ -108,11 +109,11 @@ (syntax: #export (word: {export |export|.parser} {name <c>.local_identifier} - {annotations (<>.default cs.empty_annotations csr.annotations)} + {annotations (<>.default |annotations|.empty |annotations|.parser)} type {commands (<>.some <c>.any)}) (wrap (list (` (def: (~+ (|export|.write export)) (~ (code.local_identifier name)) - (~ (csw.annotations annotations)) + (~ (|annotations|.write annotations)) (~ type) (|>> (~+ commands))))))) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index dac5f151b..ebdc3d514 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -22,7 +22,8 @@ ["cs" common ["csr" reader] ["csw" writer] - ["|.|" export]]]] + ["|.|" export] + ["|.|" annotations]]]] [math [number ["n" nat]]] @@ -304,7 +305,7 @@ (syntax: #export (actor: {export |export|.parser} {[name vars] actor_decl^} - {annotations (<>.default cs.empty_annotations csr.annotations)} + {annotations (<>.default |annotations|.empty |annotations|.parser)} state_type {[?on_mail ?on_stop messages] behavior^}) {#.doc (doc "Defines an actor, with its behavior and internal state." @@ -364,7 +365,7 @@ (syntax: #export (message: {export |export|.parser} {signature signature^} - {annotations (<>.default cs.empty_annotations csr.annotations)} + {annotations (<>.default |annotations|.empty |annotations|.parser)} body) {#.doc (doc "A message can access the actor's state through the state parameter." "A message can also access the actor itself through the self parameter." @@ -384,7 +385,7 @@ g!state (|> signature (get@ #state) code.local_identifier) g!self (|> signature (get@ #self) code.local_identifier)]] (wrap (list (` (def: (~+ (|export|.write export)) ((~ g!message) (~+ g!inputsC)) - (~ (csw.annotations annotations)) + (~ (|annotations|.write annotations)) (All [(~+ g!all_vars)] (-> (~+ g!inputsT) (..Message (~ (get@ #abstract.abstraction actor_scope)) diff --git a/stdlib/source/lux/control/parser/analysis.lux b/stdlib/source/lux/control/parser/analysis.lux index eaf659129..b825354c1 100644 --- a/stdlib/source/lux/control/parser/analysis.lux +++ b/stdlib/source/lux/control/parser/analysis.lux @@ -22,6 +22,8 @@ [tool [compiler [arity (#+ Arity)] + [reference (#+) + [variable (#+)]] [language [lux ["/" analysis (#+ Variant Tuple Environment Analysis)]]]]]] diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux index 8deecd32f..f6ae1c1ae 100644 --- a/stdlib/source/lux/control/parser/synthesis.lux +++ b/stdlib/source/lux/control/parser/synthesis.lux @@ -17,7 +17,7 @@ ["." frac]]] [tool [compiler - [reference + [reference (#+) [variable (#+ Register)]] [arity (#+ Arity)] [language diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index bd7c0368a..8f2430bff 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -23,7 +23,8 @@ ["." reader] ["." writer] ["|.|" export] - ["|.|" declaration]]]]]) + ["|.|" declaration] + ["|.|" annotations]]]]]) (abstract: #export (Capability brand input output) (-> input output) @@ -46,7 +47,7 @@ (syntax: #export (capability: {export |export|.parser} {declaration |declaration|.parser} - {annotations (<>.maybe reader.annotations)} + {annotations (<>.maybe |annotations|.parser)} {[forge input output] (<c>.form ($_ <>.and <c>.local_identifier <c>.any <c>.any))}) (do {! meta.monad} [this_module meta.current_module_name diff --git a/stdlib/source/lux/data/collection/tree/zipper.lux b/stdlib/source/lux/data/collection/tree/zipper.lux index 8007000d8..290f5143e 100644 --- a/stdlib/source/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/lux/data/collection/tree/zipper.lux @@ -115,20 +115,26 @@ [(def: #export (<one> zipper) (All [a] (-> (Zipper a) (Maybe (Zipper a)))) (case (get@ #family zipper) - #.None - #.None - (#.Some family) (case (get@ <side> family) + (#.Cons next side') + (#.Some (for {@.old + {#family (#.Some (|> family + (set@ <side> side') + (update@ <op-side> (|>> (#.Cons (get@ #node zipper)))))) + #node next}} + (let [move (: (All [a] (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a))) + (function (_ side' zipper) + (|>> (set@ <side> side') + (update@ <op-side> (|>> (#.Cons (get@ #node zipper)))))))] + {#family (#.Some (move side' zipper family)) + #node next}))) + #.Nil - #.None + #.None) - (#.Cons next side') - (#.Some {#family (|> family - (set@ <side> side') - (update@ <op-side> (|>> (#.Cons (get@ #node zipper)))) - #.Some) - #node next})))) + #.None + #.None)) (def: #export (<all> zipper) (All [a] (-> (Zipper a) (Maybe (Zipper a)))) @@ -142,11 +148,18 @@ #.None (#.Cons last prevs) - (#.Some {#family (#.Some (|> family - (set@ <side> #.Nil) - (update@ <op-side> (|>> (#.Cons (get@ #node zipper)) - (list\compose prevs))))) - #node last}))))] + (#.Some (for {@.old {#family (#.Some (|> family + (set@ <side> #.Nil) + (update@ <op-side> (|>> (#.Cons (get@ #node zipper)) + (list\compose prevs))))) + #node last}} + (let [move (: (All [a] (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a))) + (function (_ prevs zipper) + (|>> (set@ <side> #.Nil) + (update@ <op-side> (|>> (#.Cons (get@ #node zipper)) + (list\compose prevs))))))] + {#family (#.Some (move prevs zipper family)) + #node last}))))))] [right rightmost #rights #lefts] [left leftmost #lefts #rights] diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index aa805649b..6b2a84622 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -2,13 +2,6 @@ "The goal is to be able to reuse common syntax in macro definitions across libraries.")} [lux #*]) -(type: #export Annotations - (List [Name Code])) - -(def: #export empty_annotations - Annotations - (list)) - (type: #export Typed_Input {#input_binding Code #input_type Code}) diff --git a/stdlib/source/lux/macro/syntax/common/annotations.lux b/stdlib/source/lux/macro/syntax/common/annotations.lux new file mode 100644 index 000000000..e1ee52274 --- /dev/null +++ b/stdlib/source/lux/macro/syntax/common/annotations.lux @@ -0,0 +1,41 @@ +(.module: + [lux #* + [abstract + [equivalence (#+ Equivalence)]] + [control + ["." function] + ["<>" parser + ["<.>" code (#+ Parser)]]] + [data + ["." product] + ["." name] + [collection + ["." list ("#\." functor)]]] + [macro + ["." code]]]) + +(type: #export Annotations + (List [Name Code])) + +(def: #export equivalence + (Equivalence Annotations) + (list.equivalence + (product.equivalence name.equivalence + code.equivalence))) + +(def: #export empty + Annotations + (list)) + +(def: #export write + (-> Annotations Code) + (let [entry (product.both code.tag function.identity)] + (|>> (list\map entry) + code.record))) + +(def: #export parser + (Parser Annotations) + (<code>.record + (<>.some + (<>.and <code>.tag + <code>.any)))) diff --git a/stdlib/source/lux/macro/syntax/common/definition.lux b/stdlib/source/lux/macro/syntax/common/definition.lux index eca7eac02..cdb382dc1 100644 --- a/stdlib/source/lux/macro/syntax/common/definition.lux +++ b/stdlib/source/lux/macro/syntax/common/definition.lux @@ -21,7 +21,8 @@ ["." code]] [meta ["." location]]] - ["." // (#+ Annotations) + ["." // + ["#." annotations (#+ Annotations)] ["#." check (#+ Check)]]) (type: #export Definition @@ -39,8 +40,7 @@ //check.equivalence code.equivalence ) - (list.equivalence (product.equivalence name.equivalence - code.equivalence)) + //annotations.equivalence bit.equivalence )) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 5a683ed3c..fcf9ce0d0 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -14,11 +14,6 @@ ["." meta]] ["." //]) -(def: #export annotations - {#.doc "Reader for the common annotations syntax used by def: statements."} - (Parser //.Annotations) - (s.record (p.some (p.and s.tag s.any)))) - (def: (flat_list^ _) (-> Any (Parser (List Code))) (p.either (do p.monad diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index 22a4400c2..6657e9b9d 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -11,11 +11,6 @@ ["." code]]] ["." //]) -(def: #export annotations - (-> //.Annotations Code) - (|>> (list\map (product.both code.tag function.identity)) - code.record)) - (def: #export (typed_input value) (-> //.Typed_Input Code) (code.record (list [(get@ #//.input_binding value) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index 617cd8929..8b1b68e97 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -1,131 +1,130 @@ (.module: [lux #* [abstract - [predicate (#+ Predicate)]] + [predicate (#+ Predicate)] + [functor + ["." contravariant]]] [data [collection ["." list] ["." set (#+ Set)]]] [math [number - ["r" rev]]]] - [// - ["&" continuous]]) + ["/" rev]]]] + ["." // #_ + ["#" continuous]]) (type: #export (Fuzzy a) (-> a Rev)) -(def: #export (membership elem set) - (All [a] (-> a (Fuzzy a) Rev)) +(structure: #export functor + (contravariant.Functor Fuzzy) + + (def: (map f fb) + (|>> f fb))) + +(template [<name> <verdict>] + [(def: #export <name> + Fuzzy + (function (_ _) + <verdict>))] + + [empty //.false] + [full //.true] + ) + +(def: #export (membership set elem) + (All [a] (-> (Fuzzy a) a Rev)) (set elem)) -(def: #export (union left right) - (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a))) - (function (_ elem) - (&.or (membership elem left) - (membership elem right)))) +(template [<set_composition> <membership_composition>] + [(def: #export (<set_composition> left right) + (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a))) + (function (_ elem) + (<membership_composition> (left elem) + (right elem))))] -(def: #export (intersection left right) - (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a))) - (function (_ elem) - (&.and (membership elem left) - (membership elem right)))) + [union //.or] + [intersection //.and] + ) (def: #export (complement set) (All [a] (-> (Fuzzy a) (Fuzzy a))) - (function (_ elem) - (&.not (membership elem set)))) + (|>> set //.not)) (def: #export (difference sub base) (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a))) - (function (_ elem) - (&.and (membership elem base) - (&.not (membership elem sub))))) + (..intersection (..complement sub) base)) (def: #export (from_predicate predicate) (All [a] (-> (Predicate a) (Fuzzy a))) (function (_ elem) (if (predicate elem) - &.true - &.false))) + //.true + //.false))) -(def: #export (from_set set) +(def: #export (to_predicate treshold set) + (All [a] (-> Rev (Fuzzy a) (Predicate a))) + (function (_ elem) + (/.> treshold (set elem)))) + +(def: #export from_set (All [a] (-> (Set a) (Fuzzy a))) - (from_predicate (set.member? set))) + (|>> set.member? ..from_predicate)) (def: (ascending from to) (-> Rev Rev (Fuzzy Rev)) - (function (_ elem) - (cond (r.<= from elem) - &.false + (let [measure (/.- from to)] + (function (_ elem) + (cond (/.< from elem) + ## below + //.false - (r.>= to elem) - &.true + (/.< to elem) + ## in the middle... + (/./ measure + (/.- from elem)) - ## in the middle... - (r./ (r.- from to) - (r.- from elem))))) + ## above + //.true)))) (def: (descending from to) (-> Rev Rev (Fuzzy Rev)) - (function (_ elem) - (cond (r.<= from elem) - &.true - - (r.>= to elem) - &.false - - ## in the middle... - (r./ (r.- from to) - (r.- elem to))))) + (..complement (..ascending from to))) (def: #export (gradient from to) (-> Rev Rev (Fuzzy Rev)) - (if (r.< to from) - (ascending from to) - (descending from to))) + (if (/.< to from) + (..ascending from to) + (..descending from to))) + +(template: (!sort_2 <low> <high>) + (if (/.> <low> <high>) + [<low> <high>] + [<high> <low>])) (def: #export (triangle bottom middle top) (-> Rev Rev Rev (Fuzzy Rev)) - (case (list.sort r.< (list bottom middle top)) - (^ (list bottom middle top)) - (intersection (ascending bottom middle) - (descending middle top)) - - _ - (undefined))) + (let [[low_0 high_0] (!sort_2 bottom middle) + [bottom' high_1] (!sort_2 low_0 top) + [middle' top'] (!sort_2 high_0 high_1)] + (..intersection (..ascending bottom' middle') + (..descending middle' top')))) (def: #export (trapezoid bottom middle_bottom middle_top top) (-> Rev Rev Rev Rev (Fuzzy Rev)) - (case (list.sort r.< (list bottom middle_bottom middle_top top)) - (^ (list bottom middle_bottom middle_top top)) - (intersection (ascending bottom middle_bottom) - (descending middle_top top)) - - _ - (undefined))) + (let [[low_0 high_0] (!sort_2 bottom middle_bottom) + [low_1 high_1] (!sort_2 middle_top top) + [bottom' middle_0] (!sort_2 low_0 low_1) + [middle_1 top'] (!sort_2 high_0 high_1) + [middle_bottom' middle_top'] (!sort_2 middle_0 middle_1)] + (..intersection (..ascending bottom' middle_bottom') + (..descending middle_top' top')))) (def: #export (cut treshold set) (All [a] (-> Rev (Fuzzy a) (Fuzzy a))) (function (_ elem) (let [membership (set elem)] - (if (r.> treshold membership) - (|> membership (r.- treshold) (r.* &.true)) - &.false)))) - -(def: #export (to_predicate treshold set) - (All [a] (-> Rev (Fuzzy a) (Predicate a))) - (function (_ elem) - (r.> treshold (set elem)))) - -(type: #export (Fuzzy2 a) - (-> a [Rev Rev])) - -(def: #export (type_2 lower upper) - (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy2 a))) - (function (_ elem) - (let [l_rev (lower elem) - u_rev (upper elem)] - [(r.min l_rev - u_rev) - u_rev]))) + (if (/.< treshold membership) + //.false + (|> membership (/.- treshold) (/.* //.true)))))) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 8a7ae3b59..8cc4842e7 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -118,17 +118,12 @@ (#try.Success [compiler []]) (#try.Failure message)))) -(def: (with_location location error) - (-> Location Text Text) - ($_ text\compose (location.format location) text.new_line - error)) - (def: #export (fail error) {#.doc "Fails with the given error message."} (All [a] (-> Text (Meta a))) (function (_ state) - (#try.Failure (..with_location (get@ #.location state) error)))) + (#try.Failure (location.with (get@ #.location state) error)))) (def: #export (find_module name) (-> Text (Meta Module)) diff --git a/stdlib/source/lux/meta/location.lux b/stdlib/source/lux/meta/location.lux index 75acdf755..ec35a83e6 100644 --- a/stdlib/source/lux/meta/location.lux +++ b/stdlib/source/lux/meta/location.lux @@ -17,7 +17,7 @@ (~ [..dummy (#.Nat (get@ #.column location))])]))])) _ - (#.Left "Wrong syntax for here"))) + (#.Left (("lux in-module" "lux" wrong_syntax_error) (name_of ..here))))) (def: #export (format value) (-> Location Text) @@ -28,3 +28,11 @@ (("lux in-module" "lux" .text\encode) file) separator (("lux in-module" "lux" .nat\encode) line) separator (("lux in-module" "lux" .nat\encode) column)))) + +(def: \n + ("lux i64 char" +10)) + +(def: #export (with location error) + (-> Location Text Text) + ($_ "lux text concat" (..format location) \n + error)) diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux index 040c277b8..6305e361f 100644 --- a/stdlib/source/lux/target/jvm/reflection.lux +++ b/stdlib/source/lux/target/jvm/reflection.lux @@ -10,14 +10,15 @@ [parser ["<t>" text]]] [data - [number - ["n" nat]] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list ("#\." fold functor)] ["." array] - ["." dictionary]]]] + ["." dictionary]]] + [math + [number + ["n" nat]]]] ["." // #_ [encoding ["#." name (#+ External)]] diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux index 19dada86b..521c88a23 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux @@ -1,15 +1,13 @@ (.module: [lux (#- Module) + ["." meta] [abstract [monad (#+ do)]] [control ["." try]] - [data - ["." text - ["%" format (#+ format)]] + [math [number - ["n" nat]]] - ["." meta]] + ["n" nat]]]] [// (#+ Operation) [macro (#+ Expander)] [// diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index dec7625fa..f48155088 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -1,5 +1,6 @@ (.module: [lux (#- case) + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -8,17 +9,17 @@ [data ["." product] ["." maybe] - [number - ["n" nat]] [text ["%" format (#+ format)]] [collection ["." list ("#\." fold monoid functor)]]] - ["." type - ["." check]] - ["." meta] + [math + [number + ["n" nat]]] [macro - ["." code]]] + ["." code]] + ["." type + ["." check]]] ["." / #_ ["#." coverage (#+ Coverage)] ["/#" // #_ diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux index 82f23b0f6..af5a12c37 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux @@ -9,13 +9,14 @@ [data ["." bit ("#\." equivalence)] ["." maybe] - [number - ["n" nat]] ["." text ["%" format (#+ Format format)]] [collection ["." list ("#\." functor fold)] - ["." dictionary (#+ Dictionary)]]]] + ["." dictionary (#+ Dictionary)]]] + [math + [number + ["n" nat]]]] ["." //// #_ [// ["/" analysis (#+ Pattern Variant Operation)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 552216119..31a5cb912 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -6,12 +6,13 @@ ["." exception (#+ exception:)]] [data ["." maybe] - [number - ["n" nat]] ["." text ["%" format (#+ format)]] [collection ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]] ["." type ["." check]] ["." meta]] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux index fb5df2084..dadc61c2d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -9,18 +10,18 @@ ["." name] ["." product] ["." maybe] - [number - ["n" nat]] [text ["%" format (#+ format)]] [collection ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]] - ["." type - ["." check]] - ["." meta] [macro - ["." code]]] + ["." code]] + [math + [number + ["n" nat]]] + ["." type + ["." check]]] ["." // #_ ["#." type] ["#." primitive] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 8a4ef09d5..fe753e2cc 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -14,16 +14,15 @@ [data ["." maybe] ["." product] - [number - ["n" nat]] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list ("#\." fold monad monoid)] ["." array] ["." dictionary (#+ Dictionary)]]] - ["." type - ["." check (#+ Check) ("#\." monad)]] + [math + [number + ["n" nat]]] [target ["." jvm #_ [".!" reflection] @@ -37,7 +36,9 @@ ["." signature] ["#_." parser] ["#_." alias (#+ Aliasing)] - [".T" lux (#+ Mapping)]]]]] + [".T" lux (#+ Mapping)]]]] + ["." type + ["." check (#+ Check) ("#\." monad)]]] ["." // #_ ["#." lux (#+ custom)] ["/#" // diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index a76bfcc60..0d18884cb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -10,13 +10,14 @@ ["<c>" code (#+ Parser)]]] [data ["." maybe] - [number - ["n" nat]] ["." text ["%" format (#+ format)]] [collection ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]] + [math + [number + ["n" nat]]] [type ["." check]] ["." meta]] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 2837d6620..a00fe5273 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -10,18 +10,17 @@ ["<t>" text]]] [data ["." product] - [number - ["." i32]] [text ["%" format (#+ format)]] [collection ["." list ("#\." functor fold)] ["." dictionary] ["." row]]] - [type - ["." check (#+ Check)]] [macro ["." template]] + [math + [number + ["." i32]]] [target [jvm ["_" bytecode (#+ Bytecode)] @@ -57,7 +56,9 @@ [analysis ["." jvm]] [directive - ["/" lux]]]]]]]) + ["/" lux]]]]]] + [type + ["." check (#+ Check)]]]) (type: Operation (directive.Operation Anchor (Bytecode Any) Definition)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 76c9554b7..4b84727aa 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -14,12 +15,12 @@ ["." text ["%" format (#+ format)]] [collection - ["." dictionary]] - [number - ["n" nat]]] - ["." meta] + ["." dictionary]]] [macro ["." code]] + [math + [number + ["n" nat]]] ["." type (#+ :share) ["." check]]] ["." /// (#+ Extender) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 51f647d94..cc86b7df2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -7,10 +7,6 @@ ["." try]] [data [binary (#+ Binary)] - [number - ["." i32] - ["." i64] - ["n" nat]] [collection ["." list ("#\." functor)] ["." row]] @@ -18,6 +14,11 @@ ["#" binary]] [text ["%" format (#+ format)]]] + [math + [number + ["n" nat] + ["." i32] + ["." i64]]] [target ["." jvm #_ ["_" bytecode (#+ Label Bytecode)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 057302ef7..f0bd340b1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -9,13 +9,14 @@ ["." product] ["." bit ("#\." equivalence)] ["." text ("#\." equivalence)] + [collection + ["." list ("#\." functor fold monoid)] + ["." set (#+ Set)]]] + [math [number ["." i64] ["n" nat] - ["." frac ("#\." equivalence)]] - [collection - ["." list ("#\." functor fold monoid)] - ["." set (#+ Set)]]]] + ["." frac ("#\." equivalence)]]]] ["." /// #_ [// ["#." analysis (#+ Pattern Match Analysis)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index bc6aee080..d3558e9c4 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -10,10 +10,11 @@ ["." maybe ("#\." functor)] ["." text ["%" format (#+ format)]] - [number - ["n" nat]] [collection - ["." list ("#\." functor monoid fold)]]]] + ["." list ("#\." functor monoid fold)]]] + [math + [number + ["n" nat]]]] ["." // #_ ["#." loop (#+ Transform)] ["//#" /// #_ diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index 0cd95f100..e0fbf816c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -4,10 +4,11 @@ ["." monad (#+ do)]] [data ["." maybe ("#\." monad)] - [number - ["n" nat]] [collection - ["." list]]]] + ["." list]]] + [math + [number + ["n" nat]]]] [//// ["." analysis (#+ Environment)] ["/" synthesis (#+ Path Abstraction Synthesis)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 31693f4a0..68e12745d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -8,14 +8,15 @@ [data ["." product] ["." maybe ("#\." functor)] - [number - ["n" nat]] ["." text ["%" format]] [collection ["." dictionary (#+ Dictionary)] ["." list ("#\." functor fold)] - ["." set]]]] + ["." set]]] + [math + [number + ["n" nat]]]] [//// ["/" synthesis (#+ Path Synthesis)] ["." analysis] diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index 0b2db4346..a755d2bec 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -22,7 +22,8 @@ ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)] ["." row (#+ Row)] - ["." set]] + ["." set]]] + [math [number ["n" nat]]] [world diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index 61fb97ddf..d92d1e686 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -14,11 +14,12 @@ ["." binary (#+ Binary)] ["." text ["%" format (#+ format)]] - [number - ["n" nat]] [collection ["." row (#+ Row)] ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]] [target [jvm [encoding diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index ca2382eab..d65093d7c 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -19,7 +19,8 @@ ["cs" common ["csr" reader] ["csw" writer] - ["|.|" export]]]]]) + ["|.|" export] + ["|.|" annotations]]]]]) (type: Stack List) @@ -210,7 +211,7 @@ {export |export|.parser} {[name type_vars] declaration} representation_type - {annotations (<>.default cs.empty_annotations csr.annotations)} + {annotations (<>.default |annotations|.empty |annotations|.parser)} {primitives (<>.some <c>.any)}) (do meta.monad [current_module meta.current_module_name @@ -223,7 +224,7 @@ abstraction_declaration representation_declaration])] (wrap (list& (` (type: (~+ (|export|.write export)) (~ abstraction_declaration) - (~ (csw.annotations annotations)) + (~ (|annotations|.write annotations)) (primitive (~ (code.text (abstraction_type_name [current_module name]))) [(~+ type_varsC)]))) (` (type: (~ representation_declaration) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index 584a90604..8fad9d2a6 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -18,7 +18,8 @@ ["cs" common ["csr" reader] ["csw" writer] - ["|.|" export]]]] + ["|.|" export] + ["|.|" annotations]]]] [math [number ["i" int] @@ -74,9 +75,9 @@ (syntax: #export (unit: {export |export|.parser} {name s.local_identifier} - {annotations (p.default cs.empty_annotations csr.annotations)}) + {annotations (p.default |annotations|.empty |annotations|.parser)}) (wrap (list (` (type: (~+ (|export|.write export)) (~ (code.local_identifier name)) - (~ (csw.annotations annotations)) + (~ (|annotations|.write annotations)) (primitive (~ (code.text (unit_name name)))))) (` (def: (~+ (|export|.write export)) (~ (code.local_identifier (format "@" name))) (~ (code.local_identifier name)) @@ -98,10 +99,10 @@ {export |export|.parser} {name s.local_identifier} {(^slots [#ratio.numerator #ratio.denominator]) ratio^} - {annotations (p.default cs.empty_annotations csr.annotations)}) + {annotations (p.default |annotations|.empty |annotations|.parser)}) (let [g!scale (code.local_identifier name)] (wrap (list (` (type: (~+ (|export|.write export)) ((~ g!scale) (~' u)) - (~ (csw.annotations annotations)) + (~ (|annotations|.write annotations)) (primitive (~ (code.text (scale_name name))) [(~' u)]))) (` (structure: (~+ (|export|.write export)) (~ (code.local_identifier (format "@" name))) (..Scale (~ g!scale)) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 699730028..8e60de863 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -1192,3 +1192,12 @@ (#try.Failure error) (wrap (#try.Failure error)))))))) + +(def: #export (parent system path) + (All [!] (-> (System !) Path Path)) + (let [/ (\ system separator)] + (|> path + (text.split_all_with /) + list.inits + (maybe.default (list)) + (text.join_with /)))) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index c978be703..15ff185b5 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -290,7 +290,7 @@ (import: java/nio/file/Path ["#::." - (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind ?)]] #io #try java/nio/file/WatchKey) + (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind java/lang/Object)]] #io #try java/nio/file/WatchKey) (toString [] java/lang/String)]) (import: java/nio/file/StandardWatchEventKinds diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 6a4deb3c3..52269d053 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -47,7 +47,8 @@ ["#." dependency #_ ["#" resolution (#+ Resolution)]] ["#." repository (#+ Repository) - ["#/." remote (#+ Address)]] + ["#/." remote (#+ Address)] + ["#/." local]] ["#." command (#+ Command) ["#/." version] ["#/." clean] @@ -71,7 +72,10 @@ (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command a)) (Command a))) (do /action.monad - [resolution (/command/deps.do! program console (file.async file.default) (..repositories profile) profile)] + [resolution (/command/deps.do! console + (/repository/local.repository program (file.async file.default)) + (..repositories profile) + profile)] ((command console program (file.async file.default) (shell.async shell.default) resolution) profile))) (exception: (cannot_find_repository {repository Text} @@ -141,7 +145,8 @@ #/cli.Install (..command - (/command/install.do! program console (file.async file.default) profile)) + (let [fs (file.async file.default)] + (/command/install.do! console fs (/repository/local.repository program fs) profile))) (#/cli.Deploy repository identity) (..command @@ -162,7 +167,10 @@ #/cli.Dependencies (..command - (/command/deps.do! program console (file.async file.default) (..repositories profile) profile)) + (/command/deps.do! console + (/repository/local.repository program (file.async file.default)) + (..repositories profile) + profile)) (#/cli.Compilation compilation) (case compilation @@ -182,5 +190,8 @@ (..command (case auto #/cli.Build (..with_dependencies program console (/command/auto.do! watcher /command/build.do!) profile) - #/cli.Test (..with_dependencies program console (/command/auto.do! watcher /command/test.do!) profile))))))) + #/cli.Test (..with_dependencies program console (/command/auto.do! watcher /command/test.do!) profile))))) + + _ + (undefined))) )))))) diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux index 6ba0a1e48..07b53157f 100644 --- a/stdlib/source/program/aedifex/artifact.lux +++ b/stdlib/source/program/aedifex/artifact.lux @@ -68,24 +68,14 @@ (text.split_all_with ..group_separator) (text.join_with separator))) -(def: (address separator artifact) - (-> Text Artifact Text) - (let [directory (%.format (..directory separator (get@ #group artifact)) - separator - (get@ #name artifact) - separator - (get@ #version artifact))] - (%.format directory - separator - (..identity artifact)))) - -(def: #export uri +(def: #export (uri artifact) (-> Artifact URI) - (..address uri.separator)) - -(def: #export (path system) - (All [!] (-> (file.System !) Artifact Path)) - (..address (\ system separator))) + (let [/ uri.separator + group (..directory / (get@ #group artifact)) + name (get@ #name artifact) + version (get@ #version artifact) + identity (..identity artifact)] + (%.format group / name / version / identity))) (def: #export (local artifact) (-> Artifact (List Text)) diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux deleted file mode 100644 index a7f6439df..000000000 --- a/stdlib/source/program/aedifex/cache.lux +++ /dev/null @@ -1,166 +0,0 @@ -(.module: - [lux #* - [abstract - [codec (#+ Codec)] - ["." monad (#+ do)]] - [control - ["." try (#+ Try)] - [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] - [data - [binary (#+ Binary)] - ["." product] - [text - ["%" format (#+ format)] - ["." encoding]] - [collection - ["." dictionary] - ["." set (#+ Set)] - ["." list]] - [format - ["." xml]]] - [world - [program (#+ Program)] - ["." file (#+ Path File Directory)]]] - ["." // #_ - ["#" local] - ["#." hash (#+ Hash SHA-1 MD5)] - ["#." package (#+ Package)] - ["#." artifact (#+ Artifact) - ["#/." type] - ["#/." extension (#+ Extension)]] - ["#." dependency (#+ Dependency) - [resolution (#+ Resolution)] - ["#/." status (#+ Status)]] - ["#." repository #_ - ["#/." origin]]]) - -(def: (write! system content file) - (-> (file.System Promise) Binary Path (Promise (Try Any))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad system file))] - (!.use (\ file over_write) [content]))) - -(def: (write_hashed system directory [artifact type] [data status]) - (-> (file.System Promise) Path Dependency [Binary Status] (Promise (Try Any))) - (let [prefix (format directory - (\ system separator) - (//artifact.identity artifact) - (//artifact/extension.extension type))] - (do {! (try.with promise.monad)} - [_ (..write! system data prefix) - #let [write_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any)))) - (function (_ codec extension hash) - (..write! system - (|> hash (\ codec encode) (\ encoding.utf8 encode)) - (format prefix extension))))]] - (case status - #//dependency/status.Unverified - (wrap []) - - (#//dependency/status.Partial partial) - (case partial - (#.Left sha-1) - (write_hash //hash.sha-1_codec //artifact/extension.sha-1 sha-1) - - (#.Right md5) - (write_hash //hash.md5_codec //artifact/extension.md5 md5)) - - (#//dependency/status.Verified sha-1 md5) - (do ! - [_ (write_hash //hash.sha-1_codec //artifact/extension.sha-1 sha-1)] - (write_hash //hash.md5_codec //artifact/extension.md5 md5)))))) - -(def: #export (write_one program system [artifact type] package) - (-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact))) - (do promise.monad - [home (\ program home [])] - (do (try.with promise.monad) - [directory (: (Promise (Try Path)) - (file.make_directories promise.monad system (//.path system home artifact))) - _ (write_hashed system directory [artifact type] (get@ #//package.library package)) - _ (let [[pom status] (get@ #//package.pom package)] - (write_hashed system directory - [artifact //artifact/type.pom] - [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) - status]))] - (wrap artifact)))) - -(def: #export (write_all program system resolution) - (-> (Program Promise) (file.System Promise) Resolution (Promise (Try (Set Artifact)))) - (do {! (try.with promise.monad)} - [] - (|> (dictionary.entries resolution) - (list.filter (|>> product.right //package.local? not)) - (monad.map ! (function (_ [dependency package]) - (..write_one program system dependency package))) - (\ ! map (set.from_list //artifact.hash))))) - -(def: (read! system path) - (-> (file.System Promise) Path (Promise (Try Binary))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (!.use (\ system file) path))] - (!.use (\ file content) []))) - -(def: (decode codec data) - (All [a] (-> (Codec Text a) Binary (Try a))) - (let [(^open "_\.") try.monad] - (|> data - (\ encoding.utf8 decode) - (_\map (\ codec decode)) - _\join))) - -(def: #export (read_one program system [artifact type]) - (-> (Program Promise) (file.System Promise) Dependency (Promise (Try Package))) - (do promise.monad - [home (\ program home []) - #let [prefix (format (//.path system home artifact) - (\ system separator) - (//artifact.identity artifact))]] - (do (try.with promise.monad) - [pom (..read! system (format prefix //artifact/extension.pom)) - #let [extension (//artifact/extension.extension type)] - library (..read! system (format prefix extension)) - library_sha-1 (..read! system (format prefix extension //artifact/extension.sha-1)) - library_md5 (..read! system (format prefix extension //artifact/extension.md5))] - (\ promise.monad wrap - (do try.monad - [pom (..decode xml.codec pom) - library_sha-1 (..decode //hash.sha-1_codec library_sha-1) - library_md5 (..decode //hash.md5_codec library_md5)] - (wrap {#//package.origin (#//repository/origin.Local prefix) - #//package.library [library (#//dependency/status.Verified library_sha-1 library_md5)] - #//package.pom [pom #//dependency/status.Unverified]})))))) - -(def: #export (read_all program system dependencies resolution) - (-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution))) - (case dependencies - #.Nil - (\ (try.with promise.monad) wrap resolution) - - (#.Cons head tail) - (do promise.monad - [package (case (dictionary.get head resolution) - (#.Some package) - (wrap (#try.Success package)) - - #.None - (..read_one program system head))] - (with_expansions [<next> (as_is (read_all program system tail resolution))] - (case package - (#try.Success package) - (do (try.with promise.monad) - [sub_dependencies (|> package - //package.dependencies - (\ promise.monad wrap)) - resolution (|> resolution - (dictionary.put head package) - (read_all program system (set.to_list sub_dependencies)))] - <next>) - - (#try.Failure error) - <next>))))) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index a05d7ad85..7241b1de4 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -26,13 +26,14 @@ [program (#+ Program)] ["." file (#+ Path)] ["." shell (#+ Shell)] - ["." console (#+ Console)]]] + ["." console (#+ Console)] + [net + ["." uri]]]] ["." /// #_ ["#" profile] ["#." action] ["#." command (#+ Command)] ["#." local] - ["#." cache] ["#." repository] ["#." runtime] ["#." dependency (#+ Dependency) @@ -102,11 +103,19 @@ _ (exception.throw ..no_available_compiler []))) +(def: (path fs home artifact) + (All [!] (-> (file.System !) Path Artifact Path)) + (let [/ (\ fs separator)] + (|> artifact + ///local.uri + (text.replace_all uri.separator /) + (format home /)))) + (def: (libraries fs home) (All [!] (-> (file.System !) Path Resolution (List Path))) (|>> dictionary.keys (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux_library))) - (list\map (|>> (get@ #///dependency.artifact) (///local.path fs home))))) + (list\map (|>> (get@ #///dependency.artifact) (..path fs home))))) (def: (singular name) (-> Text Text (List Text)) @@ -138,9 +147,9 @@ (do ///action.monad [[resolution compiler] (promise\wrap (..compiler resolution)) #let [[command output] (let [[compiler output] (case compiler - (#JVM artifact) [(///runtime.java (///local.path fs home artifact)) + (#JVM artifact) [(///runtime.java (..path fs home artifact)) "program.jar"] - (#JS artifact) [(///runtime.node (///local.path fs home artifact)) + (#JS artifact) [(///runtime.node (..path fs home artifact)) "program.js"])] [(format compiler " build") output]) / (\ fs separator) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index b00f964d7..fe96055ef 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -36,9 +36,14 @@ ["#." action (#+ Action)] ["#." pom] ["#." hash] + ["#." package] + ["#." dependency + ["#/." deployment] + ["#/." status (#+ Status)]] ["#." repository (#+ Repository) [identity (#+ Identity)] - ["#/." remote]] + ["#/." remote] + ["#/." origin]] ["#." metadata ["#/." artifact] ["#/." snapshot]] @@ -46,94 +51,24 @@ ["#/." 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 artifact profile) (-> (Console Promise) (Repository Promise) (file.System Promise) Artifact (Command Any)) - (let [deploy! (: (-> Extension Binary (Action Any)) - (|>> (///repository/remote.uri artifact) - (\ repository upload))) - 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 (///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 (///metadata.project artifact)))] - (console.write_line //clean.success console))))) + (do {! ///action.monad} + [library (|> profile + (get@ #/.sources) + set.to_list + (export.library fs) + (\ ! map (binary.run tar.writer))) + pom (\ promise.monad wrap (///pom.write profile)) + _ (///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)]})] + (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 315c6375c..71dffeec1 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -7,7 +7,9 @@ ["." promise (#+ Promise)]]] [data [collection - ["." set (#+ Set)]]] + ["." set (#+ Set)] + ["." list ("#\." fold)] + ["." dictionary]]] [world [program (#+ Program)] ["." file] @@ -20,16 +22,18 @@ [repository (#+ Repository)] ["#" profile] ["#." action (#+ Action)] - ["#." cache] ["#." dependency #_ - ["#/." resolution (#+ Resolution)]]]]) + ["#/." resolution (#+ Resolution)] + ["#/." deployment]]]]) -(def: #export (do! program console fs repositories profile) - (-> (Program Promise) (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution)) +(def: #export (do! console local remotes profile) + (-> (Console Promise) (Repository Promise) (List (Repository Promise)) (Command Resolution)) (do ///action.monad [#let [dependencies (set.to_list (get@ #///.dependencies profile))] - cache (///cache.read_all program fs dependencies ///dependency/resolution.empty) - resolution (///dependency/resolution.all repositories dependencies cache) - cached (///cache.write_all program fs resolution) + 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))) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 033b41b40..b051a4900 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -35,36 +35,35 @@ ["#." command (#+ Command)] ["#." local] ["#." pom] + ["#." package] + [repository (#+ Repository) + ["#." origin]] + ["#." dependency #_ + ["#/." deployment] + ["#/." status]] ["#." artifact (#+ Artifact) - ["#/." extension]]]]) - -(def: (save! system content file) - (-> (file.System Promise) Binary Path (Promise (Try Any))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad system file))] - (!.use (\ file over_write) [content]))) + ["#/." type]]]]) (def: #export failure "Failure: No 'identity' defined for the project.") -(def: #export (do! program console system profile) - (-> (Program Promise) (Console Promise) (file.System Promise) (Command Any)) +(def: #export (do! console system repository profile) + (-> (Console Promise) (file.System Promise) (Repository Promise) (Command Any)) (case (get@ #/.identity profile) (#.Some identity) - (do promise.monad - [home (\ program home [])] - (do ///action.monad - [package (export.library system (set.to_list (get@ #/.sources profile))) - repository (: (Promise (Try Path)) - (file.make_directories promise.monad system (///local.path system home identity))) - #let [artifact_name (format repository (\ system separator) (///artifact.identity identity))] - _ (..save! system (binary.run tar.writer package) - (format artifact_name ///artifact/extension.lux_library)) - pom (\ promise.monad wrap (///pom.write profile)) - _ (..save! system (|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) - (format artifact_name ///artifact/extension.pom))] - (console.write_line //clean.success console))) + (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)]})] + (console.write_line //clean.success console)) _ (console.write_line ..failure console))) diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux new file mode 100644 index 000000000..1f3e776a9 --- /dev/null +++ b/stdlib/source/program/aedifex/dependency/deployment.lux @@ -0,0 +1,128 @@ +(.module: + [lux #* + [abstract + [codec (#+ Codec)] + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + [binary (#+ Binary)] + ["." product] + [text + ["%" format (#+ format)] + ["." encoding]] + [collection + ["." dictionary] + ["." set (#+ Set)] + ["." list ("#\." monoid)]] + [format + ["." xml]]] + [time + ["." instant]] + [world + [program (#+ Program)] + ["." file (#+ Path File Directory)]]] + ["." /// #_ + ["#" local] + ["#." hash (#+ Hash SHA-1 MD5)] + ["#." package (#+ Package)] + ["#." artifact (#+ Artifact) + ["#/." type] + ["#/." extension (#+ Extension)]] + ["#." metadata + ["#/." artifact] + ["#/." snapshot]] + ["#." dependency (#+ Dependency) + [resolution (#+ Resolution)] + ["#/." status (#+ Status)]] + ["#." 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) + (///artifact/extension.extension type)) + deploy_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any)))) + (function (_ codec extension hash) + (|> hash + (\ codec encode) + (\ encoding.utf8 encode) + (\ repository upload (format artifact extension)))))] + (do {! (try.with promise.monad)} + [_ (\ repository upload artifact data)] + (case status + #///dependency/status.Unverified + (wrap []) + + (#///dependency/status.Partial partial) + (case partial + (#.Left sha-1) + (deploy_hash ///hash.sha-1_codec ///artifact/extension.sha-1 sha-1) + + (#.Right md5) + (deploy_hash ///hash.md5_codec ///artifact/extension.md5 md5)) + + (#///dependency/status.Verified sha-1 md5) + (do ! + [_ (deploy_hash ///hash.sha-1_codec ///artifact/extension.sha-1 sha-1)] + (deploy_hash ///hash.md5_codec ///artifact/extension.md5 md5)))))) + +(def: (artifacts type status) + (-> ///artifact/type.Type Status (List ///artifact/type.Type)) + (with_expansions [<sha-1> (format type ///artifact/extension.sha-1) + <md5> (format type ///artifact/extension.md5)] + (list& type + (case status + #///dependency/status.Unverified + (list) + + (#///dependency/status.Partial partial) + (list (case partial + (#.Left _) <sha-1> + (#.Right _) <md5>)) + + (#///dependency/status.Verified _) + (list <sha-1> <md5>))))) + +(def: #export (one repository [artifact type] package) + (-> (Repository Promise) Dependency Package (Promise (Try Artifact))) + (do {! promise.monad} + [now (promise.future instant.now)] + (do (try.with !) + [_ (with_status repository [artifact type] (get@ #///package.library package)) + + _ (let [[pom status] (get@ #///package.pom package)] + (with_status repository + [artifact ///artifact/type.pom] + [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) + status])) + + snapshot (///metadata/snapshot.read repository artifact) + _ (|> 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))))) + (///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.last_updated now) + (///metadata/artifact.write repository artifact))] + (wrap artifact)))) + +(def: #export (all repository resolution) + (-> (Repository Promise) Resolution (Promise (Try (Set Artifact)))) + (do {! (try.with promise.monad)} + [] + (|> (dictionary.entries resolution) + (monad.map ! (function (_ [dependency package]) + (..one repository dependency package))) + (\ ! map (set.from_list ///artifact.hash))))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 1b40a3004..e6b24b152 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -60,28 +60,43 @@ (-> Binary (Repository Promise) Artifact Extension (-> Binary (Hash h)) (Codec Text (Hash h)) (Exception [Artifact Extension Text]) - (Promise (Try (Hash h))))) - (do (try.with promise.monad) - [actual (\ repository download (///repository/remote.uri artifact extension))] - (\ promise.monad wrap - (do try.monad - [output (\ encoding.utf8 decode actual) - actual (\ codec decode output) - _ (exception.assert exception [artifact extension output] - (\ ///hash.equivalence = (hash library) actual))] - (wrap actual))))) + (Promise (Try (Maybe (Hash h)))))) + (do promise.monad + [?actual (\ repository download (///repository/remote.uri artifact extension))] + (case ?actual + (#try.Success actual) + (wrap (do try.monad + [output (\ encoding.utf8 decode actual) + actual (\ codec decode output) + _ (exception.assert exception [artifact extension output] + (\ ///hash.equivalence = (hash library) actual))] + (wrap (#.Some actual)))) + + (#try.Failure error) + (wrap (#try.Success #.None))))) (def: (hashed repository artifact extension) (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status]))) (do (try.with promise.monad) [data (\ repository download (///repository/remote.uri artifact extension)) - sha-1 (..verified_hash data - repository 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) - ///hash.md5 ///hash.md5_codec ..md5_does_not_match)] - (wrap [data (#//status.Verified sha-1 md5)]))) + ?sha-1 (..verified_hash data + repository 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) + ///hash.md5 ///hash.md5_codec ..md5_does_not_match)] + (wrap [data (case [?sha-1 ?md5] + [(#.Some sha-1) (#.Some md5)] + (#//status.Verified sha-1 md5) + + [(#.Some sha-1) _] + (#//status.Partial (#.Left sha-1)) + + [_ (#.Some md5)] + (#//status.Partial (#.Right md5)) + + [#.None #.None] + #//status.Unverified)]))) (def: #export (one repository dependency) (-> (Repository Promise) Dependency (Promise (Try Package))) diff --git a/stdlib/source/program/aedifex/dependency/status.lux b/stdlib/source/program/aedifex/dependency/status.lux index bedaffdb8..82d99e9aa 100644 --- a/stdlib/source/program/aedifex/dependency/status.lux +++ b/stdlib/source/program/aedifex/dependency/status.lux @@ -3,6 +3,7 @@ [abstract [equivalence (#+ Equivalence)]] [data + [binary (#+ Binary)] ["." sum] ["." product]]] ["." /// #_ @@ -33,3 +34,9 @@ ///hash.equivalence ) )) + +(def: #export (verified payload) + (-> Binary Status) + (#Verified + (///hash.sha-1 payload) + (///hash.md5 payload))) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index e1927e577..279973c1a 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -4,17 +4,18 @@ [text ["%" format (#+ format)]]] [world - ["." file (#+ Path)]]] + [net + ["." uri (#+ URI)]]]] ["." // #_ ["#." artifact (#+ Artifact)]]) -(def: #export (repository system home) - (All [a] (-> (file.System a) Path Path)) - (let [/ (\ system separator)] - (format home / ".m2" / "repository"))) +(def: / uri.separator) -(def: #export (path system home artifact) - (All [a] (-> (file.System a) Path Artifact Path)) - (format (..repository system home) - (\ system separator) - (//artifact.path system artifact))) +(def: #export repository + URI + (format ".m2" / "repository")) + +(def: #export uri + (-> Artifact URI) + (|>> //artifact.uri + (format ..repository /))) diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux index 11a792528..0eca976c0 100644 --- a/stdlib/source/program/aedifex/metadata.lux +++ b/stdlib/source/program/aedifex/metadata.lux @@ -1,37 +1,8 @@ (.module: [lux #* - [data - ["." text - ["%" format (#+ format)]]] [world - [file (#+ Path)] - [net - ["." uri (#+ URI)]]]] - [// - ["." artifact (#+ Artifact)]]) + [file (#+ Path)]]]) (def: #export file Path "maven-metadata.xml") - -(def: (project' separator artifact) - (-> Text Artifact Text) - (format (artifact.directory separator (get@ #artifact.group artifact)) - separator - (get@ #artifact.name artifact))) - -(def: (version' separator artifact) - (-> Text Artifact Text) - (format (..project' separator artifact) - separator - (get@ #artifact.version artifact))) - -(template [<public> <private>] - [(def: #export (<public> artifact) - (-> Artifact URI) - (let [/ uri.separator] - (format (<private> / artifact) / ..file)))] - - [project ..project'] - [version ..version'] - ) diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index 5762bf49d..c1d98a8b5 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -4,13 +4,18 @@ [monad (#+ do)] [equivalence (#+ Equivalence)]] [control + [pipe (#+ do>)] + ["." try (#+ Try)] ["<>" parser ["<.>" xml (#+ Parser)] - ["<.>" text]]] + ["<.>" text]] + [concurrency + ["." promise (#+ Promise)]]] [data ["." product] ["." text - ["%" format (#+ format)]] + ["%" format] + ["." encoding]] [format ["." xml (#+ XML)]] [collection @@ -22,9 +27,14 @@ ["." instant (#+ Instant)] ["." date (#+ Date)] ["." year] - ["." month]]] - ["." /// #_ - ["#." artifact (#+ Group Name Version Artifact)]]) + ["." month]] + [world + [net + ["." uri (#+ URI)]]]] + ["." // + ["/#" // #_ + [repository (#+ Repository)] + ["#." artifact (#+ Group Name Version Artifact)]]]) (type: #export Metadata {#group Group @@ -35,26 +45,26 @@ (def: (pad value) (-> Nat Text) (if (n.< 10 value) - (format "0" (%.nat 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))) + (%.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)))) + (%.format (..pad hour) + (..pad minute) + (..pad second)))) (def: (instant_format value) (%.Format Instant) - (format (..date_format (instant.date value)) - (..time_format (instant.time value)))) + (%.format (..date_format (instant.date value)) + (..time_format (instant.time value)))) (template [<definition> <tag>] [(def: <definition> xml.Tag ["" <tag>])] @@ -73,26 +83,26 @@ (-> <type> XML) (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))] - [write_group Group ..<group> (|>)] - [write_name Name ..<name> (|>)] - [write_version Version ..<version> (|>)] - [write_last_updated Instant ..<last_updated> ..instant_format] + [format_group Group ..<group> (|>)] + [format_name Name ..<name> (|>)] + [format_version Version ..<version> (|>)] + [format_last_updated Instant ..<last_updated> ..instant_format] ) -(def: write_versions +(def: format_versions (-> (List Version) XML) - (|>> (list\map ..write_version) (#xml.Node ..<versions> xml.attributes))) + (|>> (list\map ..format_version) (#xml.Node ..<versions> xml.attributes))) -(def: #export (write value) +(def: #export (format value) (-> Metadata XML) (#xml.Node ..<metadata> xml.attributes - (list (..write_group (get@ #group value)) - (..write_name (get@ #name value)) + (list (..format_group (get@ #group value)) + (..format_name (get@ #name value)) (#xml.Node ..<versioning> xml.attributes - (list (..write_versions (get@ #versions value)) - (..write_last_updated (get@ #last_updated value))))))) + (list (..format_versions (get@ #versions value)) + (..format_last_updated (get@ #last_updated value))))))) (def: (sub tag parser) (All [a] (-> xml.Tag (Parser a) (Parser a))) @@ -157,3 +167,42 @@ (list.equivalence text.equivalence) instant.equivalence )) + +(def: #export (uri artifact) + (-> Artifact URI) + (let [/ uri.separator + group (///artifact.directory / (get@ #///artifact.group artifact)) + name (get@ #///artifact.name artifact)] + (%.format group / name / //.file))) + +(def: epoch + Instant + (instant.from_millis +0)) + +(def: #export (read repository artifact) + (-> (Repository Promise) Artifact (Promise (Try Metadata))) + (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 + (let [(^slots [#///artifact.group #///artifact.name]) artifact] + {#group group + #name name + #versions (list) + #last_updated ..epoch})))))) + +(def: #export (write repository artifact metadata) + (-> (Repository Promise) Artifact Metadata (Promise (Try Any))) + (|> metadata + ..format + (\ xml.codec encode) + (\ encoding.utf8 encode) + (\ repository upload (..uri artifact)))) diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index 38af9a729..99ad25470 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -4,14 +4,19 @@ [monad (#+ do)] [equivalence (#+ Equivalence)]] [control + [pipe (#+ do>)] + ["." try (#+ Try)] ["." exception (#+ exception:)] ["<>" parser ["<.>" xml (#+ Parser)] - ["<.>" text]]] + ["<.>" text]] + [concurrency + ["." promise (#+ Promise)]]] [data ["." product] ["." text - ["%" format (#+ format)]] + ["%" format] + ["." encoding]] [format ["." xml (#+ XML)]] [collection @@ -23,10 +28,16 @@ ["." instant (#+ Instant)] ["." date (#+ Date)] ["." year] - ["." month]]] - ["." /// #_ - ["#." artifact (#+ Group Name Version Artifact) - ["#/." type (#+ Type)]]]) + ["." month]] + [world + [net + ["." uri (#+ URI)]]]] + ["." // + ["." artifact] + ["/#" // #_ + [repository (#+ Repository)] + ["#." artifact (#+ Group Name Version Artifact) + ["#/." type (#+ Type)]]]]) (def: snapshot "SNAPSHOT") @@ -46,34 +57,32 @@ [Version Time_Stamp Build]) (type: #export Metadata - {#group Group - #name Name - #version Version + {#artifact Artifact #versioning Versioning}) (def: (pad value) (-> Nat Text) (if (n.< 10 value) - (format "0" (%.nat 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))) + (%.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)))) + (%.format (..pad hour) + (..pad minute) + (..pad second)))) (def: (instant_format value) (%.Format Instant) - (format (..date_format (instant.date value)) - (..time_format (instant.time value)))) + (%.format (..date_format (instant.date value)) + (..time_format (instant.time value)))) (template [<separator> <name>] [(def: <name> @@ -85,17 +94,17 @@ (def: (time_stamp_format value) (%.Format Time_Stamp) - (format (..date_format (instant.date value)) - ..time_stamp_separator - (..time_format (instant.time value)))) + (%.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))) + (%.format (text.replace_all ..snapshot + (..time_stamp_format time_stamp) + version) + ..value_separator + (%.nat build))) (template [<definition> <tag>] [(def: <definition> xml.Tag ["" <tag>])] @@ -121,44 +130,45 @@ (-> <type> XML) (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))] - [write_group Group ..<group> (|>)] - [write_name Name ..<name> (|>)] - [write_version Version ..<version> (|>)] - [write_last_updated Instant ..<last_updated> ..instant_format] - [write_time_stamp Instant ..<timestamp> ..time_stamp_format] - [write_build_number Nat ..<build_number> %.nat] - [write_extension Type ..<extension> (|>)] - [write_value Value ..<value> ..value_format] - [write_updated Instant ..<updated> ..instant_format] + [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: (write_snapshot value type) +(def: (format_snapshot value type) (-> Value Type XML) (<| (#xml.Node ..<snapshot_version> xml.attributes) - (list (..write_extension type) - (..write_value value) + (list (..format_extension type) + (..format_value value) (let [[version time_stamp build] value] - (..write_updated time_stamp))))) + (..format_updated time_stamp))))) -(def: (write_versioning version (^slots [#time_stamp #build #snapshot])) +(def: (format_versioning version (^slots [#time_stamp #build #snapshot])) (-> Version Versioning XML) (<| (#xml.Node ..<versioning> xml.attributes) (list (<| (#xml.Node ..<snapshot> xml.attributes) - (list (..write_time_stamp time_stamp) - (..write_build_number build))) - (..write_last_updated time_stamp) + (list (..format_time_stamp time_stamp) + (..format_build_number build))) + (..format_last_updated time_stamp) (<| (#xml.Node ..<snapshot_versions> xml.attributes) - (list\map (..write_snapshot [version time_stamp build]) + (list\map (..format_snapshot [version time_stamp build]) snapshot))))) -(def: #export (write (^slots [#group #name #version #versioning])) +(def: #export (format (^slots [#artifact #versioning])) (-> Metadata XML) - (#xml.Node ..<metadata> - xml.attributes - (list (..write_group group) - (..write_name name) - (..write_version version) - (..write_versioning version versioning)))) + (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact] + (#xml.Node ..<metadata> + xml.attributes + (list (..format_group group) + (..format_name name) + (..format_version version) + (..format_versioning version versioning))))) (def: (sub tag parser) (All [a] (-> xml.Tag (Parser a) (Parser a))) @@ -264,9 +274,9 @@ name (<xml>.somewhere (..text ..<name>)) version (<xml>.somewhere (..text ..<version>)) versioning (<xml>.somewhere (..versioning_parser version))] - (wrap {#group group - #name name - #version version + (wrap {#artifact {#///artifact.group group + #///artifact.name name + #///artifact.version version} #versioning versioning})))) (def: versioning_equivalence @@ -280,8 +290,47 @@ (def: #export equivalence (Equivalence Metadata) ($_ product.equivalence - text.equivalence - text.equivalence - text.equivalence + ///artifact.equivalence ..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)}) + +(def: #export (read repository artifact) + (-> (Repository Promise) Artifact (Promise (Try Metadata))) + (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 + {#artifact artifact + #versioning ..init_versioning}))))) + +(def: #export (write repository artifact metadata) + (-> (Repository Promise) Artifact Metadata (Promise (Try Any))) + (|> metadata + ..format + (\ xml.codec encode) + (\ encoding.utf8 encode) + (\ repository upload (..uri artifact)))) diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux new file mode 100644 index 000000000..393861ccf --- /dev/null +++ b/stdlib/source/program/aedifex/repository/local.lux @@ -0,0 +1,58 @@ +(.module: + [lux #* + [host (#+ import:)] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." text + ["%" format (#+ format)]]] + [world + [program (#+ Program)] + ["." file (#+ Path File)] + [net + ["." uri (#+ URI)]]]] + ["." // + ["/#" // #_ + ["#." local]]]) + +(def: (root /) + (-> Text Path) + (text.replace_all uri.separator / ///local.repository)) + +(def: path + (-> Text URI Path) + (text.replace_all uri.separator)) + +(def: (file program system uri) + (-> (Program Promise) + (file.System Promise) + URI + (Promise (Try (File Promise)))) + (do {! promise.monad} + [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)))] + (: (Promise (Try (File Promise))) + (file.get_file promise.monad system absolute_path))))) + +(structure: #export (repository program system) + (-> (Program Promise) (file.System Promise) (//.Repository Promise)) + + (def: (download uri) + (do {! (try.with promise.monad)} + [file (..file program system uri)] + (!.use (\ file content) []))) + + (def: (upload uri content) + (do {! (try.with promise.monad)} + [file (..file program system uri)] + (!.use (\ file over_write) [content])))) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index eebccdf09..3833c0828 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -19,7 +19,6 @@ ["#/." test] ["#/." auto]] ["#." local] - ["#." cache] ["#." dependency ["#/." resolution] ["#/." status]] @@ -49,7 +48,6 @@ /command/test.test /command/auto.test /local.test - /cache.test /dependency.test /dependency/resolution.test /dependency/status.test diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index fc8bb2dae..5c694ae74 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -39,15 +39,6 @@ ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [sample ..random - #let [fs (: (file.System Promise) - (file.mock (\ file.default separator)))]] - (_.cover [/.uri /.path] - (|> (/.path fs sample) - (text.replace_all uri.separator (\ fs separator)) - (text\= (/.uri sample))))) /type.test /extension.test diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 45d39cffc..617b3386a 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -75,15 +75,11 @@ (-> (Program Promise) (Repository Promise) (file.System Promise) Artifact ///.Profile (Promise (Try Text))) - (do promise.monad - [home (\ program home [])] - (do ///action.monad - [#let [console (@version.echo "")] - _ (..make_sources! fs (get@ #///.sources profile)) - _ (: (Promise (Try Path)) - (file.make_directories promise.monad fs (///local.repository fs home))) - _ (/.do! console repository fs artifact profile)] - (!.use (\ console read_line) [])))) + (do ///action.monad + [#let [console (@version.echo "")] + _ (..make_sources! fs (get@ #///.sources profile)) + _ (/.do! console repository fs artifact profile)] + (!.use (\ console read_line) []))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 08345a0cb..99856c83c 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -39,14 +39,15 @@ ["#." action] ["#." pom] ["#." package] - ["#." cache] ["#." artifact ["#/." type]] ["#." dependency ["#/." resolution] + ["#/." deployment] ["#/." status]] ["#." repository - ["#/." origin]]]]]}) + ["#/." origin] + ["#/." local]]]]]}) (def: #export test Test @@ -89,13 +90,14 @@ program (program.async (program.mock environment.empty home working_directory))]] (wrap (do promise.monad [verdict (do ///action.monad - [#let [console (@version.echo "")] + [#let [console (@version.echo "") + local (///repository/local.repository program fs)] pre (|> ///dependency/resolution.empty (dictionary.put dependee dependee_package) - (///cache.write_all program fs)) + (///dependency/deployment.all local)) post (|> (\ ///.monoid identity) (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee depender))) - (/.do! program console fs (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) [])))) + (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) [])))) logging! (\ ///action.monad map (text\= //clean.success) (!.use (\ console read_line) []))] diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 9df49efa4..ce3f21de8 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -26,7 +26,9 @@ ["." random (#+ Random)]] [world ["." file (#+ Path File)] - ["." program (#+ Program)]]] + ["." program (#+ Program)] + [net + ["." uri]]]] [// ["@." version] [// @@ -42,7 +44,9 @@ ["#." pom] ["#." local] ["#." artifact - ["#/." extension]]]]]}) + ["#/." extension]] + ["#." repository #_ + ["#/." local]]]]]}) (def: (make_sources! fs sources) (-> (file.System Promise) (Set Path) (Promise (Try Any))) @@ -68,9 +72,7 @@ (do ///action.monad [#let [console (@version.echo "")] _ (..make_sources! fs (get@ #///.sources sample)) - _ (: (Promise (Try Path)) - (file.make_directories promise.monad fs (///local.repository fs home))) - _ (/.do! program console fs sample)] + _ (/.do! console fs (///repository/local.repository program fs) sample)] (!.use (\ console read_line) [])))) (def: #export test @@ -88,9 +90,8 @@ program (program.async (program.mock environment.empty home working_directory))] verdict (do ///action.monad [logging (..execute! program fs sample) - #let [artifact_path (format (///local.path fs home identity) - (\ fs separator) - (///artifact.identity identity)) + #let [/ uri.separator + artifact_path (format (///local.uri identity) / (///artifact.identity identity)) library_path (format artifact_path ///artifact/extension.lux_library) pom_path (format artifact_path ///artifact/extension.pom)] diff --git a/stdlib/source/test/aedifex/local.lux b/stdlib/source/test/aedifex/local.lux index 7d0492815..6729d4485 100644 --- a/stdlib/source/test/aedifex/local.lux +++ b/stdlib/source/test/aedifex/local.lux @@ -3,35 +3,22 @@ ["_" test (#+ Test)] [abstract [monad (#+ do)]] - [control - [concurrency - [promise (#+ Promise)]]] [data ["." text]] [math - ["." random (#+ Random)]] - [world - ["." file]]] + ["." random (#+ Random)]]] [// ["@." artifact]] {#program - ["." / - ["/#" // #_ - ["#." artifact]]]}) + ["." /]}) (def: #export test Test (<| (_.covering /._) (do {! random.monad} - [sample @artifact.random - home (random.ascii/alpha 5) - #let [fs (: (file.System Promise) - (file.mock (\ file.default separator)))]] + [sample @artifact.random] ($_ _.and - (_.cover [/.repository /.path] - (let [path (/.path fs home sample)] - (and (text.starts_with? (/.repository fs home) - path) - (text.ends_with? (//artifact.path fs sample) - path)))) + (_.cover [/.repository /.uri] + (text.starts_with? /.repository + (/.uri sample))) )))) diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux index 0cac022f8..33104330b 100644 --- a/stdlib/source/test/aedifex/metadata.lux +++ b/stdlib/source/test/aedifex/metadata.lux @@ -19,16 +19,6 @@ Test (<| (_.covering /._) ($_ _.and - (<| (_.for [/.file]) - (do random.monad - [sample @artifact.random] - ($_ _.and - (_.cover [/.project] - (text.ends_with? /.file (/.project sample))) - (_.cover [/.version] - (text.ends_with? /.file (/.version sample))) - ))) - /artifact.test /snapshot.test ))) diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 6c39546b4..9977be8e1 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -60,9 +60,9 @@ ($equivalence.spec /.equivalence ..random)) (do random.monad [expected ..random] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (|> expected - /.write + /.format (<xml>.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index c1725f55a..a2f0b65db 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -24,8 +24,8 @@ [macro ["." code]]] ["$." /// #_ - [artifact - ["#." type]]] + ["#." artifact + ["#/." type]]] {#program ["." /]}) @@ -55,15 +55,13 @@ ($_ random.and ..random_instant random.nat - (random.list 5 $///type.random) + (random.list 5 $///artifact/type.random) )) (def: #export random (Random /.Metadata) ($_ random.and - (random.ascii/alpha 5) - (random.ascii/alpha 5) - (random.ascii/alpha 5) + $///artifact.random ..random_versioning)) (def: #export test @@ -75,9 +73,9 @@ ($equivalence.spec /.equivalence ..random)) (do random.monad [expected ..random] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (|> expected - /.write + /.format (<xml>.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 60fc409ad..d490620ff 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -11,17 +11,17 @@ [data ["." name] [text - ["%" format (#+ format)]] + ["%" format (#+ format)]]] + ["." math] + ["_" test (#+ Test)] + [math + ["." random (#+ Random) ("#\." functor)] [number ["." i64] ["n" nat] ["i" int] ["r" rev] - ["f" frac]]] - ["." math] - ["_" test (#+ Test)] - [math - ["." random (#+ Random) ("#\." functor)]]] + ["f" frac]]]] ## TODO: Must have 100% coverage on tests. ["." / #_ ["#." abstract] diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 8ffc75025..756ef3d21 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -23,7 +23,8 @@ ["r" rev]]] [tool [compiler - [reference (#+ Constant)] + [reference (#+ Constant) + [variable (#+)]] [language [lux ["." analysis]]]]]] diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 5cfbe4a7d..78c933714 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -75,7 +75,10 @@ false) [#.None #.None] - true)) + true + + _ + false)) (_.cover [/.every?] (\ bit.equivalence = (list.every? n.even? (/.to_list the_array)) diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index 90a72ca26..429b7fc6e 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -29,61 +29,22 @@ ["." /// #_ ["#." code]] ["." / #_ + ["#." annotations] ["#." check] + ["#." declaration] ["#." definition] - ["#." export] - ["#." declaration]]) - -(def: annotations_equivalence - (Equivalence /.Annotations) - (list.equivalence - (product.equivalence name.equivalence - code.equivalence))) + ["#." export]]) (def: random_text (Random Text) (random.ascii/alpha 10)) -(def: random_name - (Random Name) - (random.and ..random_text ..random_text)) - -(def: random_annotations - (Random /.Annotations) - (do {! random.monad} - [size (\ ! map (|>> (n.% 3)) random.nat)] - (random.list size (random.and random_name - ///code.random)))) - (def: #export test Test (<| (_.covering /._) (_.covering /reader._) (_.covering /writer._) ($_ _.and - (_.for [/.Annotations] - ($_ _.and - (do random.monad - [expected ..random_annotations] - (_.cover [/reader.annotations /writer.annotations] - (|> expected - /writer.annotations list - (<c>.run /reader.annotations) - (case> (#try.Success actual) - (\ ..annotations_equivalence = expected actual) - - (#try.Failure error) - false)))) - (_.cover [/.empty_annotations] - (|> /.empty_annotations - /writer.annotations list - (<c>.run /reader.annotations) - (case> (#try.Success actual) - (\ ..annotations_equivalence = /.empty_annotations actual) - - (#try.Failure error) - false))) - )) (do {! random.monad} [size (\ ! map (|>> (n.% 3)) random.nat) expected (random.list size ..random_text)] @@ -111,8 +72,9 @@ (#try.Failure error) false)))) + /annotations.test /check.test + /declaration.test /definition.test /export.test - /declaration.test ))) diff --git a/stdlib/source/test/lux/macro/syntax/common/annotations.lux b/stdlib/source/test/lux/macro/syntax/common/annotations.lux new file mode 100644 index 000000000..bc29a00f6 --- /dev/null +++ b/stdlib/source/test/lux/macro/syntax/common/annotations.lux @@ -0,0 +1,52 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try] + [parser + ["<.>" code]]] + [data + [collection + ["." list]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]} + ["$." //// #_ + ["#." code]]) + +(def: #export random + (Random /.Annotations) + (let [word (random.ascii/alpha 10) + tag (random.and word word)] + (do {! random.monad} + [size (\ ! map (n.% 10) random.nat)] + (random.list size (random.and tag $////code.random))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Annotations]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.empty] + (list.empty? /.empty)) + (do random.monad + [expected ..random] + (_.cover [/.write /.parser] + (case (<code>.run /.parser + (list (/.write expected))) + (#try.Failure _) + false + + (#try.Success actual) + (\ /.equivalence = expected actual))))))) diff --git a/stdlib/source/test/lux/macro/syntax/common/definition.lux b/stdlib/source/test/lux/macro/syntax/common/definition.lux index 937f5319a..a769df641 100644 --- a/stdlib/source/test/lux/macro/syntax/common/definition.lux +++ b/stdlib/source/test/lux/macro/syntax/common/definition.lux @@ -18,26 +18,20 @@ [meta ["." location]]] {1 - ["." / - [// (#+ Annotations)]]} + ["." /]} ["$."// #_ ["#." check] + ["#." annotations] ["#//" /// #_ ["#." code]]]) -(def: random_annotations - (Random Annotations) - (let [name (random.and (random.ascii/alpha 5) - (random.ascii/alpha 5))] - (random.list 5 (random.and name $////code.random)))) - (def: #export random (Random /.Definition) ($_ random.and (random.ascii/alpha 5) (random.or $//check.random $////code.random) - ..random_annotations + $//annotations.random random.bit )) diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index 6289dd64d..58587ad95 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -1,10 +1,13 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract + [equivalence (#+ Equivalence)] [monad (#+ do)] - ["." enum]] + {[0 #spec] + [/ + [functor + ["$." contravariant]]]}] [data ["." bit ("#\." equivalence)] [collection @@ -17,169 +20,338 @@ ["r" rev]]]] {1 ["." / (#+ Fuzzy) - [// - ["//" continuous]]]}) - -(template [<name> <desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>] - [(def: <name> - Test - (<| (_.context (%.name (name_of <triangle>))) - (do random.monad - [values (random.set <hash> 3 <gen>) - #let [[x y z] (case (set.to_list values) - (^ (list x y z)) - [x y z] - - _ - (undefined))] - sample <gen> - #let [[bottom middle top] (case (list.sort <lt> (list x y z)) - (^ (list bottom middle top)) - [bottom middle top] - - _ - (undefined)) - triangle (<triangle> x y z)]] - ($_ _.and - (_.test "The middle value will always have maximum membership." - (r.= //.true (/.membership middle triangle))) - (_.test "Boundary values will always have 0 membership." - (and (r.= //.false (/.membership bottom triangle)) - (r.= //.false (/.membership top triangle)))) - (_.test "Values within range, will have membership > 0." - (bit\= (r.> //.false (/.membership sample triangle)) - (and (<gt> bottom sample) - (<lt> top sample)))) - (_.test "Values outside of range, will have membership = 0." - (bit\= (r.= //.false (/.membership sample triangle)) - (or (<lte> bottom sample) - (<gte> top sample)))) - ))))] - - [rev_triangles "Rev" r.hash random.rev /.triangle r.< r.<= r.> r.>=] - ) - -(template [<name> <desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>] - [(def: <name> - Test - (<| (_.context (%.name (name_of <trapezoid>))) - (do random.monad - [values (random.set <hash> 4 <gen>) - #let [[w x y z] (case (set.to_list values) - (^ (list w x y z)) - [w x y z] - - _ - (undefined))] - sample <gen> - #let [[bottom middle_bottom middle_top top] (case (list.sort <lt> (list w x y z)) - (^ (list bottom middle_bottom middle_top top)) - [bottom middle_bottom middle_top top] - - _ - (undefined)) - trapezoid (<trapezoid> w x y z)]] - ($_ _.and - (_.test "The middle values will always have maximum membership." - (and (r.= //.true (/.membership middle_bottom trapezoid)) - (r.= //.true (/.membership middle_top trapezoid)))) - (_.test "Boundary values will always have 0 membership." - (and (r.= //.false (/.membership bottom trapezoid)) - (r.= //.false (/.membership top trapezoid)))) - (_.test "Values within inner range will have membership = 1" - (bit\= (r.= //.true (/.membership sample trapezoid)) - (and (<gte> middle_bottom sample) - (<lte> middle_top sample)))) - (_.test "Values within range, will have membership > 0." - (bit\= (r.> //.false (/.membership sample trapezoid)) - (and (<gt> bottom sample) - (<lt> top sample)))) - (_.test "Values outside of range, will have membership = 0." - (bit\= (r.= //.false (/.membership sample trapezoid)) - (or (<lte> bottom sample) - (<gte> top sample)))) - ))))] - - [rev_trapezoids "Rev" r.hash random.rev /.trapezoid r.< r.<= r.> r.>=] - ) - -(def: #export triangle - (Random (Fuzzy Rev)) + ["/#" // #_ + ["#" continuous]]]}) + +(def: trivial + Test (do random.monad - [x random.rev - y random.rev - z random.rev] - (wrap (/.triangle x y z)))) + [sample random.rev] + ($_ _.and + (_.cover [/.empty] + (r.= //.false (/.empty sample))) + (_.cover [/.full] + (r.= //.true (/.full sample))) + ))) -(def: combinators +(def: simple Test - (<| (_.context "Combinators") - (do random.monad - [left ..triangle - right ..triangle - sample random.rev] + (do {! random.monad} + [sample random.rev + + threshold_0 (\ ! map (r.% .5) + random.rev) + threshold_1 (\ ! map (|>> (r.% .5) (r.+ .5)) + random.rev) + + #let [bottom (r.min threshold_0 threshold_1) + top (r.max threshold_0 threshold_1)]] + ($_ _.and + (_.cover [/.gradient] + (let [ascending! + (let [set (/.gradient bottom top)] + (and (r.= //.false (set bottom)) + (r.= //.true (set top)) + (let [membership (set sample)] + (cond (r.<= bottom sample) + (r.= //.false membership) + + (r.>= top sample) + (r.= //.true membership) + + (r.> //.false membership))))) + + descending! + (let [set (/.gradient top bottom)] + (and (r.= //.true (set bottom)) + (r.= //.false (set top)) + (let [membership (set sample)] + (cond (r.<= bottom sample) + (r.= //.true membership) + + (r.>= top sample) + (r.= //.false membership) + + (r.> //.false membership)))))] + (and ascending! + descending!))) + (_.cover [/.membership] + (let [set (/.gradient bottom top)] + (r.= (set sample) + (/.membership set sample)))) + ))) + +(def: composition + Test + (do {! random.monad} + [sample random.rev + + [bottom middle_bottom middle_top top] + (|> random.rev + (random.set r.hash 4) + (\ ! map (|>> set.to_list (list.sort r.<))) + (random.one (function (_ thresholds) + (case thresholds + (^ (list threshold_0 threshold_1 threshold_2 threshold_3)) + (#.Some [threshold_0 threshold_1 threshold_2 threshold_3]) + + _ + #.None)))) + + #let [bottom_set (/.gradient bottom middle_bottom) + top_set (/.gradient middle_top top)]] + ($_ _.and + (_.cover [/.union] + (let [set (/.gradient bottom top)] + (and (r.= (/.membership set sample) + (/.membership (/.union /.empty set) sample)) + (r.= (/.membership /.full sample) + (/.membership (/.union /.full set) sample)) + + (r.>= (/.membership bottom_set sample) + (/.membership (/.union bottom_set top_set) sample)) + (r.>= (/.membership top_set sample) + (/.membership (/.union bottom_set top_set) sample))))) + (_.cover [/.intersection] + (let [set (/.gradient bottom top)] + (and (r.= (/.membership /.empty sample) + (/.membership (/.intersection /.empty set) sample)) + (r.= (/.membership set sample) + (/.membership (/.intersection /.full set) sample)) + + (r.<= (/.membership bottom_set sample) + (/.membership (/.intersection bottom_set top_set) sample)) + (r.<= (/.membership top_set sample) + (/.membership (/.intersection bottom_set top_set) sample))))) + (_.cover [/.complement] + (let [set (/.gradient bottom top) + + trivial! + (and (r.= (/.membership /.full sample) + (/.membership (/.complement /.empty) sample)) + (r.= (/.membership /.empty sample) + (/.membership (/.complement /.full) sample))) + + common! + (and (r.>= (/.membership set sample) + (/.membership (/.union set (/.complement set)) sample)) + (r.<= (/.membership set sample) + (/.membership (/.intersection set (/.complement set)) sample))) + + de_morgan! + (and (r.= (/.membership (/.complement (/.union bottom_set top_set)) + sample) + (/.membership (/.intersection (/.complement bottom_set) (/.complement top_set)) + sample)) + (r.= (/.membership (/.complement (/.intersection bottom_set top_set)) + sample) + (/.membership (/.union (/.complement bottom_set) (/.complement top_set)) + sample)))] + (and trivial! + common! + de_morgan!))) + (_.cover [/.difference] + (let [set (/.gradient bottom top)] + (and (r.= (/.membership set sample) + (/.membership (/.difference /.empty set) sample)) + (r.= (/.membership /.empty sample) + (/.membership (/.difference /.full set) sample)) + + (r.<= (/.membership top_set sample) + (/.membership (/.difference bottom_set top_set) sample)) + (r.<= (/.membership bottom_set sample) + (/.membership (/.difference bottom_set top_set) sample))))) + ))) + +(def: geometric + Test + (<| (_.covering /._) + (_.for [/.Fuzzy]) + (do {! random.monad} + [sample random.rev + + [bottom middle_bottom middle_top top] + (|> random.rev + (random.set r.hash 4) + (\ ! map (|>> set.to_list (list.sort r.<))) + (random.one (function (_ thresholds) + (case thresholds + (^ (list threshold_0 threshold_1 threshold_2 threshold_3)) + (#.Some [threshold_0 threshold_1 threshold_2 threshold_3]) + + _ + #.None))))] ($_ _.and - (_.test (%.name (name_of /.union)) - (let [combined (/.union left right) - combined_membership (/.membership sample combined)] - (and (r.>= (/.membership sample left) - combined_membership) - (r.>= (/.membership sample right) - combined_membership)))) - (_.test (%.name (name_of /.intersection)) - (let [combined (/.intersection left right) - combined_membership (/.membership sample combined)] - (and (r.<= (/.membership sample left) - combined_membership) - (r.<= (/.membership sample right) - combined_membership)))) - (_.test (%.name (name_of /.complement)) - (r.= (/.membership sample left) - (//.not (/.membership sample (/.complement left))))) - (_.test (%.name (name_of /.difference)) - (r.<= (/.membership sample right) - (/.membership sample (/.difference left right)))) + (_.cover [/.triangle] + (let [reference (/.triangle bottom middle_bottom top) + + irrelevant_order! + (list.every? (function (_ set) + (r.= (/.membership reference sample) + (/.membership set sample))) + (list (/.triangle bottom top middle_bottom) + (/.triangle middle_bottom bottom top) + (/.triangle middle_bottom top bottom) + (/.triangle top bottom middle_bottom) + (/.triangle top middle_bottom bottom))) + + middle_maximum! + (r.= //.true (/.membership reference middle_bottom)) + + boundary_minima! + (and (r.= //.false (/.membership reference bottom)) + (r.= //.false (/.membership reference top))) + + inside_range! + (bit\= (r.> //.false (/.membership reference sample)) + (and (r.> bottom sample) + (r.< top sample))) + + outside_range! + (bit\= (r.= //.false (/.membership reference sample)) + (or (r.<= bottom sample) + (r.>= top sample)))] + (and irrelevant_order! + middle_maximum! + boundary_minima! + inside_range! + outside_range!))) + (_.cover [/.trapezoid] + (let [reference (/.trapezoid bottom middle_bottom middle_top top) + + irrelevant_order! + (list.every? (function (_ set) + (r.= (/.membership reference sample) + (/.membership set sample))) + (let [r0 bottom + r1 middle_bottom + r2 middle_top + r3 top] + (list (/.trapezoid r0 r1 r2 r3) + (/.trapezoid r0 r1 r3 r2) + (/.trapezoid r0 r2 r1 r3) + (/.trapezoid r0 r2 r3 r1) + (/.trapezoid r0 r3 r1 r2) + (/.trapezoid r0 r3 r2 r1) + + (/.trapezoid r1 r0 r2 r3) + (/.trapezoid r1 r0 r3 r2) + (/.trapezoid r1 r2 r0 r3) + (/.trapezoid r1 r2 r3 r0) + (/.trapezoid r1 r3 r0 r2) + (/.trapezoid r1 r3 r2 r0) + + (/.trapezoid r2 r0 r1 r3) + (/.trapezoid r2 r0 r3 r1) + (/.trapezoid r2 r1 r0 r3) + (/.trapezoid r2 r1 r3 r0) + (/.trapezoid r2 r3 r0 r1) + (/.trapezoid r2 r3 r1 r0) + + (/.trapezoid r3 r0 r1 r2) + (/.trapezoid r3 r0 r2 r1) + (/.trapezoid r3 r1 r0 r2) + (/.trapezoid r3 r1 r2 r0) + (/.trapezoid r3 r2 r0 r1) + (/.trapezoid r3 r2 r1 r0) + ))) + + middle_maxima! + (and (r.= //.true (/.membership reference middle_bottom)) + (r.= //.true (/.membership reference middle_top))) + + boundary_minima! + (and (r.= //.false (/.membership reference bottom)) + (r.= //.false (/.membership reference top))) + + inside_range! + (bit\= (r.> //.false (/.membership reference sample)) + (and (r.> bottom sample) + (r.< top sample))) + + outside_range! + (bit\= (r.= //.false (/.membership reference sample)) + (or (r.<= bottom sample) + (r.>= top sample))) + + + inside_inner_range! + (bit\= (r.= //.true (/.membership reference sample)) + (and (r.<= middle_top sample) + (r.>= middle_bottom sample)))] + (and irrelevant_order! + middle_maxima! + boundary_minima! + inside_range! + outside_range! + inside_inner_range!))) )))) -(def: predicates_and_sets +(def: discrete Test - (do {! random.monad} - [#let [set_10 (set.from_list n.hash (enum.range n.enum 0 10))] - sample (|> random.nat (\ ! map (n.% 20)))] + (do random.monad + [threshold random.nat + #let [under? (n.< threshold) + set (set.from_list n.hash (list threshold))] + sample random.nat] ($_ _.and - (_.test (%.name (name_of /.from_predicate)) - (bit\= (r.= //.true (/.membership sample (/.from_predicate n.even?))) - (n.even? sample))) - (_.test (%.name (name_of /.from_set)) - (bit\= (r.= //.true (/.membership sample (/.from_set set_10))) - (set.member? set_10 sample))) + (_.cover [/.from_predicate] + (bit\= (r.= //.true (/.membership (/.from_predicate under?) sample)) + (under? sample))) + (_.cover [/.from_set] + (and (r.= //.true (/.membership (/.from_set set) threshold)) + (bit\= (r.= //.true (/.membership (/.from_set set) sample)) + (set.member? set sample)))) ))) -(def: thresholds +(def: gradient + (Random [[Rev Rev] (Fuzzy Rev)]) + (do random.monad + [sample random.rev + + threshold_0 random.rev + threshold_1 random.rev + + #let [bottom (r.min threshold_0 threshold_1) + top (r.max threshold_0 threshold_1)]] + (wrap [[bottom top] + (/.gradient bottom top)]))) + +(def: threshold Test (do random.monad - [fuzzy ..triangle - sample random.rev + [[_ set] ..gradient threshold random.rev - #let [vip_fuzzy (/.cut threshold fuzzy) - member? (/.to_predicate threshold fuzzy)]] - (<| (_.context (%.name (name_of /.cut))) - ($_ _.and - (_.test "Can increase the threshold of membership of a fuzzy set." - (bit\= (r.> //.false (/.membership sample vip_fuzzy)) - (r.> threshold (/.membership sample fuzzy)))) - (_.test "Can turn fuzzy sets into predicates through a threshold." - (bit\= (member? sample) - (r.> threshold (/.membership sample fuzzy)))) - )))) + sample random.rev] + ($_ _.and + (_.cover [/.to_predicate] + (bit\= (not ((/.to_predicate threshold set) sample)) + (r.< threshold (/.membership set sample)))) + (_.cover [/.cut] + (bit\= (r.= //.false (/.membership (/.cut threshold set) sample)) + (r.< threshold (/.membership set sample)))) + ))) (def: #export test Test - (<| (_.context (%.name (name_of /._))) - ($_ _.and - ..rev_triangles - ..rev_trapezoids - ..combinators - ..predicates_and_sets - ..thresholds - ))) + (<| (_.covering /._) + (_.for [/.Fuzzy]) + (do random.monad + [sample random.rev + [_ fuzzy] ..gradient + #let [equivalence (: (Equivalence (/.Fuzzy Rev)) + (structure + (def: (= left right) + (r.= (left sample) + (right sample)))))]] + ($_ _.and + (_.for [/.functor] + ($contravariant.spec equivalence fuzzy /.functor)) + + ..trivial + ..simple + ..composition + ..geometric + ..discrete + ..threshold + )))) diff --git a/stdlib/source/test/lux/math/modulus.lux b/stdlib/source/test/lux/math/modulus.lux index 4f3b4a2fb..c5147e75c 100644 --- a/stdlib/source/test/lux/math/modulus.lux +++ b/stdlib/source/test/lux/math/modulus.lux @@ -56,6 +56,10 @@ (_.cover [/.literal] (with_expansions [<divisor> (|divisor|)] (i.= <divisor> (/.divisor (/.literal <divisor>))))) + (_.cover [/.=] + (with_expansions [<divisor> (|divisor|)] + (/.= (/.literal <divisor>) + (/.literal <divisor>)))) (_.cover [/.congruent?] (and (/.congruent? modulus dividend dividend) (or (not (/.congruent? modulus dividend (inc dividend))) diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index dcaa417ed..2bd56a513 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -120,8 +120,8 @@ (with_expansions [<jvm> (as_is (host.import: java/lang/Double ["#::." - (#static doubleToRawLongBits #manual [double] long) - (#static longBitsToDouble #manual [long] double)]))] + (#static doubleToRawLongBits [double] long) + (#static longBitsToDouble [long] double)]))] (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>)})) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 6997d55e3..3f92e9d13 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -114,7 +114,8 @@ (: (Meta Any)) (/.run expected_lux) (!expect (^multi (#try.Failure actual_error) - (text\= expected_error actual_error))))) + (text\= (location.with location.dummy expected_error) + actual_error))))) (_.cover [/.assert] (and (|> (/.assert expected_error true) (: (Meta Any)) @@ -143,12 +144,14 @@ (/.fail expected_error))) (/.run expected_lux) (!expect (^multi (#try.Failure actual_error) - (text\= expected_error actual_error)))) + (text\= (location.with location.dummy expected_error) + actual_error)))) (|> (/.either (\ /.monad wrap expected) (\ /.monad wrap dummy)) (/.run expected_lux) (!expect (^multi (#try.Success actual) - (n.= expected actual)))))) + (n.= expected actual)))) + )) ))) (def: module_related |