aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/binary.lux13
-rw-r--r--stdlib/source/lux/data/text/unicode.lux68
-rw-r--r--stdlib/source/lux/time.lux190
-rw-r--r--stdlib/source/lux/time/date.lux15
-rw-r--r--stdlib/source/lux/time/instant.lux112
-rw-r--r--stdlib/source/lux/time/year.lux12
-rw-r--r--stdlib/source/program/aedifex.lux107
-rw-r--r--stdlib/source/program/aedifex/cli.lux25
-rw-r--r--stdlib/source/program/aedifex/command.lux4
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux14
-rw-r--r--stdlib/source/program/aedifex/command/build.lux33
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux33
-rw-r--r--stdlib/source/program/aedifex/local.lux33
-rw-r--r--stdlib/source/program/aedifex/parser.lux106
-rw-r--r--stdlib/source/program/aedifex/pom.lux31
-rw-r--r--stdlib/source/program/aedifex/profile.lux135
-rw-r--r--stdlib/source/program/aedifex/project.lux113
-rw-r--r--stdlib/source/test/lux/control/parser/text.lux6
-rw-r--r--stdlib/source/test/lux/data/binary.lux161
19 files changed, 802 insertions, 409 deletions
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index ed0d992e9..6bb5667bf 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -300,9 +300,16 @@
(exception.throw ..slice-out-of-bounds [size from to]))
(exception.throw ..inverted-slice [size from to]))))
-(def: #export (slice' from binary)
- (-> Nat Binary (Try Binary))
- (slice from (dec (..!size binary)) binary))
+(def: #export (drop from binary)
+ (-> Nat Binary Binary)
+ (case from
+ 0 binary
+ _ (case (..slice from (dec (..!size binary)) binary)
+ (#try.Success slice)
+ slice
+
+ (#try.Failure _)
+ (..create 0))))
(structure: #export monoid
(Monoid Binary)
diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux
index 8faf56789..234309ddf 100644
--- a/stdlib/source/lux/data/text/unicode.lux
+++ b/stdlib/source/lux/data/text/unicode.lux
@@ -165,23 +165,23 @@
[arabic-presentation-forms-b "FE70" "FEFF"]
[halfwidth-and-fullwidth-forms "FF00" "FFEF"]
[specials "FFF0" "FFFF"]
- [linear-b-syllabary "10000" "1007F"]
- [linear-b-ideograms "10080" "100FF"]
- [aegean-numbers "10100" "1013F"]
- [old-italic "10300" "1032F"]
- [gothic "10330" "1034F"]
- [ugaritic "10380" "1039F"]
- [deseret "10400" "1044F"]
- [shavian "10450" "1047F"]
- [osmanya "10480" "104AF"]
- [cypriot-syllabary "10800" "1083F"]
- [byzantine-musical-symbols "1D000" "1D0FF"]
- [musical-symbols "1D100" "1D1FF"]
- [tai-xuan-jing-symbols "1D300" "1D35F"]
- [mathematical-alphanumeric-symbols "1D400" "1D7FF"]
- [cjk-unified-ideographs-extension-b "20000" "2A6DF"]
- [cjk-compatibility-ideographs-supplement "2F800" "2FA1F"]
- [tags "E0000" "E007F"]
+ ## [linear-b-syllabary "10000" "1007F"]
+ ## [linear-b-ideograms "10080" "100FF"]
+ ## [aegean-numbers "10100" "1013F"]
+ ## [old-italic "10300" "1032F"]
+ ## [gothic "10330" "1034F"]
+ ## [ugaritic "10380" "1039F"]
+ ## [deseret "10400" "1044F"]
+ ## [shavian "10450" "1047F"]
+ ## [osmanya "10480" "104AF"]
+ ## [cypriot-syllabary "10800" "1083F"]
+ ## [byzantine-musical-symbols "1D000" "1D0FF"]
+ ## [musical-symbols "1D100" "1D1FF"]
+ ## [tai-xuan-jing-symbols "1D300" "1D35F"]
+ ## [mathematical-alphanumeric-symbols "1D400" "1D7FF"]
+ ## [cjk-unified-ideographs-extension-b "20000" "2A6DF"]
+ ## [cjk-compatibility-ideographs-supplement "2F800" "2FA1F"]
+ ## [tags "E0000" "E007F"]
## Specialized segments
[basic-latin/decimal "0030" "0039"]
@@ -317,23 +317,23 @@
arabic-presentation-forms-b
halfwidth-and-fullwidth-forms
specials
- linear-b-syllabary
- linear-b-ideograms
- aegean-numbers
- old-italic
- gothic
- ugaritic
- deseret
- shavian
- osmanya
- cypriot-syllabary
- byzantine-musical-symbols
- musical-symbols
- tai-xuan-jing-symbols
- mathematical-alphanumeric-symbols
- cjk-unified-ideographs-extension-b
- cjk-compatibility-ideographs-supplement
- tags
+ ## linear-b-syllabary
+ ## linear-b-ideograms
+ ## aegean-numbers
+ ## old-italic
+ ## gothic
+ ## ugaritic
+ ## deseret
+ ## shavian
+ ## osmanya
+ ## cypriot-syllabary
+ ## byzantine-musical-symbols
+ ## musical-symbols
+ ## tai-xuan-jing-symbols
+ ## mathematical-alphanumeric-symbols
+ ## cjk-unified-ideographs-extension-b
+ ## cjk-compatibility-ideographs-supplement
+ ## tags
)]))
(def: #export full
diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux
new file mode 100644
index 000000000..ecfb1edb1
--- /dev/null
+++ b/stdlib/source/lux/time.lux
@@ -0,0 +1,190 @@
+(.module:
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [order (#+ Order)]
+ [enum (#+ Enum)]
+ [codec (#+ Codec)]
+ [monad (#+ Monad do)]]
+ [control
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]
+ ["<>" parser
+ ["<t>" text (#+ Parser)]]]
+ [data
+ ["." text ("#@." monoid)]
+ [number
+ ["n" nat ("#@." decimal)]]]
+ [type
+ abstract]]
+ [/
+ ["." duration (#+ Duration)]])
+
+(template [<name> <singular> <plural>]
+ [(def: #export <name>
+ Nat
+ (.nat (duration.query <singular> <plural>)))]
+
+ [milli-seconds duration.milli-second duration.second]
+ [seconds duration.second duration.minute]
+ [minutes duration.minute duration.hour]
+ [hours duration.hour duration.day]
+ )
+
+(def: limit
+ Nat
+ (.nat (duration.to-millis duration.day)))
+
+(exception: #export (time-exceeds-a-day {time Nat})
+ (exception.report
+ ["Time (in milli-seconds)" (n@encode time)]
+ ["Maximum (in milli-seconds)" (n@encode (dec limit))]))
+
+(def: separator ":")
+
+(def: parse-section
+ (Parser Nat)
+ (<>.codec n.decimal (<t>.exactly 2 <t>.decimal)))
+
+(def: parse-millis'
+ (Parser Nat)
+ (<>.either (|> (<t>.at-most 3 <t>.decimal)
+ (<>.codec n.decimal)
+ (<>.after (<t>.this ".")))
+ (:: <>.monad wrap 0)))
+
+(template [<maximum> <parser> <exception> <sub-parser>]
+ [(exception: #export (<exception> {value Nat})
+ (exception.report
+ ["Value" (n@encode value)]
+ ["Minimum" (n@encode 0)]
+ ["Maximum" (n@encode (dec <maximum>))]))
+
+ (def: <parser>
+ (Parser Nat)
+ (do <>.monad
+ [value <sub-parser>]
+ (if (and (n.>= 0 value)
+ (n.< <maximum> value))
+ (wrap value)
+ (<>.lift (exception.throw <exception> [value])))))]
+
+ [..hours parse-hour invalid-hour ..parse-section]
+ [..minutes parse-minute invalid-minute ..parse-section]
+ [..seconds parse-second invalid-second ..parse-section]
+ [..milli-seconds parse-millis invalid-milli-second ..parse-millis']
+ )
+
+(abstract: #export Time
+ Nat
+
+ {#.doc "Time is defined as milliseconds since the start of the day (00:00:00.000)."}
+
+ (def: #export start
+ {#.doc "The instant corresponding to the start of the day: 00:00:00.000"}
+ Time
+ (:abstraction 0))
+
+ (def: #export (from-millis milli-seconds)
+ (-> Nat (Try Time))
+ (if (n.< ..limit milli-seconds)
+ (#try.Success (:abstraction milli-seconds))
+ (exception.throw ..time-exceeds-a-day [milli-seconds])))
+
+ (def: #export to-millis
+ (-> Time Nat)
+ (|>> :representation))
+
+ (structure: #export equivalence
+ (Equivalence Time)
+
+ (def: (= param subject)
+ (n.= (:representation param) (:representation subject))))
+
+ (structure: #export order
+ (Order Time)
+
+ (def: &equivalence ..equivalence)
+
+ (def: (< param subject)
+ (n.< (:representation param) (:representation subject))))
+
+ (`` (structure: #export enum
+ (Enum Time)
+
+ (def: &order ..order)
+
+ (def: succ
+ (|>> :representation (n.% ..limit) :abstraction))
+
+ (def: (pred time)
+ (:abstraction (dec (case (:representation time)
+ 0 ..limit
+ millis millis))))))
+
+ (def: #export parser
+ (Parser Time)
+ (let [to-millis (: (-> Duration Nat)
+ (|>> duration.to-millis .nat))
+ hour (to-millis duration.hour)
+ minute (to-millis duration.minute)
+ second (to-millis duration.second)
+ millis (to-millis duration.milli-second)]
+ (do {@ <>.monad}
+ [utc-hour ..parse-hour
+ _ (<t>.this ..separator)
+ utc-minute ..parse-minute
+ _ (<t>.this ..separator)
+ utc-second ..parse-second
+ utc-millis ..parse-millis]
+ (wrap (:abstraction
+ ($_ n.+
+ (n.* utc-hour hour)
+ (n.* utc-minute minute)
+ (n.* utc-second second)
+ (n.* utc-millis millis)))))))
+ )
+
+(def: (pad value)
+ (-> Nat Text)
+ (if (n.< 10 value)
+ (text@compose "0" (n@encode value))
+ (n@encode value)))
+
+(def: (adjust-negative space duration)
+ (-> Duration Duration Duration)
+ (if (duration.negative? duration)
+ (duration.merge space duration)
+ duration))
+
+(def: (encode-millis millis)
+ (-> Nat Text)
+ (cond (n.= 0 millis) ""
+ (n.< 10 millis) ($_ text@compose ".00" (n@encode millis))
+ (n.< 100 millis) ($_ text@compose ".0" (n@encode millis))
+ ## (n.< 1,000 millis)
+ ($_ text@compose "." (n@encode millis))))
+
+(def: (encode time)
+ (-> Time Text)
+ (let [time (|> time ..to-millis .int duration.from-millis)
+ [hours time] [(duration.query duration.hour time) (duration.frame duration.hour time)]
+ [minutes time] [(duration.query duration.minute time) (duration.frame duration.minute time)]
+ [seconds millis] [(duration.query duration.second time) (duration.frame duration.second time)]]
+ ($_ text@compose
+ (..pad (.nat hours))
+ ..separator (..pad (.nat minutes))
+ ..separator (..pad (.nat seconds))
+ (|> millis
+ (..adjust-negative duration.second)
+ duration.to-millis
+ .nat
+ ..encode-millis))))
+
+(structure: #export codec
+ {#.doc (doc "Based on ISO 8601."
+ "For example: 21:14:51.827")}
+ (Codec Text Time)
+
+ (def: encode ..encode)
+ (def: decode (<t>.run ..parser)))
diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux
index 01b521ca6..455176de6 100644
--- a/stdlib/source/lux/time/date.lux
+++ b/stdlib/source/lux/time/date.lux
@@ -211,11 +211,8 @@
(def: encode ..encode)
(def: decode (<t>.run ..parser)))
-(def: days-per-year
- 365)
-
(def: days-per-leap
- (|> ..days-per-year
+ (|> //year.days
(n.* 4)
(n.+ 1)))
@@ -223,7 +220,7 @@
(let [leaps-per-century (n./ //year.leap
//year.century)]
(|> //year.century
- (n.* ..days-per-year)
+ (n.* //year.days)
(n.+ leaps-per-century)
(n.- 1))))
@@ -239,7 +236,7 @@
leaps::70 (n./ //year.leap
years::70)
days::70 (|> years::70
- (n.* ..days-per-year)
+ (n.* //year.days)
(n.+ leaps::70))
## The epoch is being calculated from March 1st, instead of January 1st.
january-&-february (n.+ (//month.days #//month.January)
@@ -317,7 +314,7 @@
..day-of-year-from-month
(i.+ (.int (dec (..day-of-month date)))))
day-of-era (|> day-of-year
- (i.+ (i.* (.int ..days-per-year) year-of-era))
+ (i.+ (i.* (.int //year.days) year-of-era))
(i.+ (i./ (.int //year.leap) year-of-era))
(i.- (i./ (.int //year.century) year-of-era)))]
(|> (i.* (.int ..days-per-era) era)
@@ -337,11 +334,11 @@
(i.- (i./ ..last-era-leap-day day-of-era))
(i.+ (i./ (.int ..days-per-century) day-of-era))
(i.- (i./ ..last-era-day day-of-era))
- (i./ (.int ..days-per-year)))
+ (i./ (.int //year.days)))
year (i.+ (i.* (.int //year.era) era)
year-of-era)
day-of-year (|> day-of-era
- (i.- (i.* (.int ..days-per-year) year-of-era))
+ (i.- (i.* (.int //year.days) year-of-era))
(i.- (i./ (.int //year.leap) year-of-era))
(i.+ (i./ (.int //year.century) year-of-era)))
month (..month-from-day-of-year day-of-year)
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index fd842aff6..5f044fa71 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -8,6 +8,7 @@
[monad (#+ Monad do)]]
[control
[io (#+ IO io)]
+ ["." try]
["." exception (#+ exception:)]
["<>" parser
["<t>" text (#+ Parser)]]]
@@ -22,7 +23,7 @@
["." list ("#@." fold)]]]
[type
abstract]]
- [//
+ ["." // (#+ Time)
["." duration (#+ Duration)]
["." year (#+ Year)]
["." month (#+ Month)]
@@ -88,26 +89,6 @@
Instant
(..from-millis +0))
-(def: (pad value)
- (-> Nat Text)
- (if (n.< 10 value)
- (text@compose "0" (n@encode value))
- (n@encode value)))
-
-(def: (adjust-negative space duration)
- (-> Duration Duration Duration)
- (if (duration.negative? duration)
- (duration.merge space duration)
- duration))
-
-(def: (encode-millis millis)
- (-> Nat Text)
- (cond (n.= 0 millis) ""
- (n.< 10 millis) ($_ text@compose ".00" (n@encode millis))
- (n.< 100 millis) ($_ text@compose ".0" (n@encode millis))
- ## (n.< 1,000 millis)
- ($_ text@compose "." (n@encode millis))))
-
(def: millis-per-day
(duration.query duration.milli-second duration.day))
@@ -128,85 +109,37 @@
[(def: <definition> Text <value>)]
["T" date-suffix]
-
- [":" time-separator]
["Z" time-suffix]
)
-(def: #export (encode instant)
+(def: (clock-time duration)
+ (-> Duration Time)
+ (let [time (if (:: duration.order < duration.empty duration)
+ (duration.merge duration.day duration)
+ duration)]
+ (|> time duration.to-millis .nat //.from-millis try.assume)))
+
+(def: (encode instant)
(-> Instant Text)
(let [[date time] (..date-time instant)
- time (if (:: duration.order < duration.empty time)
- (duration.merge duration.day time)
- time)
- [hours time] [(duration.query duration.hour time) (duration.frame duration.hour time)]
- [minutes time] [(duration.query duration.minute time) (duration.frame duration.minute time)]
- [seconds millis] [(duration.query duration.second time) (duration.frame duration.second time)]]
+ time (..clock-time time)]
($_ text@compose
- (:: date.codec encode date)
- ..date-suffix (..pad (.nat hours))
- ..time-separator (..pad (.nat minutes))
- ..time-separator (..pad (.nat seconds))
- (|> millis
- (..adjust-negative duration.second)
- duration.to-millis
- .nat
- ..encode-millis)
- ..time-suffix)))
-
-(def: parse-section
- (Parser Nat)
- (<>.codec n.decimal (<t>.exactly 2 <t>.decimal)))
-
-(def: parse-millis
- (Parser Nat)
- (<>.either (|> (<t>.at-most 3 <t>.decimal)
- (<>.codec n.decimal)
- (<>.after (<t>.this ".")))
- (:: <>.monad wrap 0)))
-
-(template [<minimum> <maximum> <parser> <exception>]
- [(exception: #export (<exception> {value Nat})
- (exception.report
- ["Value" (n@encode value)]
- ["Minimum" (n@encode <minimum>)]
- ["Maximum" (n@encode <maximum>)]))
-
- (def: <parser>
- (Parser Nat)
- (do <>.monad
- [value ..parse-section]
- (if (and (n.>= <minimum> value)
- (n.<= <maximum> value))
- (wrap value)
- (<>.lift (exception.throw <exception> [value])))))]
-
- [0 23 parse-hour invalid-hour]
- [0 59 parse-minute invalid-minute]
- [0 59 parse-second invalid-second]
- )
+ (:: date.codec encode date) ..date-suffix
+ (:: //.codec encode time) ..time-suffix)))
(def: parser
(Parser Instant)
(do {@ <>.monad}
[days (:: @ map date.days date.parser)
_ (<t>.this ..date-suffix)
- utc-hour (<>.before (<t>.this ..time-separator)
- ..parse-hour)
- utc-minute (<>.before (<t>.this ..time-separator)
- ..parse-minute)
- utc-second ..parse-second
- utc-millis (<>.before (<t>.this ..time-suffix)
- ..parse-millis)]
+ time (:: @ map //.to-millis //.parser)
+ _ (<t>.this ..time-suffix)]
(wrap (|> (if (i.< +0 days)
(|> duration.day
(duration.scale-up (.nat (i.* -1 days)))
duration.inverse)
(duration.scale-up (.nat days) duration.day))
- (duration.merge (duration.scale-up utc-hour duration.hour))
- (duration.merge (duration.scale-up utc-minute duration.minute))
- (duration.merge (duration.scale-up utc-second duration.second))
- (duration.merge (duration.scale-up utc-millis duration.milli-second))
+ (duration.merge (duration.scale-up time duration.milli-second))
..absolute))))
(structure: #export codec
@@ -221,10 +154,15 @@
(IO Instant)
(io (..from-millis ("lux io current-time"))))
-(def: #export (date instant)
- (-> Instant Date)
- (let [[date _] (..date-time instant)]
- date))
+(template [<field> <type> <post-processing>]
+ [(def: #export (<field> instant)
+ (-> Instant <type>)
+ (let [[date time] (..date-time instant)]
+ (|> <field> <post-processing>)))]
+
+ [date Date (|>)]
+ [time Time ..clock-time]
+ )
(def: #export (day-of-week instant)
(-> Instant Day)
diff --git a/stdlib/source/lux/time/year.lux b/stdlib/source/lux/time/year.lux
index 9b6294a16..0ba2025c6 100644
--- a/stdlib/source/lux/time/year.lux
+++ b/stdlib/source/lux/time/year.lux
@@ -8,6 +8,9 @@
(type: #export Year
Int)
+(def: #export days
+ 365)
+
(def: #export epoch
Year
+1970)
@@ -56,12 +59,3 @@
[i.+ ..era]
))
(..with-year-0-leap year)))))
-
-(def: days-per-normal-year
- 365)
-
-(def: #export (days year)
- (-> Year Int)
- (|> year
- (i.* (.int ..days-per-normal-year))
- (i.+ (..leaps year))))
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index bfa2377f4..e29af6e7a 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -19,7 +19,9 @@
["%" format (#+ format)]
["." encoding]]
[format
- ["." xml]]]
+ ["." xml]]
+ [collection
+ ["." set]]]
[tool
[compiler
[language
@@ -29,7 +31,8 @@
["." file (#+ Path)]]]
["." / #_
[action (#+ Action)]
- ["#" project]
+ ["#" profile]
+ ["#." project (#+ Project)]
["#." parser]
["#." pom]
["#." cli]
@@ -61,20 +64,20 @@
(#.Right [end lux-code])
(#try.Success lux-code))))
-(def: (write-pom!' path project)
- (-> Path /.Project (IO (Try Any)))
+(def: (write-pom!' path profile)
+ (-> Path /.Profile (IO (Try Any)))
(do (try.with io.monad)
- [file (!.use (:: file.system file) [path])]
- (|> project
- /pom.project
+ [file (!.use (:: file.system file) [path])
+ pom (:: io.monad wrap (/pom.project profile))]
+ (|> pom
(:: xml.codec encode)
encoding.to-utf8
(!.use (:: file over-write)))))
-(def: (write-pom! project)
- (-> /.Project (IO Any))
+(def: (write-pom! profile)
+ (-> /.Profile (IO Any))
(do io.monad
- [outcome (write-pom!' /pom.file project)]
+ [outcome (write-pom!' /pom.file profile)]
(case outcome
(#try.Success value)
(wrap (log! "Successfully wrote POM file!"))
@@ -83,10 +86,10 @@
(wrap (log! (format "Could not write POM file:" text.new-line
error))))))
-(def: (install! project)
- (-> /.Project (Promise Any))
+(def: (install! profile)
+ (-> /.Profile (Promise Any))
(do promise.monad
- [outcome (/local.install (file.async file.system) project)]
+ [outcome (/local.install (file.async file.system) profile)]
(wrap (case outcome
(#try.Success _)
(log! "Successfully installed locally!")
@@ -95,16 +98,16 @@
(log! (format "Could not install locally:" text.new-line
error))))))
-(def: (fetch-dependencies! project)
- (-> /.Project (Promise Any))
+(def: (fetch-dependencies! profile)
+ (-> /.Profile (Promise Any))
(do promise.monad
[outcome (do (try.with promise.monad)
[cache (/local.all-cached (file.async file.system)
- (get@ #/.dependencies project)
+ (set.to-list (get@ #/.dependencies profile))
/dependency.empty)
resolution (promise.future
- (/dependency.resolve-all (get@ #/.repositories project)
- (get@ #/.dependencies project)
+ (/dependency.resolve-all (set.to-list (get@ #/.repositories profile))
+ (set.to-list (get@ #/.dependencies profile))
cache))]
(/local.cache-all (file.async file.system)
resolution))]
@@ -117,52 +120,48 @@
error))))))
(def: project
- (-> Binary (Try /.Project))
+ (-> Binary (Try Project))
(|>> (do> try.monad
[encoding.from-utf8]
[..read-code]
[(list) (<c>.run /parser.project)])))
-(program: [{command /cli.command}]
+(program: [{[profile operation] /cli.command}]
(do {@ io.monad}
[data (..read-file! /.file)]
- (case data
- (#try.Success data)
- (case (..project data)
- (#try.Success project)
- (case command
- #/cli.POM
- (..write-pom! project)
-
- #/cli.Dependencies
- (exec (..fetch-dependencies! project)
- (wrap []))
+ (case (do try.monad
+ [data data
+ project (..project data)]
+ (/project.profile project profile))
+ (#try.Success profile)
+ (case operation
+ #/cli.POM
+ (..write-pom! profile)
+
+ #/cli.Dependencies
+ (exec (..fetch-dependencies! profile)
+ (wrap []))
- #/cli.Install
- (exec (..install! project)
- (wrap []))
+ #/cli.Install
+ (exec (..install! profile)
+ (wrap []))
- (#/cli.Deploy repository user password)
- (exec (/deploy.do! repository user password project)
- (wrap []))
+ (#/cli.Deploy repository user password)
+ (exec (/deploy.do! repository user password profile)
+ (wrap []))
- (#/cli.Compilation compilation)
- (case compilation
- #/cli.Build (exec (/build.do! project)
- (wrap []))
- #/cli.Test (exec (/test.do! project)
- (wrap [])))
+ (#/cli.Compilation compilation)
+ (case compilation
+ #/cli.Build (exec (/build.do! profile)
+ (wrap []))
+ #/cli.Test (exec (/test.do! profile)
+ (wrap [])))
- (#/cli.Auto auto)
- (exec (case auto
- #/cli.Build (/auto.do! /build.do! project)
- #/cli.Test (/auto.do! /test.do! project))
- (wrap [])))
-
- (#try.Failure error)
- (wrap (log! (format "Invalid format file:" text.new-line
- error))))
+ (#/cli.Auto auto)
+ (exec (case auto
+ #/cli.Build (/auto.do! /build.do! profile)
+ #/cli.Test (/auto.do! /test.do! profile))
+ (wrap [])))
(#try.Failure error)
- (wrap (log! (format "Could not read file: "
- (%.text /.file)))))))
+ (wrap (log! error)))))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index b0d210c17..dc64dee6e 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -1,10 +1,11 @@
(.module:
- [lux #*
+ [lux (#- Name)
[control
["<>" parser
["." cli (#+ Parser)]]]]
[//
- [upload (#+ User Password)]])
+ [upload (#+ User Password)]
+ ["/" profile (#+ Name)]])
(type: #export Compilation
#Build
@@ -15,7 +16,7 @@
(<>.or (cli.this "build")
(cli.this "test")))
-(type: #export Command
+(type: #export Operation
#POM
#Dependencies
#Install
@@ -23,8 +24,11 @@
(#Compilation Compilation)
(#Auto Compilation))
-(def: #export command
- (Parser Command)
+(type: #export Command
+ [Name Operation])
+
+(def: operation
+ (Parser Operation)
($_ <>.or
(cli.this "pom")
(cli.this "deps")
@@ -38,3 +42,14 @@
(<>.after (cli.this "auto")
..compilation)
))
+
+(def: #export command
+ (Parser Command)
+ ($_ <>.either
+ (<>.after (cli.this "with")
+ ($_ <>.and
+ cli.any
+ ..operation))
+ (:: <>.monad map (|>> [/.default])
+ ..operation)
+ ))
diff --git a/stdlib/source/program/aedifex/command.lux b/stdlib/source/program/aedifex/command.lux
index 8b4432a97..5248b0273 100644
--- a/stdlib/source/program/aedifex/command.lux
+++ b/stdlib/source/program/aedifex/command.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*]
["." // #_
- ["#" project]
+ ["#" profile]
["#." action (#+ Action)]])
(type: #export (Command a)
- (-> //.Project (Action a)))
+ (-> //.Profile (Action a)))
diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux
index 5bf759a06..cbb76edbb 100644
--- a/stdlib/source/program/aedifex/command/auto.lux
+++ b/stdlib/source/program/aedifex/command/auto.lux
@@ -11,12 +11,13 @@
[data
[collection
["." array]
- ["." list]]]
+ ["." list]
+ ["." set]]]
[world
[file (#+ Path)]]]
["." // #_
["/#" // #_
- ["#" project]
+ ["#" profile]
["#." action (#+ Action)]
["#." command (#+ Command)]]])
@@ -115,17 +116,18 @@
#.None
(wrap []))))
-(def: #export (do! command project)
+(def: #export (do! command profile)
(All [a] (-> (Command a) (Command Any)))
(do {@ ///action.monad}
[#let [fs (java/nio/file/FileSystems::getDefault)]
watcher (promise.future (java/nio/file/FileSystem::newWatchService fs))
- targets (|> project
+ targets (|> profile
(get@ #///.sources)
+ set.to-list
(monad.map @ ..targets)
(:: @ map list.concat))
_ (monad.map @ (..watch! watcher) targets)
- _ (command project)]
+ _ (command profile)]
(loop [_ []]
(do @
[?key (..poll! watcher)
@@ -133,7 +135,7 @@
(#.Some key)
(do @
[_ (promise.future (..drain! watcher))
- _ (command project)]
+ _ (command profile)]
(wrap []))
#.None
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 0e5d1e229..f505f1d0a 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -16,11 +16,12 @@
["%" format (#+ format)]]
[collection
["." list ("#@." functor)]
- ["." dictionary]]]
+ ["." dictionary]
+ ["." set]]]
[world
["." file (#+ Path)]]]
["." /// #_
- ["#" project]
+ ["#" profile]
["#." action]
["#." command (#+ Command)]
["#." local]
@@ -55,6 +56,7 @@
(exception: #export no-available-compiler)
(exception: #export no-specified-program)
+(exception: #export no-specified-target)
(type: #export Compiler
(#JVM Artifact)
@@ -107,18 +109,25 @@
(-> Text (List Text) Text)
(|> values (list@map (|>> (format name " "))) (text.join-with " ")))
-(def: #export (do! project)
+(def: #export (do! profile)
(Command [Compiler
Path])
- (case (get@ #///.program project)
- (#.Some program)
+ (case [(get@ #///.program profile)
+ (get@ #///.target profile)]
+ [#.None _]
+ (promise@wrap (exception.throw ..no-specified-program []))
+
+ [_ #.None]
+ (promise@wrap (exception.throw ..no-specified-target []))
+
+ [(#.Some program) (#.Some target)]
(do ///action.monad
[cache (///local.all-cached (file.async file.system)
- (get@ #///.dependencies project)
+ (set.to-list (get@ #///.dependencies profile))
///dependency.empty)
resolution (promise.future
- (///dependency.resolve-all (get@ #///.repositories project)
- (get@ #///.dependencies project)
+ (///dependency.resolve-all (set.to-list (get@ #///.repositories profile))
+ (set.to-list (get@ #///.dependencies profile))
cache))
_ (///local.cache-all (file.async file.system)
resolution)
@@ -130,10 +139,10 @@
"program.jar"]
(#JS artifact) [(format "node --stack_size=8192 " (///local.path file.system artifact))
"program.js"])
- cache-directory (format working-directory (:: file.system separator) (get@ #///.target project))
+ cache-directory (format working-directory (:: file.system separator) target)
command (format prefix " build"
" " (..plural-parameter "--library" libraries)
- " " (..plural-parameter "--source" (get@ #///.sources project))
+ " " (..plural-parameter "--source" (set.to-list (get@ #///.sources profile)))
" " (..singular-parameter "--target" cache-directory)
" " (..singular-parameter "--module" program))]
#let [_ (log! "[BUILD STARTED]")]
@@ -141,6 +150,4 @@
#let [_ (log! "[BUILD ENDED]")]]
(wrap [compiler
(format cache-directory (:: file.system separator) output)]))
-
- #.None
- (promise@wrap (exception.throw ..no-specified-program []))))
+ ))
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index ed6667264..1081322b4 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -12,7 +12,8 @@
["%" format (#+ format)]
["." encoding]]
[collection
- ["." dictionary (#+ Dictionary)]]
+ ["." dictionary (#+ Dictionary)]
+ ["." set]]
[format
["." binary]
["." tar]
@@ -23,7 +24,7 @@
[compositor
["." export]]]
["." /// #_
- ["/" project (#+ Project)]
+ ["/" profile (#+ Profile)]
["//" upload (#+ User Password)]
["#." action (#+ Action)]
["#." command (#+ Command)]
@@ -39,29 +40,33 @@
(format (%.text name) " := " (%.text repo)))
(dictionary.entries options))]))
-(def: #export (do! repository user password project)
+(def: #export (do! repository user password profile)
(-> Text User Password (Command Any))
- (case (dictionary.get repository (get@ #/.deploy-repositories project))
- (#.Some repository)
- (let [artifact (get@ #/.identity project)
- deploy! (: (-> ///dependency.Type Binary (Action Any))
+ (case [(get@ #/.identity profile)
+ (dictionary.get repository (get@ #/.deploy-repositories profile))]
+ [#.None _]
+ (promise@wrap (exception.throw /.no-identity []))
+
+ [_ #.None]
+ (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))
+
+ [(#.Some identity) (#.Some repository)]
+ (let [deploy! (: (-> ///dependency.Type Binary (Action Any))
(function (_ type content)
(promise.future
(//.upload repository
user
password
- {#///dependency.artifact artifact
+ {#///dependency.artifact identity
#///dependency.type type}
content))))]
(do {@ ///action.monad}
[library (:: @ map (binary.run tar.writer)
(export.library (file.async file.system)
- (get@ #/.sources project)))
- _ (deploy! ///dependency.pom (|> project ///pom.project (:: xml.codec encode) encoding.to-utf8))
+ (set.to-list (get@ #/.sources profile))))
+ pom (promise@wrap (///pom.project profile))
+ _ (deploy! ///dependency.pom (|> pom (:: xml.codec encode) encoding.to-utf8))
_ (deploy! ///dependency.lux-library library)
_ (deploy! "sha1" (///hash.sha1 library))
_ (deploy! "md5" (///hash.md5 library))]
- (wrap [])))
-
- #.None
- (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories project)]))))
+ (wrap [])))))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index 0a429fdc2..1b8a02f1a 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -5,6 +5,7 @@
[control
["." io (#+ IO)]
["." try (#+ Try)]
+ ["." exception]
[concurrency
["." promise (#+ Promise)]]
[security
@@ -16,7 +17,8 @@
["." encoding]]
[collection
["." list ("#@." monoid)]
- ["." dictionary]]
+ ["." dictionary]
+ ["." set]]
[format
["." binary]
["." tar]
@@ -27,7 +29,7 @@
[compositor
["." export]]]
["." // #_
- ["/" project (#+ Project)]
+ ["/" profile (#+ Profile)]
["#." extension]
["#." pom]
["#." artifact (#+ Artifact)]
@@ -67,17 +69,22 @@
(file.get-file promise.monad system file))]
(!.use (:: file over-write) [content])))
-(def: #export (install system project)
- (-> (file.System Promise) Project (Promise (Try Any)))
- (do (try.with promise.monad)
- [repository (..guarantee-repository! system (get@ #/.identity project))
- #let [identity (get@ #/.identity project)
- artifact-name (format repository (:: system separator) (//artifact.identity identity))]
- package (export.library system (get@ #/.sources project))
- _ (..save! system (binary.run tar.writer package)
- (format artifact-name "." //dependency.lux-library))]
- (..save! system (|> project //pom.project (:: xml.codec encode) encoding.to-utf8)
- (format artifact-name //extension.pom))))
+(def: #export (install system profile)
+ (-> (file.System Promise) Profile (Promise (Try Any)))
+ (case (get@ #/.identity profile)
+ (#.Some identity)
+ (do (try.with promise.monad)
+ [repository (..guarantee-repository! system identity)
+ #let [artifact-name (format repository (:: system separator) (//artifact.identity identity))]
+ package (export.library system (set.to-list (get@ #/.sources profile)))
+ _ (..save! system (binary.run tar.writer package)
+ (format artifact-name "." //dependency.lux-library))
+ pom (:: promise.monad wrap (//pom.project profile))]
+ (..save! system (|> pom (:: xml.codec encode) encoding.to-utf8)
+ (format artifact-name //extension.pom)))
+
+ _
+ (:: promise.monad wrap (exception.throw /.no-identity []))))
(def: #export (cache system [artifact type] package)
(-> (file.System Promise) Dependency Package (Promise (Try Any)))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 17191d5cb..87f41f2c6 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -8,7 +8,8 @@
[data
["." text]
[collection
- ["." dictionary (#+ Dictionary)]]]
+ ["." dictionary (#+ Dictionary)]
+ ["." set (#+ Set)]]]
[tool
[compiler
[meta
@@ -16,10 +17,11 @@
[descriptor (#+ Module)]]]]]
[world
[net (#+ URL)]]]
- [//
- ["/" project]
- ["//." artifact (#+ Artifact)]
- ["//." dependency]])
+ ["." // #_
+ ["/" profile]
+ ["#." project (#+ Project)]
+ ["#." artifact (#+ Artifact)]
+ ["#." dependency]])
(def: (as-input input)
(-> (Maybe Code) (List Code))
@@ -115,16 +117,6 @@
(Parser /.Contributor)
..developer)
-(def: no-info
- /.Info
- {#/.url #.None
- #/.scm #.None
- #/.description #.None
- #/.licenses (list)
- #/.organization #.None
- #/.developers (list)
- #/.contributors (list)})
-
(def: info
(Parser /.Info)
(do {@ <>.monad}
@@ -162,6 +154,10 @@
(Parser /.Source)
<c>.text)
+(def: target
+ (Parser /.Target)
+ <c>.text)
+
(def: module
(Parser Module)
<c>.text)
@@ -171,28 +167,70 @@
(<c>.tuple (<>.and <c>.text
..repository)))
-(def: #export project
- (Parser /.Project)
+(def: profile
+ (Parser /.Profile)
(do {@ <>.monad}
[input (:: @ map
(dictionary.from-list text.hash)
(<c>.record (<>.some (<>.and <c>.local-tag
- <c>.any))))]
+ <c>.any))))
+ #let [^parents (: (Parser (List /.Name))
+ (<>.default (list)
+ (..plural input "parents" <c>.text)))
+ ^identity (: (Parser (Maybe Artifact))
+ (<>.maybe
+ (..singular input "identity" ..artifact)))
+ ^info (: (Parser (Maybe /.Info))
+ (<>.maybe
+ (..singular input "info" ..info)))
+ ^repositories (: (Parser (Set //dependency.Repository))
+ (|> (..plural input "repositories" ..repository)
+ (:: @ map (set.from-list text.hash))
+ (<>.default (set.new text.hash))))
+ ^dependencies (: (Parser (Set //dependency.Dependency))
+ (|> (..plural input "dependencies" ..dependency)
+ (:: @ map (set.from-list //dependency.hash))
+ (<>.default (set.new //dependency.hash))))
+ ^sources (: (Parser (Set /.Source))
+ (|> (..plural input "sources" ..source)
+ (:: @ map (set.from-list text.hash))
+ (<>.default (set.from-list text.hash (list /.default-source)))))
+ ^target (: (Parser (Maybe /.Target))
+ (<>.maybe
+ (..singular input "target" ..target)))
+ ^program (: (Parser (Maybe Module))
+ (<>.maybe
+ (..singular input "program" ..module)))
+ ^test (: (Parser (Maybe Module))
+ (<>.maybe
+ (..singular input "test" ..module)))
+ ^deploy-repositories (: (Parser (Dictionary Text //dependency.Repository))
+ (<| (:: @ map (dictionary.from-list text.hash))
+ (<>.default (list))
+ (..plural input "deploy-repositories" ..deploy-repository)))]]
($_ <>.and
- (..singular input "identity" ..artifact)
- (<>.default ..no-info
- (..singular input "info" ..info))
- (<>.default (list)
- (..plural input "repositories" ..repository))
- (<>.default (list)
- (..plural input "dependencies" ..dependency))
- (<>.default (list "source")
- (..plural input "sources" ..source))
- (<>.default "target"
- (..singular input "target" <c>.text))
- (<>.maybe (..singular input "program" ..module))
- (<>.maybe (..singular input "test" ..module))
- (<| (:: @ map (dictionary.from-list text.hash))
- (<>.default (list))
- (..plural input "deploy-repositories" ..deploy-repository))
+ ^parents
+ ^identity
+ ^info
+ ^repositories
+ ^dependencies
+ ^sources
+ ^target
+ ^program
+ ^test
+ ^deploy-repositories
)))
+
+(def: #export project
+ (Parser Project)
+ (let [default-profile (: (Parser Project)
+ (:: <>.monad map
+ (|>> [/.default] (list) (dictionary.from-list text.hash))
+ ..profile))
+ multi-profile (: (Parser Project)
+ (:: <>.monad map
+ (dictionary.from-list text.hash)
+ (<c>.record (<>.many (<>.and <c>.text
+ ..profile)))))]
+ (<>.either multi-profile
+ default-profile)))
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index 794ed7e12..9370620f5 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -1,15 +1,18 @@
(.module:
[lux #*
[control
- [pipe (#+ case>)]]
+ [pipe (#+ case>)]
+ ["." try (#+ Try)]
+ ["." exception]]
[data
["." maybe ("#@." functor)]
[format
["_" xml (#+ XML)]]
[collection
- ["." list ("#@." monoid functor)]]]]
+ ["." list ("#@." monoid functor)]
+ ["." set]]]]
["." // #_
- ["/" project]
+ ["/" profile]
["#." artifact (#+ Artifact)]
["#." dependency (#+ Repository Dependency)]])
@@ -110,11 +113,17 @@
))
(def: #export (project value)
- (-> /.Project XML)
- (#_.Node ["" "project"] _.attrs
- ($_ list@compose
- (list ..version)
- (..artifact (get@ #/.identity value))
- (|> value (get@ #/.repositories) (list@map ..repository) (..group "repositories") list)
- (|> value (get@ #/.dependencies) (list@map ..dependency) (..group "dependencies") list)
- )))
+ (-> /.Profile (Try XML))
+ (case (get@ #/.identity value)
+ (#.Some identity)
+ (#try.Success
+ (#_.Node ["" "project"] _.attrs
+ ($_ list@compose
+ (list ..version)
+ (..artifact identity)
+ (|> value (get@ #/.repositories) set.to-list (list@map ..repository) (..group "repositories") list)
+ (|> value (get@ #/.dependencies) set.to-list (list@map ..dependency) (..group "dependencies") list)
+ )))
+
+ _
+ (exception.throw /.no-identity [])))
diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux
new file mode 100644
index 000000000..5e5cb6175
--- /dev/null
+++ b/stdlib/source/program/aedifex/profile.lux
@@ -0,0 +1,135 @@
+(.module:
+ [lux (#- Info Source Module Name)
+ [abstract
+ [monoid (#+ Monoid)]]
+ [control
+ ["." exception (#+ exception:)]]
+ [data
+ ["." maybe ("#@." monoid)]
+ ["." text]
+ [collection
+ ["." dictionary (#+ Dictionary)]
+ ["." list ("#@." monoid)]
+ ["." set (#+ Set)]]]
+ [world
+ [net (#+ URL)]
+ [file (#+ Path)]]
+ [tool
+ [compiler
+ [meta
+ [archive
+ [descriptor (#+ Module)]]]]]]
+ [//
+ [artifact (#+ Artifact)]
+ ["." dependency]])
+
+(def: #export file
+ "project.lux")
+
+(type: #export Distribution
+ #Repo
+ #Manual)
+
+(type: #export License
+ [Text
+ URL
+ Distribution])
+
+(type: #export SCM
+ URL)
+
+(type: #export Organization
+ [Text
+ URL])
+
+(type: #export Email
+ Text)
+
+(type: #export Developer
+ [Text
+ Email
+ (Maybe Organization)])
+
+(type: #export Contributor
+ Developer)
+
+(type: #export Info
+ {#url (Maybe URL)
+ #scm (Maybe SCM)
+ #description (Maybe Text)
+ #licenses (List License)
+ #organization (Maybe Organization)
+ #developers (List Developer)
+ #contributors (List Contributor)})
+
+(def: #export default-info
+ Info
+ {#url #.None
+ #scm #.None
+ #description #.None
+ #licenses (list)
+ #organization #.None
+ #developers (list)
+ #contributors (list)})
+
+(type: #export Source
+ Path)
+
+(def: #export default-source
+ Source
+ "source")
+
+(type: #export Target
+ Path)
+
+(def: #export default-target
+ Target
+ "target")
+
+(type: #export Name
+ Text)
+
+(def: #export default
+ Name
+ "")
+
+(type: #export Profile
+ {#parents (List Name)
+ #identity (Maybe Artifact)
+ #info (Maybe Info)
+ #repositories (Set dependency.Repository)
+ #dependencies (Set dependency.Dependency)
+ #sources (Set Source)
+ #target (Maybe Target)
+ #program (Maybe Module)
+ #test (Maybe Module)
+ #deploy-repositories (Dictionary Text dependency.Repository)})
+
+(exception: #export no-identity)
+
+(structure: #export monoid
+ (Monoid Profile)
+
+ (def: identity
+ {#parents (list)
+ #identity #.None
+ #info #.None
+ #repositories (set.new text.hash)
+ #dependencies (set.new dependency.hash)
+ #sources (set.new text.hash)
+ #target #.None
+ #program #.None
+ #test #.None
+ #deploy-repositories (dictionary.new text.hash)})
+
+ (def: (compose override baseline)
+ {#parents (list@compose (get@ #parents baseline) (get@ #parents override))
+ #identity (maybe@compose (get@ #identity override) (get@ #identity baseline))
+ #info (maybe@compose (get@ #info override) (get@ #info baseline))
+ #repositories (set.union (get@ #repositories baseline) (get@ #repositories override))
+ #dependencies (set.union (get@ #dependencies baseline) (get@ #dependencies override))
+ #sources (set.union (get@ #sources baseline) (get@ #sources override))
+ #target (maybe@compose (get@ #target override) (get@ #target baseline))
+ #program (maybe@compose (get@ #program override) (get@ #program baseline))
+ #test (maybe@compose (get@ #test override) (get@ #test baseline))
+ #deploy-repositories (dictionary.merge (get@ #deploy-repositories override) (get@ #deploy-repositories baseline))}))
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index 20bbda840..81a8de1af 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,70 +1,53 @@
(.module:
- [lux (#- Info Source Module)
+ [lux (#- Name)
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]]
[data
- ["." text]
+ ["." text
+ ["%" format (#+ format)]]
[collection
- ["." dictionary (#+ Dictionary)]]]
- [world
- [net (#+ URL)]
- [file (#+ Path)]]
- [tool
- [compiler
- [meta
- [archive
- [descriptor (#+ Module)]]]]]]
- [//
- [artifact (#+ Artifact)]
- ["." dependency]])
-
-(def: #export file
- "project.lux")
-
-(type: #export Distribution
- #Repo
- #Manual)
-
-(type: #export License
- [Text
- URL
- Distribution])
-
-(type: #export SCM
- URL)
-
-(type: #export Organization
- [Text
- URL])
-
-(type: #export Email
- Text)
-
-(type: #export Developer
- [Text
- Email
- (Maybe Organization)])
-
-(type: #export Contributor
- Developer)
-
-(type: #export Info
- {#url (Maybe URL)
- #scm (Maybe SCM)
- #description (Maybe Text)
- #licenses (List License)
- #organization (Maybe Organization)
- #developers (List Developer)
- #contributors (List Contributor)})
-
-(type: #export Source
- Path)
+ ["." dictionary (#+ Dictionary)]
+ ["." set (#+ Set)]
+ ["." list ("#@." fold)]]]]
+ ["." // #_
+ ["#" profile (#+ Name Profile)]])
(type: #export Project
- {#identity Artifact
- #info Info
- #repositories (List dependency.Repository)
- #dependencies (List dependency.Dependency)
- #sources (List Source)
- #target Path
- #program (Maybe Module)
- #test (Maybe Module)
- #deploy-repositories (Dictionary Text dependency.Repository)})
+ (Dictionary Name Profile))
+
+(exception: #export (unknown-profile {name Name})
+ (exception.report
+ ["Name" (%.text name)]))
+
+(exception: #export (circular-dependency {dependee Name} {dependent Name})
+ (exception.report
+ ["Dependent" (%.text dependent)]
+ ["Dependee" (%.text dependee)]))
+
+(def: (profile' lineage project name)
+ (-> (Set Name) Project Name (Try Profile))
+ (case (dictionary.get name project)
+ (#.Some profile)
+ (case (list.find (set.member? lineage)
+ (get@ #//.parents profile))
+ (#.Some ouroboros)
+ (exception.throw ..circular-dependency [ouroboros name])
+
+ #.None
+ (do {@ try.monad}
+ [parents (monad.map @ (profile' (set.add name lineage) project)
+ (get@ #//.parents profile))]
+ (wrap (list@fold (function (_ parent child)
+ (:: //.monoid compose child parent))
+ profile
+ parents))))
+
+ #.None
+ (exception.throw ..unknown-profile [name])))
+
+(def: #export (profile project name)
+ (-> Project Name (Try Profile))
+ (profile' (set.new text.hash) project name))
diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux
index 08dddb051..4b207b257 100644
--- a/stdlib/source/test/lux/control/parser/text.lux
+++ b/stdlib/source/test/lux/control/parser/text.lux
@@ -95,19 +95,19 @@
(..should-fail (text.from-code invalid) /.lower))))
(do {@ random.monad}
[expected (:: @ map (n.% 10) random.nat)
- invalid (random.char (unicode.set [unicode.aegean-numbers (list)]))]
+ invalid (random.char (unicode.set [unicode.number-forms (list)]))]
(_.cover [/.decimal]
(and (..should-pass (:: n.decimal encode expected) /.decimal)
(..should-fail (text.from-code invalid) /.decimal))))
(do {@ random.monad}
[expected (:: @ map (n.% 8) random.nat)
- invalid (random.char (unicode.set [unicode.aegean-numbers (list)]))]
+ invalid (random.char (unicode.set [unicode.number-forms (list)]))]
(_.cover [/.octal]
(and (..should-pass (:: n.octal encode expected) /.octal)
(..should-fail (text.from-code invalid) /.octal))))
(do {@ random.monad}
[expected (:: @ map (n.% 16) random.nat)
- invalid (random.char (unicode.set [unicode.aegean-numbers (list)]))]
+ invalid (random.char (unicode.set [unicode.number-forms (list)]))]
(_.cover [/.hexadecimal]
(and (..should-pass (:: n.hex encode expected) /.hexadecimal)
(..should-fail (text.from-code invalid) /.hexadecimal))))
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux
index 492fdac24..17f773206 100644
--- a/stdlib/source/test/lux/data/binary.lux
+++ b/stdlib/source/test/lux/data/binary.lux
@@ -1,16 +1,18 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
- ["r" math/random (#+ Random)]
["_" test (#+ Test)]
+ [math
+ ["." random (#+ Random)]]
[abstract
["." monad (#+ do)]
["." enum]
{[0 #spec]
[/
- ["$." equivalence]]}]
+ ["$." equivalence]
+ ["$." monoid]]}]
[control
- ["." try (#+ Try)]]
+ ["." try (#+ Try)]
+ ["." exception (#+ Exception)]]
[data
[number
["." i64]
@@ -24,7 +26,7 @@
(-> (Try Bit) Bit)
(case result
(#try.Failure _)
- #0
+ false
(#try.Success output)
output))
@@ -34,59 +36,124 @@
(let [output (/.create size)]
(loop [idx 0]
(if (n.< size idx)
- (do r.monad
- [byte r.nat]
+ (do random.monad
+ [byte random.nat]
(exec (try.assume (/.write/8 idx byte output))
(recur (inc idx))))
- (:: r.monad wrap output)))))
+ (:: random.monad wrap output)))))
-(def: (bits-io bytes read write value)
+(def: (throws? exception try)
+ (All [e a] (-> (Exception e) (Try a) Bit))
+ (case try
+ (#try.Failure error)
+ (exception.match? exception error)
+
+ (#try.Success _)
+ false))
+
+(def: (binary-io bytes read write value)
(-> Nat (-> Nat Binary (Try Nat)) (-> Nat Nat Binary (Try Any)) Nat Bit)
(let [binary (/.create bytes)
cap (case bytes
8 (dec 0)
_ (|> 1 (i64.left-shift (n.* 8 bytes)) dec))
capped-value (i64.and cap value)]
- (succeed
- (do try.monad
- [_ (write 0 value binary)
- output (read 0 binary)]
- (wrap (n.= capped-value output))))))
+ (and (succeed
+ (do try.monad
+ [pre (read 0 binary)
+ _ (write 0 value binary)
+ post (read 0 binary)]
+ (wrap (and (n.= 0 pre)
+ (n.= capped-value post)))))
+ (throws? /.index-out-of-bounds (read 1 binary))
+ (throws? /.index-out-of-bounds (write 1 value binary)))))
+
+(def: as-list
+ (-> /.Binary (List Nat))
+ (/.fold (function (_ head tail)
+ (#.Cons head tail))
+ (list)))
(def: #export test
Test
- (<| (_.context (%.name (name-of /._)))
- (do {@ r.monad}
- [#let [gen-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 8))))]
- binary-size gen-size
- random-binary (binary binary-size)
- value r.nat
- #let [gen-idx (|> r.nat (:: @ map (n.% binary-size)))]
- [from to] (r.and gen-idx gen-idx)
+ (<| (_.covering /._)
+ (do {@ random.monad}
+ [#let [gen-size (|> random.nat (:: @ map (|>> (n.% 100) (n.max 8))))]
+ size gen-size
+ sample (..binary size)
+ value random.nat
+ #let [gen-idx (|> random.nat (:: @ map (n.% size)))]
+ [from to] (random.and gen-idx gen-idx)
#let [[from to] [(n.min from to) (n.max from to)]]]
- ($_ _.and
- ($equivalence.spec /.equivalence (binary binary-size))
- (_.test "Can get size of binary."
- (|> random-binary /.size (n.= binary-size)))
- (_.test "Can read/write 8-bit values."
- (bits-io 1 /.read/8 /.write/8 value))
- (_.test "Can read/write 16-bit values."
- (bits-io 2 /.read/16 /.write/16 value))
- (_.test "Can read/write 32-bit values."
- (bits-io 4 /.read/32 /.write/32 value))
- (_.test "Can read/write 64-bit values."
- (bits-io 8 /.read/64 /.write/64 value))
- (_.test "Can slice binaries."
- (let [slice-size (|> to (n.- from) inc)
- random-slice (try.assume (/.slice from to random-binary))
- idxs (enum.range n.enum 0 (dec slice-size))
- reader (function (_ binary idx) (/.read/8 idx binary))]
- (and (n.= slice-size (/.size random-slice))
- (case [(monad.map try.monad (reader random-slice) idxs)
- (monad.map try.monad (|>> (n.+ from) (reader random-binary)) idxs)]
- [(#try.Success slice-vals) (#try.Success binary-vals)]
- (:: (list.equivalence n.equivalence) = slice-vals binary-vals)
+ (_.with-cover [/.Binary]
+ ($_ _.and
+ (_.with-cover [/.equivalence]
+ ($equivalence.spec /.equivalence (..binary size)))
+ (_.with-cover [/.monoid]
+ ($monoid.spec /.equivalence /.monoid (..binary size)))
+ (_.cover [/.fold]
+ (n.= (:: list.fold fold n.+ 0 (..as-list sample))
+ (/.fold n.+ 0 sample)))
+
+ (_.cover [/.create]
+ (:: /.equivalence =
+ (/.create size)
+ (/.create size)))
+ (_.cover [/.size]
+ (|> (/.create size) /.size (n.= size)))
+ (_.with-cover [/.index-out-of-bounds]
+ ($_ _.and
+ (_.cover [/.read/8 /.write/8]
+ (..binary-io 1 /.read/8 /.write/8 value))
+ (_.cover [/.read/16 /.write/16]
+ (..binary-io 2 /.read/16 /.write/16 value))
+ (_.cover [/.read/32 /.write/32]
+ (..binary-io 4 /.read/32 /.write/32 value))
+ (_.cover [/.read/64 /.write/64]
+ (..binary-io 8 /.read/64 /.write/64 value))))
+ (_.cover [/.slice]
+ (let [slice-size (|> to (n.- from) inc)
+ random-slice (try.assume (/.slice from to sample))
+ idxs (enum.range n.enum 0 (dec slice-size))
+ reader (function (_ binary idx) (/.read/8 idx binary))]
+ (and (n.= slice-size (/.size random-slice))
+ (case [(monad.map try.monad (reader random-slice) idxs)
+ (monad.map try.monad (|>> (n.+ from) (reader sample)) idxs)]
+ [(#try.Success slice-vals) (#try.Success binary-vals)]
+ (:: (list.equivalence n.equivalence) = slice-vals binary-vals)
+
+ _
+ #0))))
+ (_.cover [/.slice-out-of-bounds]
+ (and (throws? /.slice-out-of-bounds (/.slice size size sample))
+ (throws? /.slice-out-of-bounds (/.slice from size sample))))
+ (_.cover [/.inverted-slice]
+ (or (throws? /.inverted-slice (/.slice to from sample))
+ (n.= to from)))
+ (_.cover [/.drop]
+ (and (:: /.equivalence = sample (/.drop 0 sample))
+ (:: /.equivalence = (/.create 0) (/.drop size sample))
+ (case (list.reverse (..as-list sample))
+ #.Nil
+ false
+
+ (#.Cons head tail)
+ (n.= (list.fold n.+ 0 tail)
+ (/.fold n.+ 0 (/.drop 1 sample))))))
+ (_.cover [/.copy]
+ (and (case (/.copy size 0 sample 0 (/.create size))
+ (#try.Success output)
+ (and (not (is? sample output))
+ (:: /.equivalence = sample output))
- _
- #0))))
- ))))
+ (#try.Failure _)
+ false)
+ (succeed
+ (do try.monad
+ [sample/0 (/.read/8 0 sample)
+ copy (/.copy 1 0 sample 0 (/.create 2))
+ copy/0 (/.read/8 0 copy)
+ copy/1 (/.read/8 1 copy)]
+ (wrap (and (n.= sample/0 copy/0)
+ (n.= 0 copy/1)))))))
+ )))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 01:57:16 +0000