aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/locale.lux3
-rw-r--r--stdlib/source/lux/macro/code.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux32
-rw-r--r--stdlib/source/program/aedifex.lux48
-rw-r--r--stdlib/source/program/aedifex/cli.lux16
-rw-r--r--stdlib/source/program/aedifex/local.lux86
-rw-r--r--stdlib/source/program/aedifex/parser.lux7
-rw-r--r--stdlib/source/program/aedifex/pom.lux3
-rw-r--r--stdlib/source/program/aedifex/project.lux14
-rw-r--r--stdlib/source/program/compositor/cli.lux11
-rw-r--r--stdlib/source/program/compositor/export.lux56
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux43
-rw-r--r--stdlib/source/test/lux/control/concurrency/promise.lux16
-rw-r--r--stdlib/source/test/lux/control/function/memo.lux2
-rw-r--r--stdlib/source/test/lux/control/parser/binary.lux43
-rw-r--r--stdlib/source/test/lux/locale.lux77
16 files changed, 348 insertions, 113 deletions
diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux
index 0fe688e43..5205c2f85 100644
--- a/stdlib/source/lux/locale.lux
+++ b/stdlib/source/lux/locale.lux
@@ -44,7 +44,8 @@
(structure: #export hash
(Hash Locale)
- (def: &equivalence ..equivalence)
+ (def: &equivalence
+ ..equivalence)
(def: hash
(|>> :representation
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index 8b868db58..f91b0e51a 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -58,7 +58,9 @@
[local-identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."]
[local-tag #.Tag "Produces a local tag (a tag with no module prefix)."])
-(structure: #export equivalence (Equivalence Code)
+(structure: #export equivalence
+ (Equivalence Code)
+
(def: (= x y)
(case [x y]
(^template [<tag> <eq>]
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index 1dceaaba6..7d6a56b63 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -155,26 +155,23 @@
(#.Some [_ path])
(#try.Success path))))
-(def: (enumerate-context system partial-host-extension context enumeration)
- (-> (file.System Promise) Extension Context Enumeration
- (Promise (Try Enumeration)))
+(def: (enumerate-context system context enumeration)
+ (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration)))
(do {@ (try.with promise.monad)}
[directory (!.use (:: system directory) [context])]
(loop [directory directory
enumeration enumeration]
(do @
[files (!.use (:: directory files) [])
- enumeration (monad.fold @ (let [full-host-extension (..full-host-extension partial-host-extension)]
- (function (_ file enumeration)
- (let [path (!.use (:: file path) [])]
- (if (or (text.ends-with? full-host-extension path)
- (text.ends-with? ..lux-extension path))
- (do @
- [path (promise@wrap (..clean-path system context path))
- source-code (!.use (:: file content) [])]
- (promise@wrap
- (dictionary.try-put path source-code enumeration)))
- (wrap enumeration)))))
+ enumeration (monad.fold @ (function (_ file enumeration)
+ (let [path (!.use (:: file path) [])]
+ (if (text.ends-with? ..lux-extension path)
+ (do @
+ [path (promise@wrap (..clean-path system context path))
+ source-code (!.use (:: file content) [])]
+ (promise@wrap
+ (dictionary.try-put path source-code enumeration)))
+ (wrap enumeration))))
enumeration
files)
directories (!.use (:: directory directories) [])]
@@ -183,12 +180,11 @@
(def: Action
(type (All [a] (Promise (Try a)))))
-(def: #export (enumerate system partial-host-extension contexts)
- (-> (file.System Promise) Extension (List Context)
- (Action Enumeration))
+(def: #export (enumerate system contexts)
+ (-> (file.System Promise) (List Context) (Action Enumeration))
(monad.fold (: (Monad Action)
(try.with promise.monad))
- (enumerate-context system partial-host-extension)
+ (enumerate-context system)
(: Enumeration
(dictionary.new text.hash))
contexts))
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index fd269f71f..6909704dd 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -10,7 +10,9 @@
["." cli (#+ program:)]
["<c>" code]]
[security
- ["!" capability]]]
+ ["!" capability]]
+ [concurrency
+ ["." promise]]]
[data
[binary (#+ Binary)]
["." text
@@ -28,7 +30,9 @@
["." / #_
["#" project]
["#." parser]
- ["#." pom]])
+ ["#." pom]
+ ["#." cli]
+ ["#." local]])
(def: (read-file! path)
(-> Path (IO (Try Binary)))
@@ -67,22 +71,36 @@
[..read-code]
[(list) (<c>.run /parser.project)])))
-(program: [project-file]
+(program: [{command /cli.command}]
(do {@ io.monad}
- [data (..read-file! project-file)]
+ [data (..read-file! /.file)]
(case data
(#try.Success data)
(case (..project data)
- (#try.Success value)
- (do @
- [outcome (..write-pom! /pom.file value)]
- (case outcome
- (#try.Success value)
- (wrap (log! "Successfully wrote POM file!"))
-
- (#try.Failure error)
- (wrap (log! (format "Could not write POM file:" text.new-line
- error)))))
+ (#try.Success project)
+ (case command
+ #/cli.POM
+ (do @
+ [outcome (..write-pom! /pom.file project)]
+ (case outcome
+ (#try.Success value)
+ (wrap (log! "Successfully wrote POM file!"))
+
+ (#try.Failure error)
+ (wrap (log! (format "Could not write POM file:" text.new-line
+ error)))))
+
+ #/cli.Install
+ (exec (do promise.monad
+ [outcome (/local.install (file.async file.system) project)]
+ (wrap (case outcome
+ (#try.Success _)
+ (log! "Successfully installed locally!")
+
+ (#try.Failure error)
+ (log! (format "Could not install locally:" text.new-line
+ error)))))
+ (wrap [])))
(#try.Failure error)
(wrap (log! (format "Invalid format file:" text.new-line
@@ -90,4 +108,4 @@
(#try.Failure error)
(wrap (log! (format "Could not read file: "
- (%.text project-file)))))))
+ (%.text /.file)))))))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
new file mode 100644
index 000000000..5f75cac9b
--- /dev/null
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -0,0 +1,16 @@
+(.module:
+ [lux #*
+ [control
+ ["<>" parser
+ ["." cli (#+ Parser)]]]])
+
+(type: #export Command
+ #POM
+ #Install)
+
+(def: #export command
+ (Parser Command)
+ ($_ <>.or
+ (cli.this "pom")
+ (cli.this "install")
+ ))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
new file mode 100644
index 000000000..15d9a9323
--- /dev/null
+++ b/stdlib/source/program/aedifex/local.lux
@@ -0,0 +1,86 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." io (#+ IO)]
+ ["." try (#+ Try)]
+ [concurrency
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
+ [data
+ [binary (#+ Binary)]
+ ["." text
+ ["%" format (#+ format)]
+ ["." encoding]]
+ [collection
+ ["." list ("#@." monoid)]]
+ [format
+ ["." binary]
+ ["." tar]
+ ["." xml]]]
+ [world
+ ["." file (#+ Path File Directory)]]]
+ [program
+ [compositor
+ ["." export]]]
+ ["." // #_
+ ["#." project (#+ Project)]
+ ["#." pom]
+ ["#." dependency]])
+
+(def: group-separator
+ ".")
+
+(def: (local system)
+ (All [a] (-> (file.System a) Path))
+ (format "~" (:: system separator) ".m2"))
+
+(def: (repository system)
+ (All [a] (-> (file.System a) Path))
+ (format (..local system) (:: system separator) "repository"))
+
+(def: (guarantee-repository! system project)
+ (-> (file.System Promise) Project (Promise (Try Path)))
+ (do {@ (try.with promise.monad)}
+ [_ (: (Promise (Try (Directory Promise)))
+ (file.get-directory promise.monad system (..local system)))
+ #let [root (..repository system)
+ identity (get@ #//project.identity project)]
+ _ (: (Promise (Try (Directory Promise)))
+ (file.get-directory promise.monad system root))]
+ (monad.fold @
+ (function (_ child parent)
+ (do @
+ [#let [path (format parent (:: system separator) child)]
+ _ (: (Promise (Try (Directory Promise)))
+ (file.get-directory promise.monad system path))]
+ (wrap path)))
+ root
+ (list@compose (|> identity
+ (get@ #//project.group)
+ (text.split-all-with ..group-separator))
+ (list (get@ #//project.name identity)
+ (get@ #//project.version identity))))))
+
+(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])))
+
+(def: #export (install system project)
+ (-> (file.System Promise) Project (Promise (Try Any)))
+ (do (try.with promise.monad)
+ [repository (..guarantee-repository! system project)
+ #let [identity (get@ #//project.identity project)
+ artifact-name (format repository
+ (:: system separator) (get@ #//project.name identity)
+ "-" (get@ #//project.version identity))]
+ package (export.library system (get@ #//project.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 //pom.extension))))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index f3bdbe34f..1a4b2f638 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -121,6 +121,10 @@
(<>.default //dependency.lux-library ..type)
)))
+(def: source
+ (Parser /.Source)
+ <c>.text)
+
(def: #export project
(Parser /.Project)
(<| <c>.form
@@ -137,4 +141,7 @@
(<| (<>.default (list))
(..bundle (' #dependencies))
..dependency)
+ (<| (<>.default (list "source"))
+ (..bundle (' #sources))
+ ..source)
))))
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index d19ec5902..102728e1e 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -16,6 +16,9 @@
(def: #export file
"pom.xml")
+(def: #export extension
+ ".pom")
+
(def: version
XML
(#_.Node ["" "modelVersion"] _.attrs
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index a0891951f..9f98ebc51 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,10 +1,14 @@
(.module:
- [lux (#- Name Info)
+ [lux (#- Name Info Source)
[world
- [net (#+ URL)]]]
+ [net (#+ URL)]
+ [file (#+ Path)]]]
[//
["." dependency]])
+(def: #export file
+ "project.lux")
+
(type: #export Group
Text)
@@ -61,8 +65,12 @@
(type: #export Dependency
[Artifact dependency.Type])
+(type: #export Source
+ Path)
+
(type: #export Project
{#identity Artifact
#info Info
#repositories (List Repository)
- #dependencies (List Dependency)})
+ #dependencies (List Dependency)
+ #sources (List Source)})
diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux
index 03235bbad..4c4384636 100644
--- a/stdlib/source/program/compositor/cli.lux
+++ b/stdlib/source/program/compositor/cli.lux
@@ -12,9 +12,14 @@
[world
[file (#+ Path)]]])
-(type: #export Source Path)
-(type: #export Library Path)
-(type: #export Target Path)
+(type: #export Source
+ Path)
+
+(type: #export Library
+ Path)
+
+(type: #export Target
+ Path)
(type: #export Compilation
[(List Source) (List Library) Target Module])
diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux
index f6a78ed78..468b1ef9d 100644
--- a/stdlib/source/program/compositor/export.lux
+++ b/stdlib/source/program/compositor/export.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- Source)
[abstract
["." monad (#+ do)]]
[control
@@ -27,7 +27,10 @@
[world
["." file]]]
[//
- [cli (#+ Export)]])
+ [cli (#+ Source Export)]])
+
+(def: file
+ "library.tar")
(def: no-ownership
tar.Ownership
@@ -37,26 +40,31 @@
{#tar.user commons
#tar.group commons}))
-(def: #export (export system extension [sources target])
- (-> (file.System Promise) Extension Export (Promise (Try Any)))
- (let [package (format target (:: system separator) "library.tar")]
+(def: #export (library system sources)
+ (-> (file.System Promise) (List Source) (Promise (Try tar.Tar)))
+ (do (try.with promise.monad)
+ [files (io.enumerate system sources)]
+ (|> (dictionary.entries files)
+ (monad.map try.monad
+ (function (_ [path source-code])
+ (do try.monad
+ [path (|> path
+ (text.replace-all (:: system separator) .module-separator)
+ tar.path)
+ source-code (tar.content source-code)]
+ (wrap (#tar.Normal [path
+ (instant.from-millis +0)
+ tar.none
+ ..no-ownership
+ source-code])))))
+ (:: try.monad map row.from-list)
+ (:: promise.monad wrap))))
+
+(def: #export (export system [sources target])
+ (-> (file.System Promise) Export (Promise (Try Any)))
+ (let [package (format target (:: system separator) ..file)]
(do (try.with promise.monad)
- [package (: (Promise (Try (file.File Promise)))
- (file.get-file promise.monad system package))
- files (io.enumerate system extension sources)
- tar (|> (dictionary.entries files)
- (monad.map try.monad
- (function (_ [path source-code])
- (do try.monad
- [path (|> path
- (text.replace-all (:: system separator) .module-separator)
- tar.path)
- source-code (tar.content source-code)]
- (wrap (#tar.Normal [path
- (instant.from-millis +0)
- tar.none
- ..no-ownership
- source-code])))))
- (:: try.monad map (|>> row.from-list (binary.run tar.writer)))
- promise@wrap)]
- (!.use (:: package over-write) tar))))
+ [tar (..library system sources)
+ package (: (Promise (Try (file.File Promise)))
+ (file.get-file promise.monad system package))]
+ (!.use (:: package over-write) (binary.run tar.writer tar)))))
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 70aae523e..fe082cda7 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -168,27 +168,28 @@
(_.claim [/.distinct]
(list@= (list distint/0 distint/1 distint/2)
actual))))
- (wrap (do promise.monad
- [#let [polling-delay 20
- amount-of-polls 5
- total-delay (n.* amount-of-polls polling-delay)
- [channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))]
- _ (promise.schedule total-delay (io.io []))
- _ (promise.future (:: sink close))
- actual (/.consume channel)]
- (_.claim [/.poll]
- (and (list.every? (n.= sample) actual)
- (n.>= amount-of-polls (list.size actual))))))
- (wrap (do promise.monad
- [#let [polling-delay 20
- amount-of-polls 5
- total-delay (n.* amount-of-polls polling-delay)
- [channel sink] (/.periodic polling-delay)]
- _ (promise.schedule total-delay (io.io []))
- _ (promise.future (:: sink close))
- actual (/.consume channel)]
- (_.claim [/.periodic]
- (n.>= amount-of-polls (list.size actual)))))
+ (let [polling-delay 10
+ wiggle-room (n.* 2 polling-delay)
+ amount-of-polls 5
+ total-delay (|> polling-delay
+ (n.* amount-of-polls)
+ (n.+ wiggle-room))]
+ ($_ _.and
+ (wrap (do promise.monad
+ [#let [[channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))]
+ _ (promise.schedule total-delay (io.io []))
+ _ (promise.future (:: sink close))
+ actual (/.consume channel)]
+ (_.claim [/.poll]
+ (and (list.every? (n.= sample) actual)
+ (n.>= amount-of-polls (list.size actual))))))
+ (wrap (do promise.monad
+ [#let [[channel sink] (/.periodic polling-delay)]
+ _ (promise.schedule total-delay (io.io []))
+ _ (promise.future (:: sink close))
+ actual (/.consume channel)]
+ (_.claim [/.periodic]
+ (n.>= amount-of-polls (list.size actual)))))))
(wrap (do promise.monad
[#let [max-iterations 10]
actual (|> [0 sample]
diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux
index 2495223b5..1c8933499 100644
--- a/stdlib/source/test/lux/control/concurrency/promise.lux
+++ b/stdlib/source/test/lux/control/concurrency/promise.lux
@@ -109,10 +109,10 @@
(i.>= (.int to-wait)
(duration.to-millis (instant.span pre post)))))))
(wrap (do /.monad
- [?left (/.or (/.delay 10 leftE)
- (/.delay 20 dummy))
- ?right (/.or (/.delay 20 dummy)
- (/.delay 10 rightE))]
+ [?left (/.or (/.delay 100 leftE)
+ (/.delay 200 dummy))
+ ?right (/.or (/.delay 200 dummy)
+ (/.delay 100 rightE))]
(_.claim [/.or]
(case [?left ?right]
[(#.Left leftA) (#.Right rightA)]
@@ -122,10 +122,10 @@
_
false))))
(wrap (do /.monad
- [leftA (/.either (/.delay 10 leftE)
- (/.delay 20 dummy))
- rightA (/.either (/.delay 20 dummy)
- (/.delay 10 rightE))]
+ [leftA (/.either (/.delay 100 leftE)
+ (/.delay 200 dummy))
+ rightA (/.either (/.delay 200 dummy)
+ (/.delay 100 rightE))]
(_.claim [/.either]
(n.= (n.+ leftE rightE)
(n.+ leftA rightA)))))
diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux
index a00b8bc58..d09625d79 100644
--- a/stdlib/source/test/lux/control/function/memo.lux
+++ b/stdlib/source/test/lux/control/function/memo.lux
@@ -50,7 +50,7 @@
Test
(<| (_.covering /._)
(do {@ random.monad}
- [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20))))])
+ [input (|> random.nat (:: @ map (|>> (n.% 5) (n.+ 21))))])
(_.with-cover [/.Memo])
($_ _.and
(_.cover [/.closed /.none]
diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux
index d646852f3..8bc24976e 100644
--- a/stdlib/source/test/lux/control/parser/binary.lux
+++ b/stdlib/source/test/lux/control/parser/binary.lux
@@ -3,8 +3,10 @@
["_" test (#+ Test)]
[abstract
[equivalence (#+ Equivalence)]
+ [predicate (#+ Predicate)]
[monad (#+ do)]]
[control
+ [pipe (#+ case>)]
["." try]
["." exception]
["<>" parser]]
@@ -15,7 +17,8 @@
["." bit]
["." name]
["." text ("#@." equivalence)
- ["." encoding]]
+ ["." encoding]
+ ["%" format (#+ format)]]
["." format #_
["#" binary]]
[number
@@ -46,10 +49,25 @@
(def: segment-size 10)
+(def: (utf8-conversion-does-not-alter? value)
+ (Predicate Text)
+ (|> value
+ encoding.to-utf8
+ encoding.from-utf8
+ (case> (#try.Success converted)
+ (text@= value converted)
+
+ (#try.Failure error)
+ false)))
+
+(def: random-text
+ (Random Text)
+ (random.filter ..utf8-conversion-does-not-alter?
+ (random.unicode ..segment-size)))
+
(def: random-name
(Random Name)
- (random.and (random.unicode ..segment-size)
- (random.unicode ..segment-size)))
+ (random.and ..random-text ..random-text))
(structure: cursor-equivalence
(Equivalence Cursor)
@@ -63,7 +81,7 @@
(def: random-cursor
(Random Cursor)
($_ random.and
- (random.unicode ..segment-size)
+ ..random-text
random.nat
random.nat))
@@ -83,7 +101,7 @@
random.int
random.rev
random.frac
- (random.unicode ..segment-size)
+ ..random-text
..random-name
..random-name
random-sequence
@@ -186,7 +204,8 @@
[(do {@ random.monad}
[expected <random>]
(_.cover [<parser>]
- (|> (format.run <format> expected)
+ (|> expected
+ (format.run <format>)
(/.run <parser>)
(!expect (^multi (#try.Success actual)
(:: <equivalence> = expected actual))))))]
@@ -195,8 +214,7 @@
[/.nat format.nat random.nat n.equivalence]
[/.int format.int random.int int.equivalence]
[/.rev format.rev random.rev rev.equivalence]
- [/.frac format.frac random.frac frac.equivalence]
- ))
+ [/.frac format.frac random.frac frac.equivalence]))
(do {@ random.monad}
[expected (:: @ map (|>> (i64.and (i64.mask /.size/8))
(n.max 2))
@@ -216,7 +234,8 @@
[(do {@ random.monad}
[expected <random>]
(_.cover [<parser>]
- (|> (format.run <format> expected)
+ (|> expected
+ (format.run <format>)
(/.run <parser>)
(!expect (^multi (#try.Success actual)
(:: <equivalence> = expected actual))))))]
@@ -229,7 +248,8 @@
[(do {@ random.monad}
[expected <random>]
(_.cover [<cover>]
- (|> (format.run <format> expected)
+ (|> expected
+ (format.run <format>)
(/.run <parser>)
(!expect (^multi (#try.Success actual)
(:: <equivalence> = expected actual))))))]
@@ -237,8 +257,7 @@
[/.maybe (/.maybe /.nat) (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)]
[/.list (/.list /.nat) (format.list format.nat) (random.list ..segment-size random.nat) (list.equivalence n.equivalence)]
[/.set (/.set n.hash /.nat) (format.set format.nat) (random.set n.hash ..segment-size random.nat) set.equivalence]
- [/.name /.name format.name ..random-name name.equivalence]
- ))
+ [/.name /.name format.name ..random-name name.equivalence]))
(do {@ random.monad}
[expected (:: @ map (list.repeat ..segment-size) random.nat)]
(_.cover [/.set-elements-are-not-unique]
diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux
index 0e6f0ea01..37a629596 100644
--- a/stdlib/source/test/lux/locale.lux
+++ b/stdlib/source/test/lux/locale.lux
@@ -1,13 +1,78 @@
(.module:
[lux #*
- ["_" test (#+ Test)]]
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [math
+ ["." random (#+ Random) ("#@." monad)]]
+ [data
+ ["." text ("#@." equivalence)
+ ["." encoding (#+ Encoding)]]
+ [collection
+ ["." list]]]]
["." / #_
["#." language]
- ["#." territory]])
+ ["#." territory]]
+ {1
+ ["." /
+ ["." language (#+ Language)]
+ ["." territory (#+ Territory)]]})
+
+(def: random-language
+ (Random Language)
+ (random.either (random@wrap language.afar)
+ (random@wrap language.zaza)))
+
+(def: random-territory
+ (Random Territory)
+ (random.either (random@wrap territory.afghanistan)
+ (random@wrap territory.zimbabwe)))
+
+(def: random-encoding
+ (Random Encoding)
+ (random.either (random@wrap encoding.ascii)
+ (random@wrap encoding.koi8-u)))
+
+(def: random-locale
+ (Random /.Locale)
+ (do random.monad
+ [language ..random-language
+ territory ..random-territory
+ encoding ..random-encoding]
+ (wrap (/.locale language (#.Some territory) (#.Some encoding)))))
(def: #export test
Test
- ($_ _.and
- /language.test
- /territory.test
- ))
+ (<| (_.covering /._)
+ (_.with-cover [/.Locale])
+ ($_ _.and
+ (_.with-cover [/.equivalence]
+ ($equivalence.spec /.equivalence ..random-locale))
+
+ (do random.monad
+ [language ..random-language
+ territory ..random-territory
+ encoding ..random-encoding
+ #let [l-locale (/.locale language #.None #.None)
+ lt-locale (/.locale language (#.Some territory) #.None)
+ le-locale (/.locale language #.None (#.Some encoding))
+ lte-locale (/.locale language (#.Some territory) (#.Some encoding))]
+ #let [language-check (and (text@= (language.code language)
+ (/.code l-locale))
+ (list.every? (|>> /.code (text.starts-with? (language.code language)))
+ (list lt-locale le-locale lte-locale)))
+ territory-check (list.every? (|>> /.code (text.contains? (territory.long-code territory)))
+ (list lt-locale lte-locale))
+ encoding-check (list.every? (|>> /.code (text.ends-with? (encoding.name encoding)))
+ (list le-locale lte-locale))]]
+ (_.cover [/.locale /.code]
+ (and language-check
+ territory-check
+ encoding-check)))
+
+ /language.test
+ /territory.test
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 09:52:08 +0000