aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/data/text/buffer.lux3
-rw-r--r--stdlib/source/lux/math/number.lux19
-rw-r--r--stdlib/source/lux/meta.lux16
-rw-r--r--stdlib/source/lux/time/duration.lux21
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux13
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux82
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux2
-rw-r--r--stdlib/source/lux/world/file.lux30
-rw-r--r--stdlib/source/lux/world/program.lux123
-rw-r--r--stdlib/source/program/aedifex/artifact/value.lux18
-rw-r--r--stdlib/source/program/compositor.lux11
-rw-r--r--stdlib/source/test/aedifex/artifact.lux2
-rw-r--r--stdlib/source/test/aedifex/artifact/value.lux38
-rw-r--r--stdlib/source/test/lux.lux117
-rw-r--r--stdlib/source/test/lux/host.js.lux24
-rw-r--r--stdlib/source/test/lux/math/number/frac.lux3
-rw-r--r--stdlib/source/test/lux/meta.lux214
-rw-r--r--stdlib/source/test/lux/time/day.lux35
-rw-r--r--stdlib/source/test/lux/time/duration.lux100
-rw-r--r--stdlib/source/test/lux/time/instant.lux4
21 files changed, 657 insertions, 221 deletions
diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux
index e58e10405..e4ebba1c9 100644
--- a/stdlib/source/lux/data/text/buffer.lux
+++ b/stdlib/source/lux/data/text/buffer.lux
@@ -33,7 +33,8 @@
(new [int])
(toString [] java/lang/String)]))]
(`` (for {@.old (as_is <jvm>)
- @.jvm (as_is <jvm>)})))
+ @.jvm (as_is <jvm>)}
+ (as_is))))
(`` (abstract: #export Buffer
(for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]
diff --git a/stdlib/source/lux/math/number.lux b/stdlib/source/lux/math/number.lux
index dd7dba194..a96c450ee 100644
--- a/stdlib/source/lux/math/number.lux
+++ b/stdlib/source/lux/math/number.lux
@@ -19,8 +19,8 @@
"Given syntax for a "
encoding
" number, generates a Nat, an Int, a Rev or a Frac.")
- commas "Allows for the presence of commas among the digits."
- description [location (#.Text ($_ "lux text concat" encoding " " commas))]]
+ separators "Allows for the presence of commas among the digits."
+ description [location (#.Text ($_ "lux text concat" encoding " " separators))]]
(#try.Success [state (list (` (doc (~ description)
(~ example_1)
(~ example_2))))]))
@@ -28,27 +28,30 @@
_
(#try.Failure "Wrong syntax for 'encoding_doc'.")))
-(def: (comma_prefixed? number)
+(def: separator
+ ",")
+
+(def: (separator_prefixed? number)
(-> Text Bit)
- (case ("lux text index" 0 "," number)
+ (case ("lux text index" 0 ..separator number)
(#.Some 0)
#1
_
#0))
-(def: clean_commas
+(def: clean_separators
(-> Text Text)
- (text.replace_all "," ""))
+ (text.replace_all ..separator ""))
(template [<macro> <nat> <int> <rev> <frac> <error> <doc>]
[(macro: #export (<macro> tokens state)
{#.doc <doc>}
(case tokens
(#.Cons [meta (#.Text repr')] #.Nil)
- (if (comma_prefixed? repr')
+ (if (..separator_prefixed? repr')
(#try.Failure <error>)
- (let [repr (clean_commas repr')]
+ (let [repr (..clean_separators repr')]
(case (\ <nat> decode repr)
(#try.Success value)
(#try.Success [state (list [meta (#.Nat value)])])
diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux
index aeeb71cf1..9b12c6ae9 100644
--- a/stdlib/source/lux/meta.lux
+++ b/stdlib/source/lux/meta.lux
@@ -147,9 +147,10 @@
(def: #export current_module
(Meta Module)
- (do ..monad
- [this_module_name current_module_name]
- (find_module this_module_name)))
+ (let [(^open "\.") ..monad]
+ (|> ..current_module_name
+ (\map ..find_module)
+ \join)))
(def: (macro_type? type)
(-> Type Bit)
@@ -593,13 +594,12 @@
(def: #export (imported? import)
(-> Text (Meta Bit))
- (let [(^open ".") ..monad]
- (|> ..current_module_name
- (map ..find_module) join
- (map (|>> (get@ #.imports) (list.any? (text\= import)))))))
+ (\ ..functor map
+ (|>> (get@ #.imports) (list.any? (text\= import)))
+ ..current_module))
(def: #export (resolve_tag tag)
- {#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."}
+ {#.doc "Given a tag, finds out what is its index, its related tag-list and its associated type."}
(-> Name (Meta [Nat (List Name) Type]))
(do ..monad
[#let [[module name] tag]
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index fbe116ee1..3ea941935 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -3,6 +3,7 @@
[abstract
[equivalence (#+ Equivalence)]
[order (#+ Order)]
+ [enum (#+ Enum)]
[codec (#+ Codec)]
[monoid (#+ Monoid)]
[monad (#+ do)]]
@@ -54,10 +55,6 @@
(-> Duration Duration)
(|>> :representation (i.* -1) :abstraction))
- (def: #export (difference from to)
- (-> Duration Duration Duration)
- (|> from inverse (merge to)))
-
(def: #export (query param subject)
(-> Duration Duration Int)
(i./ (:representation param) (:representation subject)))
@@ -178,8 +175,7 @@
(..merge (..up hours ..hour))
(..merge (..up minutes ..minute))
(..merge (..up seconds ..second))
- (..merge (..up millis ..milli_second))
- )]]
+ (..merge (..up millis ..milli_second)))]]
(wrap (case sign
(#.Left _) (..inverse span)
(#.Right _) span)))))
@@ -189,3 +185,16 @@
(def: encode ..encode)
(def: decode (<t>.run ..parser)))
+
+(def: #export (difference from to)
+ (-> Duration Duration Duration)
+ (|> from ..inverse (..merge to)))
+
+(structure: #export enum
+ (Enum Duration)
+
+ (def: &order ..order)
+ (def: succ
+ (..merge ..milli_second))
+ (def: pred
+ (..merge (..inverse ..milli_second))))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 15b7165f4..21fc0b343 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -1,6 +1,7 @@
(.module:
[lux (#- Module)
[type (#+ :share)]
+ ["." debug]
["@" target (#+ Host)]
[abstract
["." monad (#+ Monad do)]]
@@ -524,7 +525,7 @@
(#.Right [[descriptor document] output])
(do !
- [#let [_ (log! (..module_compilation_log state))
+ [#let [_ (debug.log! (..module_compilation_log state))
descriptor (set@ #descriptor.references (set.from_list text.hash all_dependencies) descriptor)]
_ (..cache_module static platform module_id [[descriptor document] output])]
(case (archive.add module [descriptor document] archive)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux
index 09341fd59..db00d6439 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux
@@ -5,13 +5,16 @@
["." // #_
["#." runtime]])
-(def: #export bit _.boolean)
+(def: #export bit
+ _.boolean)
(def: #export (i64 value)
(-> (I64 Any) Computation)
- (//runtime.i64//new (|> value //runtime.high .int _.i32)
- (|> value //runtime.low .int _.i32)))
+ (//runtime.i64 (|> value //runtime.high .int _.i32)
+ (|> value //runtime.low .int _.i32)))
-(def: #export f64 _.number)
+(def: #export f64
+ _.number)
-(def: #export text _.string)
+(def: #export text
+ _.string)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
index 119796a73..82d787b9a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- i64)
["." meta]
[abstract
["." monad (#+ do)]]
@@ -193,14 +193,19 @@
(def: #export variant_flag_field "_lux_flag")
(def: #export variant_value_field "_lux_value")
-(runtime: (variant//create tag last? value)
- (_.return (_.object (list [..variant_tag_field tag]
- [..variant_flag_field last?]
- [..variant_value_field value]))))
+(runtime: (variant//new tag last? value)
+ (let [@this (_.var "this")]
+ (with_vars [tag is_last value]
+ (_.closure (list tag is_last value)
+ ($_ _.then
+ (_.set (_.the ..variant_tag_field @this) tag)
+ (_.set (_.the ..variant_flag_field @this) is_last)
+ (_.set (_.the ..variant_value_field @this) value)
+ )))))
(def: #export (variant tag last? value)
(-> Expression Expression Expression Computation)
- (..variant//create tag last? value))
+ (_.new ..variant//new (list tag last? value)))
(runtime: (sum//get sum wants_last wanted_tag)
(let [no_match! (_.return _.null)
@@ -249,7 +254,7 @@
($_ _.then
@tuple//left
@tuple//right
- @variant//create
+ @variant//new
@sum//get
))
@@ -281,8 +286,17 @@
(def: #export i64_high_field Text "_lux_high")
(runtime: (i64//new high low)
- (_.return (_.object (list [..i64_high_field high]
- [..i64_low_field low]))))
+ (let [@this (_.var "this")]
+ (with_vars [high low]
+ (_.closure (list high low)
+ ($_ _.then
+ (_.set (_.the ..i64_high_field @this) high)
+ (_.set (_.the ..i64_low_field @this) low)
+ )))))
+
+(def: #export (i64 high low)
+ (-> Expression Expression Computation)
+ (_.new ..i64//new (list high low)))
(runtime: i64//2^16
(_.left_shift (_.i32 +16) (_.i32 +1)))
@@ -306,16 +320,18 @@
(_.+ (i64//unsigned_low i64)))))
(runtime: i64//zero
- (i64//new (_.i32 +0) (_.i32 +0)))
+ (..i64 (_.i32 +0) (_.i32 +0)))
(runtime: i64//min
- (i64//new (_.i32 (hex "+80000000")) (_.i32 +0)))
+ (..i64 (_.i32 (hex "+80,00,00,00"))
+ (_.i32 +0)))
(runtime: i64//max
- (i64//new (_.i32 (hex "+7FFFFFFF")) (_.i32 (hex "+FFFFFFFF"))))
+ (..i64 (_.i32 (hex "+7F,FF,FF,FF"))
+ (_.i32 (hex "+FF,FF,FF,FF"))))
(runtime: i64//one
- (i64//new (_.i32 +0) (_.i32 +1)))
+ (..i64 (_.i32 +0) (_.i32 +1)))
(runtime: (i64//= reference sample)
(_.return (_.and (_.= (_.the ..i64_high_field reference)
@@ -355,16 +371,16 @@
(_.define x48 (|> (high_16 x32) (_.+ l48) (_.+ r48) low_16))
(_.set x32 (low_16 x32))
- (_.return (i64//new (_.bit_or (up_16 x48) x32)
- (_.bit_or (up_16 x16) x00)))
+ (_.return (..i64 (_.bit_or (up_16 x48) x32)
+ (_.bit_or (up_16 x16) x00)))
))))
(template [<name> <op>]
[(runtime: (<name> subject parameter)
- (_.return (i64//new (<op> (_.the ..i64_high_field subject)
- (_.the ..i64_high_field parameter))
- (<op> (_.the ..i64_low_field subject)
- (_.the ..i64_low_field parameter)))))]
+ (_.return (..i64 (<op> (_.the ..i64_high_field subject)
+ (_.the ..i64_high_field parameter))
+ (<op> (_.the ..i64_low_field subject)
+ (_.the ..i64_low_field parameter)))))]
[i64//xor _.bit_xor]
[i64//or _.bit_or]
@@ -372,8 +388,8 @@
)
(runtime: (i64//not value)
- (_.return (i64//new (_.bit_not (_.the ..i64_high_field value))
- (_.bit_not (_.the ..i64_low_field value)))))
+ (_.return (..i64 (_.bit_not (_.the ..i64_high_field value))
+ (_.bit_not (_.the ..i64_low_field value)))))
(runtime: (i64//negate value)
(_.if (i64//= i64//min value)
@@ -392,8 +408,8 @@
(_.return i64//max)]
[(|> value (_.< (_.i32 +0)))
(_.return (|> value _.negate i64//from_number i64//negate))])
- (_.return (i64//new (|> value (_./ i64//2^32) _.to_i32)
- (|> value (_.% i64//2^32) _.to_i32)))))
+ (_.return (..i64 (|> value (_./ i64//2^32) _.to_i32)
+ (|> value (_.% i64//2^32) _.to_i32)))))
(def: (cap_shift! shift)
(-> Var Statement)
@@ -416,9 +432,9 @@
(let [high (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift shift))
(|> input (_.the ..i64_low_field) (_.logic_right_shift (_.- shift (_.i32 +32)))))
low (|> input (_.the ..i64_low_field) (_.left_shift shift))]
- (_.return (i64//new high low)))])
+ (_.return (..i64 high low)))])
(let [high (|> input (_.the ..i64_low_field) (_.left_shift (_.- (_.i32 +32) shift)))]
- (_.return (i64//new high (_.i32 +0)))))))
+ (_.return (..i64 high (_.i32 +0)))))))
(runtime: (i64//arithmetic_right_shift input shift)
($_ _.then
@@ -428,12 +444,12 @@
(let [high (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift shift))
low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift)
(_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))]
- (_.return (i64//new high low)))])
+ (_.return (..i64 high low)))])
(let [high (_.? (|> input (_.the ..i64_high_field) (_.>= (_.i32 +0)))
(_.i32 +0)
(_.i32 -1))
low (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))]
- (_.return (i64//new high low))))))
+ (_.return (..i64 high low))))))
(runtime: (i64//logic_right_shift input shift)
($_ _.then
@@ -443,11 +459,11 @@
(let [high (|> input (_.the ..i64_high_field) (_.logic_right_shift shift))
low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift)
(_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))]
- (_.return (i64//new high low)))]
+ (_.return (..i64 high low)))]
[(|> shift (_.= (_.i32 +32)))
- (_.return (i64//new (_.i32 +0) (|> input (_.the ..i64_high_field))))])
- (_.return (i64//new (_.i32 +0)
- (|> input (_.the ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift))))))))
+ (_.return (..i64 (_.i32 +0) (|> input (_.the ..i64_high_field))))])
+ (_.return (..i64 (_.i32 +0)
+ (|> input (_.the ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift))))))))
(def: runtime//bit
Statement
@@ -520,8 +536,8 @@
(_.+ (_.* l00 r48))
low_16))
- (_.return (i64//new (_.bit_or (up_16 x48) x32)
- (_.bit_or (up_16 x16) x00)))
+ (_.return (..i64 (_.bit_or (up_16 x48) x32)
+ (_.bit_or (up_16 x16) x00)))
))))))
(runtime: (i64//< parameter subject)
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 cc86b7df2..011734cc8 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
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Type Definition case log! false true)
+ [lux (#- Type Definition case false true)
[abstract
["." monad (#+ do)]
["." enum]]
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 8e60de863..8882270f8 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -626,15 +626,27 @@
(System IO)
(~~ (template [<name> <method> <capability> <exception>]
- [(def: <name>
- (..can_open
- (function (<name> path)
- (do (try.with io.monad)
- [stats (Fs::statSync [path] (..node_fs []))
- verdict (<method> [] stats)]
- (if verdict
- (wrap (<capability> path))
- (\ io.monad wrap (exception.throw <exception> [path])))))))]
+ [(with_expansions [<failure> (exception.throw <exception> [path])]
+ (def: <name>
+ (..can_open
+ (function (<name> path)
+ (do {! io.monad}
+ [?stats (Fs::statSync [path] (..node_fs []))]
+ (case ?stats
+ (#try.Success stats)
+ (do !
+ [?verdict (<method> [] stats)]
+ (wrap (case ?verdict
+ (#try.Success verdict)
+ (if verdict
+ (#try.Success (<capability> path))
+ <failure>)
+
+ (#try.Failure _)
+ <failure>)))
+
+ (#try.Failure _)
+ (wrap <failure>)))))))]
[file Stats::isFile ..file ..cannot_find_file]
[directory Stats::isDirectory ..directory ..cannot_find_directory]
diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux
index 049a80dea..205fbb7f8 100644
--- a/stdlib/source/lux/world/program.lux
+++ b/stdlib/source/lux/world/program.lux
@@ -1,7 +1,7 @@
(.module:
[lux #*
["@" target]
- [host (#+ import:)]
+ ["." host (#+ import:)]
[abstract
[monad (#+ do)]]
[control
@@ -11,13 +11,17 @@
["." atom]
["." promise (#+ Promise)]]
[parser
- [environment (#+ Environment)]]]
+ ["." environment (#+ Environment)]]]
[data
["." maybe]
["." text
["%" format (#+ format)]]
[collection
- ["." dictionary (#+ Dictionary)]]]]
+ ["." array (#+ Array) ("#\." fold)]
+ ["." dictionary (#+ Dictionary)]]]
+ [math
+ [number
+ ["i" int]]]]
[//
[file (#+ Path)]
[shell (#+ Exit)]])
@@ -109,7 +113,61 @@
@.jvm <jvm>})))
)]
(for {@.old (as_is <jvm>)
- @.jvm (as_is <jvm>)}))
+ @.jvm (as_is <jvm>)
+ @.js (as_is (def: default_exit!
+ (-> Exit (IO Nothing))
+ (|>> %.int error! io.io))
+
+ (import: NodeJs_Process
+ (exit [host.Number] #io Nothing)
+ (cwd [] #io Path))
+
+ (def: (exit_node_js! code)
+ (-> Exit (IO Nothing))
+ (case (host.constant ..NodeJs_Process [process])
+ (#.Some process)
+ (NodeJs_Process::exit (i.frac code) process)
+
+ #.None
+ (..default_exit! code)))
+
+ (import: Browser_Window
+ (close [] Nothing))
+
+ (import: Browser_Location
+ (reload [] Nothing))
+
+ (def: (exit_browser! code)
+ (-> Exit (IO Nothing))
+ (case [(host.constant ..Browser_Window [window])
+ (host.constant ..Browser_Location [location])]
+ [(#.Some window) (#.Some location)]
+ (exec
+ (Browser_Window::close [] window)
+ (Browser_Location::reload [] location)
+ (..default_exit! code))
+
+ [(#.Some window) #.None]
+ (exec
+ (Browser_Window::close [] window)
+ (..default_exit! code))
+
+ [#.None (#.Some location)]
+ (exec
+ (Browser_Location::reload [] location)
+ (..default_exit! code))
+
+ [#.None #.None]
+ (..default_exit! code)))
+
+ (import: JS_Object
+ (entries [] (Array (Array host.String))))
+
+ (import: NodeJs_OS
+ (homedir [] #io Path))
+
+ (import: (require [host.String] Any)))}
+ (as_is)))
(structure: #export default
(Program IO)
@@ -117,21 +175,66 @@
(def: (environment _)
(with_expansions [<jvm> ..jvm\\environment]
(for {@.old <jvm>
- @.jvm <jvm>})))
+ @.jvm <jvm>
+ @.js (io.io (if host.on_node_js?
+ (case (host.constant JS_Object [process env])
+ (#.Some process/env)
+ (|> process/env
+ (JS_Object::entries [])
+ (array\fold (function (_ entry environment)
+ (<| (maybe.default environment)
+ (do maybe.monad
+ [variable (array.read 0 entry)
+ value (array.read 1 entry)]
+ (wrap (dictionary.put variable value environment)))))
+ environment.empty))
+
+ #.None
+ (undefined))
+ environment.empty))}
+ ## TODO: Replace dummy implementation.
+ (io.io environment.empty))))
(def: (home _)
- (with_expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))]
+ (with_expansions [<default> (io.io "~")
+ <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))]
(for {@.old <jvm>
- @.jvm <jvm>})))
+ @.jvm <jvm>
+ @.js (if host.on_node_js?
+ (|> (..require "os")
+ (:coerce NodeJs_OS)
+ (NodeJs_OS::homedir []))
+ <default>)}
+ ## TODO: Replace dummy implementation.
+ <default>)))
(def: (directory _)
- (with_expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))]
+ (with_expansions [<default> (io.io ".")
+ <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))]
(for {@.old <jvm>
- @.jvm <jvm>})))
+ @.jvm <jvm>
+ @.js (if host.on_node_js?
+ (case (host.constant ..NodeJs_Process [process])
+ (#.Some process)
+ (NodeJs_Process::cwd [] process)
+
+ #.None
+ <default>)
+ <default>)}
+ ## TODO: Replace dummy implementation.
+ <default>)))
(def: (exit code)
(with_expansions [<jvm> (do io.monad
[_ (java/lang/System::exit code)]
(wrap (undefined)))]
(for {@.old <jvm>
- @.jvm <jvm>}))))
+ @.jvm <jvm>
+ @.js (cond host.on_node_js?
+ (..exit_node_js! code)
+
+ host.on_browser?
+ (..exit_browser! code)
+
+ ## else
+ (..default_exit! code))}))))
diff --git a/stdlib/source/program/aedifex/artifact/value.lux b/stdlib/source/program/aedifex/artifact/value.lux
index eb5c33c22..3e92dbf16 100644
--- a/stdlib/source/program/aedifex/artifact/value.lux
+++ b/stdlib/source/program/aedifex/artifact/value.lux
@@ -1,25 +1,19 @@
(.module:
- [lux (#- Name Type)
+ [lux #*
[abstract
[equivalence (#+ Equivalence)]]
[data
["." product]
["." text
["%" format]]
- [format
- ["." xml]]
[collection
["." list ("#\." functor)]]]
[math
[number
- ["n" nat]]]
- ["." time (#+ Time)
- ["." instant (#+ Instant)]
- ["." date (#+ Date)]
- ["." year]
- ["." month]]]
+ ["." nat]]]
+ [time
+ ["." instant]]]
[// (#+ Version)
- [type (#+ Type)]
["." time_stamp (#+ Time_Stamp)]])
(type: #export Build
@@ -35,7 +29,7 @@
($_ product.equivalence
text.equivalence
instant.equivalence
- n.equivalence
+ nat.equivalence
))
(def: separator
@@ -44,7 +38,7 @@
(def: snapshot
"SNAPSHOT")
-(def: #export (format [version time_stamp build])
+(def: #export (format (^slots [#version #time_stamp #build]))
(%.Format Value)
(%.format (text.replace_all ..snapshot
(time_stamp.format time_stamp)
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 2788783cc..63325ff0b 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -1,6 +1,7 @@
(.module:
[lux (#- Module)
[type (#+ :share)]
+ ["." debug]
["@" target (#+ Host)]
[abstract
[monad (#+ Monad do)]]
@@ -62,9 +63,9 @@
[?output action]
(case ?output
(#try.Failure error)
- (exec (log! (format text.new_line
- failure_description text.new_line
- error text.new_line))
+ (exec (debug.log! (format text.new_line
+ failure_description text.new_line
+ error text.new_line))
(io.run (\ world/program.default exit +1)))
(#try.Success output)
@@ -141,14 +142,14 @@
_ (ioW.freeze (get@ #platform.&file_system platform) static archive)
program_context (promise\wrap ($/program.context archive))
_ (promise.future (..package! io.monad file.default packager,package static archive program_context))]
- (wrap (log! "Compilation complete!"))))
+ (wrap (debug.log! "Compilation complete!"))))
(#/cli.Export export)
(<| (or_crash! "Export failed:")
(do (try.with promise.monad)
[_ (/export.export (get@ #platform.&file_system platform)
export)]
- (wrap (log! "Export complete!"))))
+ (wrap (debug.log! "Export complete!"))))
(#/cli.Interpretation interpretation)
## TODO: Fix the interpreter...
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index dc2de91f7..7409a65e2 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -21,6 +21,7 @@
["." / #_
["#." type]
["#." extension]
+ ["#." value]
["#." time_stamp
["#/." date]
["#/." time]]]
@@ -45,6 +46,7 @@
/type.test
/extension.test
+ /value.test
/time_stamp.test
/time_stamp/date.test
/time_stamp/time.test
diff --git a/stdlib/source/test/aedifex/artifact/value.lux b/stdlib/source/test/aedifex/artifact/value.lux
new file mode 100644
index 000000000..10e9016b1
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/value.lux
@@ -0,0 +1,38 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" text]]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["n" nat]
+ ["i" int]]]
+ [time
+ ["." instant]]]
+ {#program
+ ["." /]})
+
+(def: #export random
+ (Random /.Value)
+ ($_ random.and
+ (random.ascii/alpha 5)
+ random.instant
+ random.nat
+ ))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Build /.Value])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+ )))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 2fb01ad72..f1200381a 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -1,42 +1,46 @@
-(.module:
- ["/" lux #*
- [program (#+ program:)]
- ["_" test (#+ Test)]
- ["@" target]
- [abstract
- [monad (#+ do)]
- [predicate (#+ Predicate)]]
- [control
- ["." io (#+ io)]]
- [data
- ["." name]
- [text
- ["%" format (#+ format)]]]
- ["." math
- ["." random (#+ Random) ("#\." functor)]
- [number
- ["n" nat]
- ["i" int]
- ["r" rev]
- ["f" frac]
- ["." i64]]]]
- ## TODO: Must have 100% coverage on tests.
- ["." / #_
- ["#." abstract]
- ["#." control]
- ["#." data]
- ["#." locale]
- ["#." macro]
- ["#." math]
- ["#." meta]
- ["#." time]
- ## ["#." tool]
- ["#." type]
- ["#." world]
- ["#." host]
- ["#." extension]
- ["#." target #_
- ["#/." jvm]]])
+(.with_expansions [<target>' (.for {"{old}" (.as_is ["#/." jvm])
+ "JVM" (.as_is ["#/." jvm])}
+ (.as_is))
+ <target> <target>']
+ (.module:
+ ["/" lux #*
+ [program (#+ program:)]
+ ["_" test (#+ Test)]
+ ["@" target]
+ [abstract
+ [monad (#+ do)]
+ [predicate (#+ Predicate)]]
+ [control
+ ["." io (#+ io)]]
+ [data
+ ["." name]
+ [text
+ ["%" format (#+ format)]]]
+ ["." math
+ ["." random (#+ Random) ("#\." functor)]
+ [number
+ ["n" nat]
+ ["i" int]
+ ["r" rev]
+ ["f" frac]
+ ["." i64]]]]
+ ## TODO: Must have 100% coverage on tests.
+ ["." / #_
+ ["#." abstract]
+ ["#." control]
+ ["#." data]
+ ["#." locale]
+ ["#." macro]
+ ["#." math]
+ ["#." meta]
+ ["#." time]
+ ## ["#." tool]
+ ["#." type]
+ ["#." world]
+ ["#." host]
+ ["#." extension]
+ ["#." target #_
+ <target>]]))
## TODO: Get rid of this ASAP
(template: (!bundle body)
@@ -211,22 +215,25 @@
(def: sub_tests
Test
- (_.in_parallel (list& /abstract.test
- /control.test
- /data.test
- /locale.test
- /macro.test
- /math.test
- /meta.test
- /time.test
- ## /tool.test
- /type.test
- /world.test
- /host.test
- /target/jvm.test
- (for {@.old (list)}
- (list /extension.test))
- )))
+ (let [tail (: (List Test)
+ (for {@.old (list)}
+ (list /extension.test)))]
+ (_.in_parallel (list& /abstract.test
+ /control.test
+ /data.test
+ /locale.test
+ /macro.test
+ /math.test
+ /meta.test
+ /time.test
+ ## /tool.test
+ /type.test
+ /world.test
+ /host.test
+ (for {@.jvm (#.Cons /target/jvm.test tail)
+ @.old (#.Cons /target/jvm.test tail)}
+ tail)
+ ))))
(def: test
(<| (_.context (name.module (name_of /._)))
diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux
index 6147ef9b9..5ffe1fbeb 100644
--- a/stdlib/source/test/lux/host.js.lux
+++ b/stdlib/source/test/lux/host.js.lux
@@ -50,16 +50,16 @@
object random.nat]
(<| (_.covering /._)
($_ _.and
- (_.cover [/.on-browser? /.on-node-js? /.on-nashorn?]
- (or /.on-nashorn?
- /.on-node-js?
- /.on-browser?))
- (_.cover [/.type-of]
- (and (text\= "boolean" (/.type-of boolean))
- (text\= "number" (/.type-of number))
- (text\= "string" (/.type-of string))
- (text\= "function" (/.type-of function))
- (text\= "object" (/.type-of object))))
+ (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?]
+ (or /.on_nashorn?
+ /.on_node_js?
+ /.on_browser?))
+ (_.cover [/.type_of]
+ (and (text\= "boolean" (/.type_of boolean))
+ (text\= "number" (/.type_of number))
+ (text\= "string" (/.type_of string))
+ (text\= "function" (/.type_of function))
+ (text\= "object" (/.type_of object))))
(_.cover [/.try]
(case (/.try (error! string))
(#try.Success _)
@@ -70,12 +70,12 @@
(_.cover [/.import:]
(let [encoding "utf8"]
(text\= string
- (cond /.on-nashorn?
+ (cond /.on_nashorn?
(let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))]
(|> (java/lang/String::new [binary encoding])
(:coerce Text)))
- /.on-node-js?
+ /.on_node_js?
(|> (Buffer::from [string encoding])
(Buffer::toString [encoding]))
diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux
index 0bbe19697..5f37be2ef 100644
--- a/stdlib/source/test/lux/math/number/frac.lux
+++ b/stdlib/source/test/lux/math/number/frac.lux
@@ -123,7 +123,8 @@
(#static doubleToRawLongBits [double] long)
(#static longBitsToDouble [long] double)]))]
(for {@.old (as_is <jvm>)
- @.jvm (as_is <jvm>)}))
+ @.jvm (as_is <jvm>)}
+ (as_is)))
(def: #export test
Test
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index c1972a991..e740c1237 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -1,6 +1,7 @@
(.module:
[lux #*
["_" test (#+ Test)]
+ ["." type ("#\." equivalence)]
[abstract
[monad (#+ do)]
{[0 #spec]
@@ -9,13 +10,17 @@
["$." apply]
["$." monad]]}]
[control
- ["." try]]
+ ["." try (#+ Try) ("#\." functor)]]
[data
+ ["." product]
+ ["." maybe]
["." bit ("#\." equivalence)]
+ ["." name ("#\." equivalence)]
["." text ("#\." equivalence)
["%" format (#+ format)]]
[collection
- ["." list]]]
+ ["." list ("#\." functor monoid)]
+ ["." set]]]
[meta
["." location]]
[math
@@ -161,14 +166,18 @@
version (random.ascii/upper_alpha 1)
source_code (random.ascii/upper_alpha 1)
expected_current_module (random.ascii/upper_alpha 1)
+ imported_module_name (random.filter (|>> (text\= expected_current_module) not)
+ (random.ascii/upper_alpha 1))
primitive_type (random.ascii/upper_alpha 1)
expected_seed random.nat
expected random.nat
dummy (random.filter (|>> (n.= expected) not) random.nat)
expected_short (random.ascii/upper_alpha 1)
- dummy_module (random.filter (|>> (text\= expected_current_module) not)
+ dummy_module (random.filter (function (_ module)
+ (not (or (text\= expected_current_module module)
+ (text\= imported_module_name module))))
(random.ascii/upper_alpha 1))
- #let [expected_module {#.module_hash 0
+ #let [imported_module {#.module_hash 0
#.module_aliases (list)
#.definitions (list)
#.imports (list)
@@ -176,8 +185,18 @@
#.types (list)
#.module_annotations #.None
#.module_state #.Active}
+ expected_module {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions (list)
+ #.imports (list imported_module_name)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.module_state #.Active}
expected_modules (list [expected_current_module
- expected_module])
+ expected_module]
+ [imported_module_name
+ imported_module])
expected_lux {#.info {#.target target
#.version version
#.mode #.Build}
@@ -222,6 +241,25 @@
(/.run expected_lux)
(!expect (^multi (#try.Success actual_modules)
(is? expected_modules actual_modules)))))
+ (_.cover [/.imported_modules]
+ (and (|> (/.imported_modules expected_current_module)
+ (/.run expected_lux)
+ (try\map (\ (list.equivalence text.equivalence) =
+ (list imported_module_name)))
+ (try.default false))
+ (|> (/.imported_modules imported_module_name)
+ (/.run expected_lux)
+ (try\map (\ (list.equivalence text.equivalence) =
+ (list)))
+ (try.default false))))
+ (_.cover [/.imported_by?]
+ (|> (/.imported_by? imported_module_name expected_current_module)
+ (/.run expected_lux)
+ (try.default false)))
+ (_.cover [/.imported?]
+ (|> (/.imported? imported_module_name)
+ (/.run expected_lux)
+ (try.default false)))
(_.cover [/.normalize]
(and (|> (/.normalize ["" expected_short])
(/.run expected_lux)
@@ -256,7 +294,10 @@
dummy (random.filter (|>> (n.= expected) not) random.nat)
expected_gensym (random.ascii/upper_alpha 1)
expected_location ..random_location
- #let [expected_lux {#.info {#.target target
+ #let [type_context {#.ex_counter 0
+ #.var_counter 0
+ #.var_bindings (list)}
+ expected_lux {#.info {#.target target
#.version version
#.mode #.Build}
#.source [location.dummy 0 source_code]
@@ -264,9 +305,7 @@
#.current_module (#.Some expected_current_module)
#.modules (list)
#.scopes (list)
- #.type_context {#.ex_counter 0
- #.var_counter 0
- #.var_bindings (list)}
+ #.type_context type_context
#.expected (#.Some expected_type)
#.seed expected_seed
#.scope_type_vars (list)
@@ -299,6 +338,11 @@
(/.run expected_lux)
(!expect (^multi (#try.Success actual_type)
(is? expected_type actual_type)))))
+ (_.cover [/.type_context]
+ (|> /.type_context
+ (/.run expected_lux)
+ (try\map (is? type_context))
+ (try.default false)))
)))
(def: definition_related
@@ -487,6 +531,17 @@
#.extensions []
#.host []}])))]]
($_ _.and
+ (_.cover [/.find_export]
+ (and (let [[current_globals macro_globals expected_lux]
+ (expected_lux true (#.Some expected_type))]
+ (|> (/.find_export [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (!expect (#try.Success _))))
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux false (#.Some expected_type))]
+ (|> (/.find_export [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (!expect (#try.Failure _))))))
(_.cover [/.find_macro]
(let [same_module!
(let [[current_globals macro_globals expected_lux]
@@ -521,6 +576,17 @@
not_macro!
not_found!
aliasing!)))
+ (_.cover [/.un_alias]
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux true (#.Some .Macro))]
+ (and (|> (/.un_alias [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (try\map (name\= [expected_macro_module expected_short]))
+ (try.default false))
+ (|> (/.un_alias [expected_current_module expected_short])
+ (/.run expected_lux)
+ (try\map (name\= [expected_macro_module expected_short]))
+ (try.default false)))))
(_.cover [/.find_def]
(let [[current_globals macro_globals expected_lux]
(expected_lux expected_exported? (#.Some expected_type))
@@ -578,6 +644,113 @@
alias!)))
)))
+(def: tags_related
+ Test
+ (do {! random.monad}
+ [current_module (random.ascii/upper_alpha 1)
+ tag_module (random.filter (|>> (text\= current_module) not)
+ (random.ascii/upper_alpha 1))
+
+ name_0 (random.ascii/upper_alpha 1)
+ name_1 (random.filter (|>> (text\= name_0) not)
+ (random.ascii/upper_alpha 1))
+
+ #let [random_tag (\ ! map (|>> [tag_module])
+ (random.ascii/upper_alpha 1))]
+ all_tags (|> random_tag
+ (random.set name.hash 10)
+ (\ ! map set.to_list))
+ #let [tags_0 (list.take 5 all_tags)
+ tags_1 (list.drop 5 all_tags)
+
+ type_0 (#.Primitive name_0 (list))
+ type_1 (#.Primitive name_1 (list))
+
+ entry_0 [name_0 [tags_0 false type_0]]
+ entry_1 [name_1 [tags_1 true type_1]]
+
+ expected_lux
+ (: Lux
+ {#.info {#.target ""
+ #.version ""
+ #.mode #.Build}
+ #.source [location.dummy 0 ""]
+ #.location location.dummy
+ #.current_module (#.Some current_module)
+ #.modules (list [current_module
+ {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions (list)
+ #.imports (list tag_module)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.module_state #.Active}]
+ [tag_module
+ {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions (list)
+ #.imports (list)
+ #.tags (list\compose (|> tags_0
+ list.enumeration
+ (list\map (function (_ [index [_ short]])
+ [short [index tags_0 false type_0]])))
+ (|> tags_1
+ list.enumeration
+ (list\map (function (_ [index [_ short]])
+ [short [index tags_1 true type_1]]))))
+ #.types (list entry_0 entry_1)
+ #.module_annotations #.None
+ #.module_state #.Active}])
+ #.scopes (list)
+ #.type_context {#.ex_counter 0
+ #.var_counter 0
+ #.var_bindings (list)}
+ #.expected #.None
+ #.seed 0
+ #.scope_type_vars (list)
+ #.extensions []
+ #.host []})]]
+ ($_ _.and
+ (_.cover [/.tag_lists]
+ (let [equivalence (list.equivalence
+ (product.equivalence
+ (list.equivalence name.equivalence)
+ type.equivalence))]
+ (|> (/.tag_lists tag_module)
+ (/.run expected_lux)
+ (try\map (\ equivalence = (list [tags_1 type_1])))
+ (try.default false))))
+ (_.cover [/.tags_of]
+ (|> (/.tags_of [tag_module name_1])
+ (/.run expected_lux)
+ (try\map (\ (maybe.equivalence (list.equivalence name.equivalence)) = (#.Some tags_1)))
+ (try.default false)))
+ (_.cover [/.resolve_tag]
+ (|> tags_1
+ list.enumeration
+ (list.every? (function (_ [expected_index tag])
+ (|> tag
+ /.resolve_tag
+ (/.run expected_lux)
+ (!expect (^multi (^ (#try.Success [actual_index actual_tags actual_type]))
+ (let [correct_index!
+ (n.= expected_index
+ actual_index)
+
+ correct_tags!
+ (\ (list.equivalence name.equivalence) =
+ tags_1
+ actual_tags)
+
+ correct_type!
+ (type\= type_1
+ actual_type)]
+ (and correct_index!
+ correct_tags!
+ correct_type!)))))))))
+ )))
+
(def: injection
(Injection Meta)
(\ /.monad wrap))
@@ -613,7 +786,7 @@
#let [expected_lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [location.dummy 0 source_code]
+ #.source [expected_location 0 source_code]
#.location expected_location
#.current_module (#.Some expected_current_module)
#.modules (list)
@@ -633,6 +806,26 @@
($apply.spec ..injection (..comparison expected_lux) /.apply))
(_.for [/.monad]
($monad.spec ..injection (..comparison expected_lux) /.monad))
+
+ (do random.monad
+ [expected_value random.nat
+ expected_error (random.ascii/upper_alpha 1)]
+ (_.cover [/.lift]
+ (and (|> expected_error
+ #try.Failure
+ (: (Try Nat))
+ /.lift
+ (/.run expected_lux)
+ (!expect (^multi (#try.Failure actual)
+ (text\= (location.with expected_location expected_error)
+ actual))))
+ (|> expected_value
+ #try.Success
+ (: (Try Nat))
+ /.lift
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual)
+ (is? expected_value actual)))))))
..compiler_related
..error_handling
@@ -640,6 +833,7 @@
..context_related
..definition_related
..search_related
+ ..tags_related
))
/annotation.test
diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux
index a08b54659..89a1aa3d4 100644
--- a/stdlib/source/test/lux/time/day.lux
+++ b/stdlib/source/test/lux/time/day.lux
@@ -1,6 +1,5 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
{[0 #spec]
@@ -9,25 +8,29 @@
["$." order]
["$." enum]]}]
[math
- ["r" random (#+ Random) ("#\." monad)]]]
+ ["." random (#+ Random) ("#\." monad)]]]
{1
- ["." / (#+ Day)]})
+ ["." /]})
-(def: #export day
- (Random Day)
- (r.either (r.either (r.either (r\wrap #/.Sunday)
- (r\wrap #/.Monday))
- (r.either (r\wrap #/.Tuesday)
- (r\wrap #/.Wednesday)))
- (r.either (r.either (r\wrap #/.Thursday)
- (r\wrap #/.Friday))
- (r\wrap #/.Saturday))))
+(def: #export random
+ (Random /.Day)
+ (random.either (random.either (random.either (random\wrap #/.Sunday)
+ (random\wrap #/.Monday))
+ (random.either (random\wrap #/.Tuesday)
+ (random\wrap #/.Wednesday)))
+ (random.either (random.either (random\wrap #/.Thursday)
+ (random\wrap #/.Friday))
+ (random\wrap #/.Saturday))))
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
+ (_.for [/.Day])
($_ _.and
- ($equivalence.spec /.equivalence ..day)
- ($order.spec /.order ..day)
- ($enum.spec /.enum ..day)
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+ (_.for [/.order]
+ ($order.spec /.order ..random))
+ (_.for [/.enum]
+ ($enum.spec /.enum ..random))
)))
diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux
index af9d46014..24d5449f3 100644
--- a/stdlib/source/test/lux/time/duration.lux
+++ b/stdlib/source/test/lux/time/duration.lux
@@ -1,6 +1,5 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
[monad (#+ do)]
@@ -8,43 +7,94 @@
[/
["$." equivalence]
["$." order]
+ ["$." enum]
["$." monoid]
["$." codec]]}]
+ [data
+ ["." bit ("#\." equivalence)]]
[math
["." random (#+ Random)]
[number
["n" nat]
["i" int]]]]
{1
- ["." / (#+ Duration)]})
-
-(def: #export duration
- (Random Duration)
- (\ random.monad map /.from_millis random.int))
+ ["." /]})
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
+ (_.for [/.Duration])
($_ _.and
- ($equivalence.spec /.equivalence ..duration)
- ($order.spec /.order ..duration)
- ($monoid.spec /.equivalence /.monoid ..duration)
- ($codec.spec /.equivalence /.codec ..duration)
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence random.duration))
+ (_.for [/.order]
+ ($order.spec /.order random.duration))
+ (_.for [/.enum]
+ ($enum.spec /.enum random.duration))
+ (_.for [/.monoid]
+ ($monoid.spec /.equivalence /.monoid random.duration))
+ (_.for [/.codec]
+ ($codec.spec /.equivalence /.codec random.duration))
(do random.monad
- [millis random.int]
- (_.test "Can convert from/to milliseconds."
- (|> millis /.from_millis /.to_millis (i.= millis))))
- (do {! random.monad}
- [sample (|> duration (\ ! map (/.frame /.day)))
- frame duration
- factor (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
- #let [(^open "/\.") /.order]]
+ [duration random.duration]
+ (_.cover [/.from_millis /.to_millis]
+ (|> duration /.to_millis /.from_millis (\ /.equivalence = duration))))
+ (do random.monad
+ [#let [(^open "\.") /.equivalence]
+ expected random.duration
+ parameter random.duration]
($_ _.and
- (_.test "Can scale a duration."
- (|> sample (/.up factor) (/.query sample) (i.= (.int factor))))
- (_.test "Scaling a duration by one does not change it."
- (|> sample (/.up 1) (/\= sample)))
- (_.test "Merging a duration with it's opposite yields an empty duration."
- (|> sample (/.merge (/.inverse sample)) (/\= /.empty)))))
+ (_.cover [/.merge /.difference]
+ (|> expected (/.merge parameter) (/.difference parameter) (\= expected)))
+ (_.cover [/.empty]
+ (|> expected (/.merge /.empty) (\= expected)))
+ (_.cover [/.inverse]
+ (and (|> expected /.inverse /.inverse (\= expected))
+ (|> expected (/.merge (/.inverse expected)) (\= /.empty))))
+ (_.cover [/.positive? /.negative? /.neutral?]
+ (or (bit\= (/.positive? expected)
+ (/.negative? (/.inverse expected)))
+ (bit\= (/.neutral? expected)
+ (/.neutral? (/.inverse expected)))))
+ ))
+ (do random.monad
+ [#let [(^open "\.") /.equivalence]
+ factor random.nat]
+ (_.cover [/.up /.down]
+ (|> /.milli_second (/.up factor) (/.down factor) (\= /.milli_second))))
+ (do {! random.monad}
+ [#let [(^open "\.") /.order
+ positive (|> random.duration
+ (random.filter (|>> (\= /.empty) not))
+ (\ ! map (function (_ duration)
+ (if (/.positive? duration)
+ duration
+ (/.inverse duration)))))]
+ sample positive
+ frame positive]
+ (`` ($_ _.and
+ (_.cover [/.frame]
+ (let [sample' (/.frame frame sample)]
+ (and (\< frame sample')
+ (bit\= (\< frame sample)
+ (\= sample sample')))))
+ (_.cover [/.query]
+ (i.= +1 (/.query sample sample)))
+ (_.cover [/.milli_second]
+ (\= /.empty (\ /.enum pred /.milli_second)))
+ (~~ (template [<factor> <big> <small>]
+ [(_.cover [<big>]
+ (|> <big> (/.query <small>) (i.= <factor>)))]
+
+ [+1,000 /.second /.milli_second]
+ [+60 /.minute /.second]
+ [+60 /.hour /.minute]
+ [+24 /.day /.hour]
+
+ [+7 /.week /.day]
+ [+365 /.normal_year /.day]
+ [+366 /.leap_year /.day]
+ ))
+ )))
)))
diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux
index 65fed1248..9ed1df446 100644
--- a/stdlib/source/test/lux/time/instant.lux
+++ b/stdlib/source/test/lux/time/instant.lux
@@ -21,8 +21,6 @@
[time
["@d" duration]
["@." date]]]
- [//
- ["_." duration]]
{1
["." / (#+ Instant)]})
@@ -45,7 +43,7 @@
(|> millis /.from_millis /.to_millis (i.= millis))))
(do random.monad
[sample instant
- span _duration.duration
+ span random.duration
#let [(^open "@/.") /.equivalence
(^open "@d/.") @d.equivalence]]
($_ _.and