diff options
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/lux/locale.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/code.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/io/context.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex.lux | 48 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/cli.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/local.lux | 86 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/parser.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/pom.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/project.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/program/compositor/cli.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/program/compositor/export.lux | 56 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/frp.lux | 43 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/promise.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/function/memo.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/parser/binary.lux | 43 | ||||
| -rw-r--r-- | stdlib/source/test/lux/locale.lux | 77 |
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 + ))) |