From ddcc768d9d2e798814989037a286df9951840bcd Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 12 Aug 2020 01:01:30 -0400
Subject: WIP: New build-tool named Aedifex (can read project descriptions).
---
stdlib/source/lux/control/pipe.lux | 2 +-
stdlib/source/lux/data/format/xml.lux | 14 +-
stdlib/source/lux/data/maybe.lux | 9 +
stdlib/source/lux/locale/language.lux | 1037 ++++++++++----------
stdlib/source/lux/test.lux | 16 +-
stdlib/source/program/aedifex.lux | 93 ++
stdlib/source/program/aedifex/dependency.lux | 14 +
stdlib/source/program/aedifex/parser.lux | 140 +++
stdlib/source/program/aedifex/project.lux | 68 ++
stdlib/source/test/lux/control/exception.lux | 163 +--
stdlib/source/test/lux/control/function.lux | 45 +-
stdlib/source/test/lux/control/io.lux | 37 +-
stdlib/source/test/lux/control/parser.lux | 431 ++++----
stdlib/source/test/lux/control/pipe.lux | 177 ++--
stdlib/source/test/lux/control/reader.lux | 55 +-
stdlib/source/test/lux/control/region.lux | 211 ++--
stdlib/source/test/lux/control/security/policy.lux | 36 +-
stdlib/source/test/lux/locale/language.lux | 266 +++++
stdlib/source/test/lux/target/jvm.lux | 22 +-
19 files changed, 1748 insertions(+), 1088 deletions(-)
create mode 100644 stdlib/source/program/aedifex.lux
create mode 100644 stdlib/source/program/aedifex/dependency.lux
create mode 100644 stdlib/source/program/aedifex/parser.lux
create mode 100644 stdlib/source/program/aedifex/project.lux
create mode 100644 stdlib/source/test/lux/locale/language.lux
(limited to 'stdlib/source')
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index 691d5568b..23440ca83 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -104,7 +104,7 @@
[step (list.reverse prev-steps)]
(list g!temp (` (|> (~ g!temp) (~+ step)))))]
(wrap (list (` ((~! do) (~ monad)
- [(~ g!temp) (~ prev)
+ [(~' #let) [(~ g!temp) (~ prev)]
(~+ step-bindings)]
(|> (~ g!temp) (~+ last-step)))))))
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index 0e7cfb7bf..83a3209d4 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -19,16 +19,22 @@
["." list ("#@." functor)]
["." dictionary (#+ Dictionary)]]]])
-(type: #export Tag Name)
-(type: #export Attrs (Dictionary Name Text))
+(type: #export Tag
+ Name)
-(def: #export attrs Attrs (dictionary.new name.hash))
+(type: #export Attrs
+ (Dictionary Name Text))
+
+(def: #export attrs
+ Attrs
+ (dictionary.new name.hash))
(type: #export #rec XML
(#Text Text)
(#Node Tag Attrs (List XML)))
-(def: namespace-separator ":")
+(def: namespace-separator
+ ":")
(def: xml-standard-escape-char^
(Parser Text)
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index 2bde551e7..2afd4cb60 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -138,3 +138,12 @@
(def: #export assume
(All [a] (-> (Maybe a) a))
(|>> (..default (undefined))))
+
+(def: #export (to-list value)
+ (All [a] (-> (Maybe a) (List a)))
+ (case value
+ #.None
+ #.Nil
+
+ (#.Some value)
+ (#.Cons value #.Nil)))
diff --git a/stdlib/source/lux/locale/language.lux b/stdlib/source/lux/locale/language.lux
index 75b4c53a8..8aeeb1c51 100644
--- a/stdlib/source/lux/locale/language.lux
+++ b/stdlib/source/lux/locale/language.lux
@@ -12,516 +12,557 @@
## https://en.wikipedia.org/wiki/List_of_ISO_639-2_codes
(abstract: #export Language
- Text
+ {#name Text
+ #code Text}
- (def: #export code
- (-> Language Text)
- (|>> :representation))
+ (template [<name> <tag>]
+ [(def: #export <name>
+ (-> Language Text)
+ (|>> :representation (get@ <tag>)))]
- (template [<code> <name> <alias>+]
- [(def: #export <name> Language (:abstraction <code>))
+ [name #name]
+ [code #code]
+ )
+
+ (template [<code> <name> <definition> <alias>+]
+ [(def: #export <definition>
+ Language
+ (:abstraction {#name <name>
+ #code <code>}))
(`` (template [<alias>]
- [(def: #export <alias> Language <name>)]
+ [(def: #export <alias>
+ Language
+ <definition>)]
(~~ (template.splice <alias>+))))]
- ["mis" uncoded []]
- ["mul" multiple []]
- ["und" undetermined []]
- ["zxx" not-applicable []]
-
- ["aar" afar []]
- ["abk" abkhazian []]
- ["ace" achinese []]
- ["ach" acoli []]
- ["ada" adangme []]
- ["ady" adyghe []]
- ["afa" afro-asiatic []]
- ["afh" afrihili []]
- ["afr" afrikaans []]
- ["ain" ainu []]
- ["aka" akan []]
- ["akk" akkadian []]
- ["ale" aleut []]
- ["alg" algonquian []]
- ["alt" southern-altai []]
- ["amh" amharic []]
- ["ang" old-english []]
- ["anp" angika []]
- ["apa" apache []]
- ["ara" arabic []]
- ["arc" official-aramaic []]
- ["arg" aragonese []]
- ["arn" mapudungun []]
- ["arp" arapaho []]
- ["art" artificial []]
- ["arw" arawak []]
- ["asm" assamese []]
- ["ast" asturian [[bable] [leonese] [asturleonese]]]
- ["ath" athapascan []]
- ["aus" australian []]
- ["ava" avaric []]
- ["ave" avestan []]
- ["awa" awadhi []]
- ["aym" aymara []]
- ["aze" azerbaijani []]
- ["bad" banda []]
- ["bai" bamileke []]
- ["bak" bashkir []]
- ["bal" baluchi []]
- ["bam" bambara []]
- ["ban" balinese []]
- ["bas" basa []]
- ["bat" baltic []]
- ["bej" beja []]
- ["bel" belarusian []]
- ["bem" bemba []]
- ["ben" bengali []]
- ["ber" berber []]
- ["bho" bhojpuri []]
- ["bih" bihari []]
- ["bik" bikol []]
- ["bin" edo []]
- ["bis" bislama []]
- ["bla" siksika []]
- ["bnt" bantu []]
- ["bod" tibetan []]
- ["bos" bosnian []]
- ["bra" braj []]
- ["bre" breton []]
- ["btk" batak []]
- ["bua" buriat []]
- ["bug" buginese []]
- ["bul" bulgarian []]
- ["byn" blin []]
- ["cad" caddo []]
- ["cai" central-american-indian []]
- ["car" galibi-carib []]
- ["cat" catalan [[valencian]]]
- ["cau" caucasian []]
- ["ceb" cebuano []]
- ["cel" celtic []]
- ["ces" czech []]
- ["cha" chamorro []]
- ["chb" chibcha []]
- ["che" chechen []]
- ["chg" chagatai []]
- ["chk" chuukese []]
- ["chm" mari []]
- ["chn" chinook []]
- ["cho" choctaw []]
- ["chp" chipewyan []]
- ["chr" cherokee []]
- ["chu" church-slavic [[old-slavonic] [church-slavonic] [old-bulgarian] [old-church-slavonic]]]
- ["chv" chuvash []]
- ["chy" cheyenne []]
- ["cmc" chamic []]
- ["cnr" montenegrin []]
- ["cop" coptic []]
- ["cor" cornish []]
- ["cos" corsican []]
- ["cpe" creoles-and-pidgins/english []]
- ["cpf" creoles-and-pidgins/french []]
- ["cpp" creoles-and-pidgins/portuguese []]
- ["cre" cree []]
- ["crh" crimean []]
- ["crp" creoles-and-pidgins []]
- ["csb" kashubian []]
- ["cus" cushitic []]
- ["cym" welsh []]
- ["dak" dakota []]
- ["dan" danish []]
- ["dar" dargwa []]
- ["day" land-dayak []]
- ["del" delaware []]
- ["den" slavey []]
- ["dgr" dogrib []]
- ["din" dinka []]
- ["div" dhivehi [[maldivian]]]
- ["doi" dogri []]
- ["dra" dravidian []]
- ["dsb" lower-sorbian []]
- ["dua" duala []]
- ["dum" middle-dutch []]
- ["dyu" dyula []]
- ["dzo" dzongkha []]
- ["efi" efik []]
- ["egy" egyptian []]
- ["eka" ekajuk []]
- ["ell" greek []]
- ["elx" elamite []]
- ["eng" english []]
- ["enm" middle-english []]
- ["epo" esperanto []]
- ["est" estonian []]
- ["eus" basque []]
- ["ewe" ewe []]
- ["ewo" ewondo []]
- ["fan" fang []]
- ["fao" faroese []]
- ["fas" persian []]
- ["fat" fanti []]
- ["fij" fijian []]
- ["fil" filipino []]
- ["fin" finnish []]
- ["fiu" finno-ugrian []]
- ["fon" fon []]
- ["fra" french []]
- ["frm" middle-french []]
- ["fro" old-french []]
- ["frr" northern-frisian []]
- ["frs" eastern-frisian []]
- ["fry" western-frisian []]
- ["ful" fulah []]
- ["fur" friulian []]
- ["gaa" ga []]
- ["gay" gayo []]
- ["gba" gbaya []]
- ["gem" germanic []]
- ["deu" german []]
- ["gez" geez []]
- ["gil" gilbertese []]
- ["gla" gaelic []]
- ["gle" irish []]
- ["glg" galician []]
- ["glv" manx []]
- ["gmh" middle-high-german []]
- ["goh" old-high-german []]
- ["gon" gondi []]
- ["gor" gorontalo []]
- ["got" gothic []]
- ["grb" grebo []]
- ["grc" ancient-greek []]
- ["grn" guarani []]
- ["gsw" swiss-german [[alemannic] [alsatian]]]
- ["guj" gujarati []]
- ["gwi" gwich'in []]
- ["hai" haida []]
- ["hat" haitian []]
- ["hau" hausa []]
- ["haw" hawaiian []]
- ["heb" hebrew []]
- ["her" herero []]
- ["hil" hiligaynon []]
- ["him" himachali []]
- ["hin" hindi []]
- ["hit" hittite []]
- ["hmn" hmong []]
- ["hmo" hiri-motu []]
- ["hrv" croatian []]
- ["hsb" upper-sorbian []]
- ["hun" hungarian []]
- ["hup" hupa []]
- ["hye" armenian []]
- ["iba" iban []]
- ["ibo" igbo []]
- ["ido" ido []]
- ["iii" sichuan-yi [[nuosu]]]
- ["ijo" ijo []]
- ["iku" inuktitut []]
- ["ile" interlingue []]
- ["ilo" iloko []]
- ["ina" interlingua []]
- ["inc" indic []]
- ["ind" indonesian []]
- ["ine" indo-european []]
- ["inh" ingush []]
- ["ipk" inupiaq []]
- ["ira" iranian []]
- ["iro" iroquoian []]
- ["isl" icelandic []]
- ["ita" italian []]
- ["jav" javanese []]
- ["jbo" lojban []]
- ["jpn" japanese []]
- ["jpr" judeo-persian []]
- ["jrb" judeo-arabic []]
- ["kaa" kara-kalpak []]
- ["kab" kabyle []]
- ["kac" kachin [[jingpho]]]
- ["kal" kalaallisut [[greenlandic]]]
- ["kam" kamba []]
- ["kan" kannada []]
- ["kar" karen []]
- ["kas" kashmiri []]
- ["kat" georgian []]
- ["kau" kanuri []]
- ["kaw" kawi []]
- ["kaz" kazakh []]
- ["kbd" kabardian []]
- ["kha" khasi []]
- ["khi" khoisan []]
- ["khm" central-khmer []]
- ["kho" khotanese [[sakan]]]
- ["kik" gikuyu []]
- ["kin" kinyarwanda []]
- ["kir" kyrgyz []]
- ["kmb" kimbundu []]
- ["kok" konkani []]
- ["kom" komi []]
- ["kon" kongo []]
- ["kor" korean []]
- ["kos" kosraean []]
- ["kpe" kpelle []]
- ["krc" karachay-balkar []]
- ["krl" karelian []]
- ["kro" kru []]
- ["kru" kurukh []]
- ["kua" kwanyama []]
- ["kum" kumyk []]
- ["kur" kurdish []]
- ["kut" kutenai []]
- ["lad" ladino []]
- ["lah" lahnda []]
- ["lam" lamba []]
- ["lao" lao []]
- ["lat" latin []]
- ["lav" latvian []]
- ["lez" lezghian []]
- ["lim" limburgan []]
- ["lin" lingala []]
- ["lit" lithuanian []]
- ["lol" mongo []]
- ["loz" lozi []]
- ["ltz" luxembourgish []]
- ["lua" luba-lulua []]
- ["lub" luba-katanga []]
- ["lug" ganda []]
- ["lui" luiseno []]
- ["lun" lunda []]
- ["luo" luo []]
- ["lus" lushai []]
- ["mad" madurese []]
- ["mag" magahi []]
- ["mah" marshallese []]
- ["mai" maithili []]
- ["mak" makasar []]
- ["mal" malayalam []]
- ["man" mandingo []]
- ["map" austronesian []]
- ["mar" marathi []]
- ["mas" masai []]
- ["mdf" moksha []]
- ["mdr" mandar []]
- ["men" mende []]
- ["mga" middle-irish []]
- ["mic" mi'kmaq [[micmac]]]
- ["min" minangkabau []]
- ["mkd" macedonian []]
- ["mkh" mon-khmer []]
- ["mlg" malagasy []]
- ["mlt" maltese []]
- ["mnc" manchu []]
- ["mni" manipuri []]
- ["mno" manobo []]
- ["moh" mohawk []]
- ["mon" mongolian []]
- ["mos" mossi []]
- ["mri" maori []]
- ["msa" malay []]
- ["mun" munda []]
- ["mus" creek []]
- ["mwl" mirandese []]
- ["mwr" marwari []]
- ["mya" burmese []]
- ["myn" mayan []]
- ["myv" erzya []]
- ["nah" nahuatl []]
- ["nai" north-american-indian []]
- ["nap" neapolitan []]
- ["nau" nauru []]
- ["nav" navajo []]
- ["nbl" south-ndebele []]
- ["nde" north-ndebele []]
- ["ndo" ndonga []]
- ["nds" low-german []]
- ["nep" nepali []]
- ["new" newari [[nepal-bhasa]]]
- ["nia" nias []]
- ["nic" niger-kordofanian []]
- ["niu" niuean []]
- ["nld" dutch [[flemish]]]
- ["nno" nynorsk []]
- ["nob" bokmal []]
- ["nog" nogai []]
- ["non" old-norse []]
- ["nor" norwegian []]
- ["nqo" n'ko []]
- ["nso" northern-sotho [[pedi] [sepedi]]]
- ["nub" nubian []]
- ["nwc" old-newari [[classical-newari] [classical-nepal-bhasa]]]
- ["nya" nyanja [[chichewa] [chewa]]]
- ["nym" nyamwezi []]
- ["nyn" nyankole []]
- ["nyo" nyoro []]
- ["nzi" nzima []]
- ["oci" occitan [[provencal]]]
- ["oji" ojibwa []]
- ["ori" oriya []]
- ["orm" oromo []]
- ["osa" osage []]
- ["oss" ossetic []]
- ["ota" ottoman-turkish []]
- ["oto" otomian []]
- ["paa" papuan []]
- ["pag" pangasinan []]
- ["pal" pahlavi []]
- ["pam" pampanga [[kapampangan]]]
- ["pan" punjabi []]
- ["pap" papiamento []]
- ["pau" palauan []]
- ["peo" old-persian []]
- ["phi" philippine []]
- ["phn" phoenician []]
- ["pli" pali []]
- ["pol" polish []]
- ["pon" pohnpeian []]
- ["por" portuguese []]
- ["pra" prakrit []]
- ["pro" old-provencal []]
- ["pus" pashto []]
- ["que" quechua []]
- ["raj" rajasthani []]
- ["rap" rapanui []]
- ["rar" rarotongan [[cook-islands-maori]]]
- ["roa" romance []]
- ["roh" romansh []]
- ["rom" romany []]
- ["ron" romanian [[moldavian] [moldovan]]]
- ["run" rundi []]
- ["rup" aromanian [[arumanian] [macedo-romanian]]]
- ["rus" russian []]
- ["sad" sandawe []]
- ["sag" sango []]
- ["sah" yakut []]
- ["sai" south-american-indian []]
- ["sal" salishan []]
- ["sam" samaritan-aramaic []]
- ["san" sanskrit []]
- ["sas" sasak []]
- ["sat" santali []]
- ["scn" sicilian []]
- ["sco" scots []]
- ["sel" selkup []]
- ["sem" semitic []]
- ["sga" old-irish []]
- ["sgn" sign []]
- ["shn" shan []]
- ["sid" sidamo []]
- ["sin" sinhalese []]
- ["sio" siouan []]
- ["sit" sino-tibetan []]
- ["sla" slavic []]
- ["slk" slovak []]
- ["slv" slovenian []]
- ["sma" southern-sami []]
- ["sme" northern-sami []]
- ["smi" sami []]
- ["smj" lule []]
- ["smn" inari []]
- ["smo" samoan []]
- ["sms" skolt-sami []]
- ["sna" shona []]
- ["snd" sindhi []]
- ["snk" soninke []]
- ["sog" sogdian []]
- ["som" somali []]
- ["son" songhai []]
- ["sot" southern-sotho []]
- ["spa" spanish [[castilian]]]
- ["sqi" albanian []]
- ["srd" sardinian []]
- ["srn" sranan-tongo []]
- ["srp" serbian []]
- ["srr" serer []]
- ["ssa" nilo-saharan []]
- ["ssw" swati []]
- ["suk" sukuma []]
- ["sun" sundanese []]
- ["sus" susu []]
- ["sux" sumerian []]
- ["swa" swahili []]
- ["swe" swedish []]
- ["syc" classical-syriac []]
- ["syr" syriac []]
- ["tah" tahitian []]
- ["tai" tai []]
- ["tam" tamil []]
- ["tat" tatar []]
- ["tel" telugu []]
- ["tem" timne []]
- ["ter" tereno []]
- ["tet" tetum []]
- ["tgk" tajik []]
- ["tgl" tagalog []]
- ["tha" thai []]
- ["tig" tigre []]
- ["tir" tigrinya []]
- ["tiv" tiv []]
- ["tkl" tokelau []]
- ["tlh" klingon []]
- ["tli" tlingit []]
- ["tmh" tamashek []]
- ["tog" tonga []]
- ["ton" tongan []]
- ["tpi" tok-pisin []]
- ["tsi" tsimshian []]
- ["tsn" tswana []]
- ["tso" tsonga []]
- ["tuk" turkmen []]
- ["tum" tumbuka []]
- ["tup" tupi []]
- ["tur" turkish []]
- ["tut" altaic []]
- ["tvl" tuvalu []]
- ["twi" twi []]
- ["tyv" tuvinian []]
- ["udm" udmurt []]
- ["uga" ugaritic []]
- ["uig" uyghur []]
- ["ukr" ukrainian []]
- ["umb" umbundu []]
- ["urd" urdu []]
- ["uzb" uzbek []]
- ["vai" vai []]
- ["ven" venda []]
- ["vie" vietnamese []]
- ["vol" volapük []]
- ["vot" votic []]
- ["wak" wakashan []]
- ["wal" walamo []]
- ["war" waray []]
- ["was" washo []]
- ["wen" sorbian []]
- ["wln" walloon []]
- ["wol" wolof []]
- ["xal" kalmyk [[oirat]]]
- ["xho" xhosa []]
- ["yao" yao []]
- ["yap" yapese []]
- ["yid" yiddish []]
- ["yor" yoruba []]
- ["ypk" yupik []]
- ["zap" zapotec []]
- ["zbl" blissymbols []]
- ["zen" zenaga []]
- ["zgh" standard-moroccan-tamazight []]
- ["zha" zhuang []]
- ["zho" chinese []]
- ["znd" zande []]
- ["zul" zulu []]
- ["zun" zuni []]
- ["zza" zaza [[dimili] [dimli] [kirdki] [kirmanjki] [zazaki]]]
+ ["mis" "uncoded languages" uncoded []]
+ ["mul" "multiple languages" multiple []]
+ ["und" "undetermined" undetermined []]
+ ["zxx" "no linguistic content; not applicable" not-applicable []]
+
+ ["aar" "Afar" afar []]
+ ["abk" "Abkhazian" abkhazian []]
+ ["ace" "Achinese" achinese []]
+ ["ach" "Acoli" acoli []]
+ ["ada" "Adangme" adangme []]
+ ["ady" "Adyghe; Adygei" adyghe []]
+ ["afa" "Afro-Asiatic languages" afro-asiatic []]
+ ["afh" "Afrihili" afrihili []]
+ ["afr" "Afrikaans" afrikaans []]
+ ["ain" "Ainu" ainu []]
+ ["aka" "Akan" akan []]
+ ["akk" "Akkadian" akkadian []]
+ ["ale" "Aleut" aleut []]
+ ["alg" "Algonquian languages" algonquian []]
+ ["alt" "Southern Altai" southern-altai []]
+ ["amh" "Amharic" amharic []]
+ ["ang" "Old English (ca.450–1100)" old-english []]
+ ["anp" "Angika" angika []]
+ ["apa" "Apache languages" apache []]
+ ["ara" "Arabic" arabic []]
+ ["arc" "Official Aramaic (700–300 BCE); Imperial Aramaic (700–300 BCE)" official-aramaic [[imperial-aramaic]]]
+ ["arg" "Aragonese" aragonese []]
+ ["arn" "Mapudungun; Mapuche" mapudungun []]
+ ["arp" "Arapaho" arapaho []]
+ ["art" "Artificial languages" artificial []]
+ ["arw" "Arawak" arawak []]
+ ["asm" "Assamese" assamese []]
+ ["ast" "Asturian; Bable; Leonese; Asturleonese" asturian [[bable] [leonese] [asturleonese]]]
+ ["ath" "Athapascan languages" athapascan []]
+ ["aus" "Australian languages" australian []]
+ ["ava" "Avaric" avaric []]
+ ["ave" "Avestan" avestan []]
+ ["awa" "Awadhi" awadhi []]
+ ["aym" "Aymara" aymara []]
+ ["aze" "Azerbaijani" azerbaijani []]
+
+ ["bad" "Banda languages" banda []]
+ ["bai" "Bamileke languages" bamileke []]
+ ["bak" "Bashkir" bashkir []]
+ ["bal" "Baluchi" baluchi []]
+ ["bam" "Bambara" bambara []]
+ ["ban" "Balinese" balinese []]
+ ["bas" "Basa" basa []]
+ ["bat" "Baltic languages" baltic []]
+ ["bej" "Beja; Bedawiyet" beja []]
+ ["bel" "Belarusian" belarusian []]
+ ["bem" "Bemba" bemba []]
+ ["ben" "Bengali" bengali []]
+ ["ber" "Berber languages" berber []]
+ ["bho" "Bhojpuri" bhojpuri []]
+ ["bih" "Bihari languages" bihari []]
+ ["bik" "Bikol" bikol []]
+ ["bin" "Bini; Edo" bini [[edo]]]
+ ["bis" "Bislama" bislama []]
+ ["bla" "Siksika" siksika []]
+ ["bnt" "Bantu languages" bantu []]
+ ["bod" "Tibetan" tibetan []]
+ ["bos" "Bosnian" bosnian []]
+ ["bra" "Braj" braj []]
+ ["bre" "Breton" breton []]
+ ["btk" "Batak languages" batak []]
+ ["bua" "Buriat" buriat []]
+ ["bug" "Buginese" buginese []]
+ ["bul" "Bulgarian" bulgarian []]
+ ["byn" "Blin; Bilin" blin [[bilin]]]
+
+ ["cad" "Caddo" caddo []]
+ ["cai" "Central American Indian languages" central-american-indian []]
+ ["car" "Galibi Carib" galibi-carib []]
+ ["cat" "Catalan; Valencian" catalan [[valencian]]]
+ ["cau" "Caucasian languages" caucasian []]
+ ["ceb" "Cebuano" cebuano []]
+ ["cel" "Celtic languages" celtic []]
+ ["ces" "Czech" czech []]
+ ["cha" "Chamorro" chamorro []]
+ ["chb" "Chibcha" chibcha []]
+ ["che" "Chechen" chechen []]
+ ["chg" "Chagatai" chagatai []]
+ ["chk" "Chuukese" chuukese []]
+ ["chm" "Mari" mari []]
+ ["chn" "Chinook jargon" chinook []]
+ ["cho" "Choctaw" choctaw []]
+ ["chp" "Chipewyan; Dene Suline" chipewyan []]
+ ["chr" "Cherokee" cherokee []]
+ ["chu" "Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic" church-slavic [[old-slavonic] [church-slavonic] [old-bulgarian] [old-church-slavonic]]]
+ ["chv" "Chuvash" chuvash []]
+ ["chy" "Cheyenne" cheyenne []]
+ ["cmc" "Chamic languages" chamic []]
+ ["cnr" "Montenegrin" montenegrin []]
+ ["cop" "Coptic" coptic []]
+ ["cor" "Cornish" cornish []]
+ ["cos" "Corsican" corsican []]
+ ["cpe" "Creoles and pidgins, English based" creoles-and-pidgins/english []]
+ ["cpf" "Creoles and pidgins, French-based" creoles-and-pidgins/french []]
+ ["cpp" "Creoles and pidgins, Portuguese-based" creoles-and-pidgins/portuguese []]
+ ["cre" "Cree" cree []]
+ ["crh" "Crimean Tatar; Crimean Turkish" crimean []]
+ ["crp" "Creoles and pidgins" creoles-and-pidgins []]
+ ["csb" "Kashubian" kashubian []]
+ ["cus" "Cushitic languages" cushitic []]
+ ["cym" "Welsh" welsh []]
+
+ ["dak" "Dakota" dakota []]
+ ["dan" "Danish" danish []]
+ ["dar" "Dargwa" dargwa []]
+ ["day" "Land Dayak languages" land-dayak []]
+ ["del" "Delaware" delaware []]
+ ["den" "Slave (Athapascan)" slavey []]
+ ["deu" "German" german []]
+ ["dgr" "Dogrib" dogrib []]
+ ["din" "Dinka" dinka []]
+ ["div" "Divehi; Dhivehi; Maldivian" dhivehi [[maldivian]]]
+ ["doi" "Dogri" dogri []]
+ ["dra" "Dravidian languages" dravidian []]
+ ["dsb" "Lower Sorbian" lower-sorbian []]
+ ["dua" "Duala" duala []]
+ ["dum" "Middle Dutch (ca. 1050–1350)" middle-dutch []]
+ ["dyu" "Dyula" dyula []]
+ ["dzo" "Dzongkha" dzongkha []]
+
+ ["efi" "Efik" efik []]
+ ["egy" "Ancient Egyptian" egyptian []]
+ ["eka" "Ekajuk" ekajuk []]
+ ["ell" "Modern Greek (1453–)" greek []]
+ ["elx" "Elamite" elamite []]
+ ["eng" "English" english []]
+ ["enm" "Middle English (1100–1500)" middle-english []]
+ ["epo" "Esperanto" esperanto []]
+ ["est" "Estonian" estonian []]
+ ["eus" "Basque" basque []]
+ ["ewe" "Ewe" ewe []]
+ ["ewo" "Ewondo" ewondo []]
+
+ ["fan" "Fang" fang []]
+ ["fao" "Faroese" faroese []]
+ ["fas" "Persian" persian []]
+ ["fat" "Fanti" fanti []]
+ ["fij" "Fijian" fijian []]
+ ["fil" "Filipino; Pilipino" filipino []]
+ ["fin" "Finnish" finnish []]
+ ["fiu" "Finno-Ugrian languages" finno-ugrian []]
+ ["fon" "Fon" fon []]
+ ["fra" "French" french []]
+ ["frm" "Middle French (ca. 1400–1600)" middle-french []]
+ ["fro" "Old French (ca. 842–1400)" old-french []]
+ ["frr" "Northern Frisian" northern-frisian []]
+ ["frs" "Eastern Frisian" eastern-frisian []]
+ ["fry" "Western Frisian" western-frisian []]
+ ["ful" "Fulah" fulah []]
+ ["fur" "Friulian" friulian []]
+
+ ["gaa" "Ga" ga []]
+ ["gay" "Gayo" gayo []]
+ ["gba" "Gbaya" gbaya []]
+ ["gem" "Germanic languages" germanic []]
+ ["gez" "Geez" geez []]
+ ["gil" "Gilbertese" gilbertese []]
+ ["gla" "Gaelic; Scottish Gaelic" gaelic []]
+ ["gle" "Irish" irish []]
+ ["glg" "Galician" galician []]
+ ["glv" "Manx" manx []]
+ ["gmh" "Middle High German (ca. 1050–1500)" middle-high-german []]
+ ["goh" "Old High German (ca. 750–1050)" old-high-german []]
+ ["gon" "Gondi" gondi []]
+ ["gor" "Gorontalo" gorontalo []]
+ ["got" "Gothic" gothic []]
+ ["grb" "Grebo" grebo []]
+ ["grc" "Ancient Greek (to 1453)" ancient-greek []]
+ ["grn" "Guarani" guarani []]
+ ["gsw" "Swiss German; Alemannic; Alsatian" swiss-german [[alemannic] [alsatian]]]
+ ["guj" "Gujarati" gujarati []]
+ ["gwi" "Gwich'in" gwich'in []]
+
+ ["hai" "Haida" haida []]
+ ["hat" "Haitian; Haitian Creole" haitian []]
+ ["hau" "Hausa" hausa []]
+ ["haw" "Hawaiian" hawaiian []]
+ ["heb" "Hebrew" hebrew []]
+ ["her" "Herero" herero []]
+ ["hil" "Hiligaynon" hiligaynon []]
+ ["him" "Himachali languages; Pahari languages" himachali []]
+ ["hin" "Hindi" hindi []]
+ ["hit" "Hittite" hittite []]
+ ["hmn" "Hmong; Mong" hmong []]
+ ["hmo" "Hiri Motu" hiri-motu []]
+ ["hrv" "Croatian" croatian []]
+ ["hsb" "Upper Sorbian" upper-sorbian []]
+ ["hun" "Hungarian" hungarian []]
+ ["hup" "Hupa" hupa []]
+ ["hye" "Armenian" armenian []]
+
+ ["iba" "Iban" iban []]
+ ["ibo" "Igbo" igbo []]
+ ["ido" "Ido" ido []]
+ ["iii" "Sichuan Yi; Nuosu" sichuan-yi [[nuosu]]]
+ ["ijo" "Ijo languages" ijo []]
+ ["iku" "Inuktitut" inuktitut []]
+ ["ile" "Interlingue; Occidental" interlingue []]
+ ["ilo" "Iloko" iloko []]
+ ["ina" "Interlingua (International Auxiliary Language Association)" interlingua []]
+ ["inc" "Indic languages" indic []]
+ ["ind" "Indonesian" indonesian []]
+ ["ine" "Indo-European languages" indo-european []]
+ ["inh" "Ingush" ingush []]
+ ["ipk" "Inupiaq" inupiaq []]
+ ["ira" "Iranian languages" iranian []]
+ ["iro" "Iroquoian languages" iroquoian []]
+ ["isl" "Icelandic" icelandic []]
+ ["ita" "Italian" italian []]
+
+ ["jav" "Javanese" javanese []]
+ ["jbo" "Lojban" lojban []]
+ ["jpn" "Japanese" japanese []]
+ ["jpr" "Judeo-Persian" judeo-persian []]
+ ["jrb" "Judeo-Arabic" judeo-arabic []]
+
+ ["kaa" "Kara-Kalpak" kara-kalpak []]
+ ["kab" "Kabyle" kabyle []]
+ ["kac" "Kachin; Jingpho" kachin [[jingpho]]]
+ ["kal" "Kalaallisut; Greenlandic" kalaallisut [[greenlandic]]]
+ ["kam" "Kamba" kamba []]
+ ["kan" "Kannada" kannada []]
+ ["kar" "Karen languages" karen []]
+ ["kas" "Kashmiri" kashmiri []]
+ ["kat" "Georgian" georgian []]
+ ["kau" "Kanuri" kanuri []]
+ ["kaw" "Kawi" kawi []]
+ ["kaz" "Kazakh" kazakh []]
+ ["kbd" "Kabardian" kabardian []]
+ ["kha" "Khasi" khasi []]
+ ["khi" "Khoisan languages" khoisan []]
+ ["khm" "Central Khmer" central-khmer []]
+ ["kho" "Khotanese; Sakan" khotanese [[sakan]]]
+ ["kik" "Kikuyu; Gikuyu" gikuyu []]
+ ["kin" "Kinyarwanda" kinyarwanda []]
+ ["kir" "Kirghiz; Kyrgyz" kyrgyz []]
+ ["kmb" "Kimbundu" kimbundu []]
+ ["kok" "Konkani" konkani []]
+ ["kom" "Komi" komi []]
+ ["kon" "Kongo" kongo []]
+ ["kor" "Korean" korean []]
+ ["kos" "Kosraean" kosraean []]
+ ["kpe" "Kpelle" kpelle []]
+ ["krc" "Karachay-Balkar" karachay-balkar []]
+ ["krl" "Karelian" karelian []]
+ ["kro" "Kru languages" kru []]
+ ["kru" "Kurukh" kurukh []]
+ ["kua" "Kuanyama; Kwanyama" kwanyama []]
+ ["kum" "Kumyk" kumyk []]
+ ["kur" "Kurdish" kurdish []]
+ ["kut" "Kutenai" kutenai []]
+
+ ["lad" "Ladino" ladino []]
+ ["lah" "Lahnda" lahnda []]
+ ["lam" "Lamba" lamba []]
+ ["lao" "Lao" lao []]
+ ["lat" "Latin" latin []]
+ ["lav" "Latvian" latvian []]
+ ["lez" "Lezghian" lezghian []]
+ ["lim" "Limburgan; Limburger; Limburgish" limburgan []]
+ ["lin" "Lingala" lingala []]
+ ["lit" "Lithuanian" lithuanian []]
+ ["lol" "Mongo" mongo []]
+ ["loz" "Lozi" lozi []]
+ ["ltz" "Luxembourgish; Letzeburgesch" luxembourgish []]
+ ["lua" "Luba-Lulua" luba-lulua []]
+ ["lub" "Luba-Katanga" luba-katanga []]
+ ["lug" "Ganda" ganda []]
+ ["lui" "Luiseno" luiseno []]
+ ["lun" "Lunda" lunda []]
+ ["luo" "Luo (Kenya and Tanzania)" luo []]
+ ["lus" "Lushai" lushai []]
+
+ ["mad" "Madurese" madurese []]
+ ["mag" "Magahi" magahi []]
+ ["mah" "Marshallese" marshallese []]
+ ["mai" "Maithili" maithili []]
+ ["mak" "Makasar" makasar []]
+ ["mal" "Malayalam" malayalam []]
+ ["man" "Mandingo" mandingo []]
+ ["map" "Austronesian languages" austronesian []]
+ ["mar" "Marathi" marathi []]
+ ["mas" "Masai" masai []]
+ ["mdf" "Moksha" moksha []]
+ ["mdr" "Mandar" mandar []]
+ ["men" "Mende" mende []]
+ ["mga" "Middle Irish (900–1200)" middle-irish []]
+ ["mic" "Mi'kmaq; Micmac" mi'kmaq [[micmac]]]
+ ["min" "Minangkabau" minangkabau []]
+ ["mkd" "Macedonian" macedonian []]
+ ["mkh" "Mon-Khmer languages" mon-khmer []]
+ ["mlg" "Malagasy" malagasy []]
+ ["mlt" "Maltese" maltese []]
+ ["mnc" "Manchu" manchu []]
+ ["mni" "Manipuri" manipuri []]
+ ["mno" "Manobo languages" manobo []]
+ ["moh" "Mohawk" mohawk []]
+ ["mon" "Mongolian" mongolian []]
+ ["mos" "Mossi" mossi []]
+ ["mri" "Maori" maori []]
+ ["msa" "Malay" malay []]
+ ["mun" "Munda languages" munda []]
+ ["mus" "Creek" creek []]
+ ["mwl" "Mirandese" mirandese []]
+ ["mwr" "Marwari" marwari []]
+ ["mya" "Burmese" burmese []]
+ ["myn" "Mayan languages" mayan []]
+ ["myv" "Erzya" erzya []]
+
+ ["nah" "Nahuatl languages" nahuatl []]
+ ["nai" "North American Indian languages" north-american-indian []]
+ ["nap" "Neapolitan" neapolitan []]
+ ["nau" "Nauru" nauru []]
+ ["nav" "Navajo; Navaho" navajo []]
+ ["nbl" "South Ndebele" south-ndebele []]
+ ["nde" "North Ndebele" north-ndebele []]
+ ["ndo" "Ndonga" ndonga []]
+ ["nds" "Low German; Low Saxon" low-german []]
+ ["nep" "Nepali" nepali []]
+ ["new" "Nepal Bhasa; Newari" newari [[nepal-bhasa]]]
+ ["nia" "Nias" nias []]
+ ["nic" "Niger-Kordofanian languages" niger-kordofanian []]
+ ["niu" "Niuean" niuean []]
+ ["nld" "Dutch; Flemish" dutch [[flemish]]]
+ ["nno" "Norwegian Nynorsk" nynorsk []]
+ ["nob" "Norwegian Bokmål" bokmal []]
+ ["nog" "Nogai" nogai []]
+ ["non" "Old Norse" old-norse []]
+ ["nor" "Norwegian" norwegian []]
+ ["nqo" "N'Ko" n'ko []]
+ ["nso" "Pedi; Sepedi; Northern Sotho" northern-sotho [[pedi] [sepedi]]]
+ ["nub" "Nubian languages" nubian []]
+ ["nwc" "Classical Newari; Old Newari; Classical Nepal Bhasa" old-newari [[classical-newari] [classical-nepal-bhasa]]]
+ ["nya" "Chichewa; Chewa; Nyanja" nyanja [[chichewa] [chewa]]]
+ ["nym" "Nyamwezi" nyamwezi []]
+ ["nyn" "Nyankole" nyankole []]
+ ["nyo" "Nyoro" nyoro []]
+ ["nzi" "Nzima" nzima []]
+
+ ["oci" "Occitan (post 1500); Provençal" occitan [[provencal]]]
+ ["oji" "Ojibwa" ojibwa []]
+ ["ori" "Oriya" oriya []]
+ ["orm" "Oromo" oromo []]
+ ["osa" "Osage" osage []]
+ ["oss" "Ossetian; Ossetic" ossetic []]
+ ["ota" "Ottoman Turkish (1500–1928)" ottoman-turkish []]
+ ["oto" "Otomian languages" otomian []]
+
+ ["paa" "Papuan languages" papuan []]
+ ["pag" "Pangasinan" pangasinan []]
+ ["pal" "Pahlavi" pahlavi []]
+ ["pam" "Pampanga; Kapampangan" pampanga [[kapampangan]]]
+ ["pan" "Panjabi; Punjabi" punjabi []]
+ ["pap" "Papiamento" papiamento []]
+ ["pau" "Palauan" palauan []]
+ ["peo" "Old Persian (ca. 600–400 B.C.)" old-persian []]
+ ["phi" "Philippine languages" philippine []]
+ ["phn" "Phoenician" phoenician []]
+ ["pli" "Pali" pali []]
+ ["pol" "Polish" polish []]
+ ["pon" "Pohnpeian" pohnpeian []]
+ ["por" "Portuguese" portuguese []]
+ ["pra" "Prakrit languages" prakrit []]
+ ["pro" "Old Provençal (to 1500); Old Occitan (to 1500)" old-provencal []]
+ ["pus" "Pushto; Pashto" pashto []]
+
+ ["que" "Quechua" quechua []]
+
+ ["raj" "Rajasthani" rajasthani []]
+ ["rap" "Rapanui" rapanui []]
+ ["rar" "Rarotongan; Cook Islands Maori" rarotongan [[cook-islands-maori]]]
+ ["roa" "Romance languages" romance []]
+ ["roh" "Romansh" romansh []]
+ ["rom" "Romany" romany []]
+ ["ron" "Romanian; Moldavian; Moldovan" romanian [[moldavian] [moldovan]]]
+ ["run" "Rundi" rundi []]
+ ["rup" "Aromanian; Arumanian; Macedo-Romanian" aromanian [[arumanian] [macedo-romanian]]]
+ ["rus" "Russian" russian []]
+
+ ["sad" "Sandawe" sandawe []]
+ ["sag" "Sango" sango []]
+ ["sah" "Yakut" yakut []]
+ ["sai" "South American Indian (Other)" south-american-indian []]
+ ["sal" "Salishan languages" salishan []]
+ ["sam" "Samaritan Aramaic" samaritan-aramaic []]
+ ["san" "Sanskrit" sanskrit []]
+ ["sas" "Sasak" sasak []]
+ ["sat" "Santali" santali []]
+ ["scn" "Sicilian" sicilian []]
+ ["sco" "Scots" scots []]
+ ["sel" "Selkup" selkup []]
+ ["sem" "Semitic languages" semitic []]
+ ["sga" "Old Irish (to 900)" old-irish []]
+ ["sgn" "Sign Languages" sign []]
+ ["shn" "Shan" shan []]
+ ["sid" "Sidamo" sidamo []]
+ ["sin" "Sinhala; Sinhalese" sinhalese []]
+ ["sio" "Siouan languages" siouan []]
+ ["sit" "Sino-Tibetan languages" sino-tibetan []]
+ ["sla" "Slavic languages" slavic []]
+ ["slk" "Slovak" slovak []]
+ ["slv" "Slovenian" slovenian []]
+ ["sma" "Southern Sami" southern-sami []]
+ ["sme" "Northern Sami" northern-sami []]
+ ["smi" "Sami languages" sami []]
+ ["smj" "Lule Sami" lule []]
+ ["smn" "Inari Sami" inari []]
+ ["smo" "Samoan" samoan []]
+ ["sms" "Skolt Sami" skolt-sami []]
+ ["sna" "Shona" shona []]
+ ["snd" "Sindhi" sindhi []]
+ ["snk" "Soninke" soninke []]
+ ["sog" "Sogdian" sogdian []]
+ ["som" "Somali" somali []]
+ ["son" "Songhai languages" songhai []]
+ ["sot" "Southern Sotho" southern-sotho []]
+ ["spa" "Spanish; Castilian" spanish [[castilian]]]
+ ["sqi" "Albanian" albanian []]
+ ["srd" "Sardinian" sardinian []]
+ ["srn" "Sranan Tongo" sranan-tongo []]
+ ["srp" "Serbian" serbian []]
+ ["srr" "Serer" serer []]
+ ["ssa" "Nilo-Saharan languages" nilo-saharan []]
+ ["ssw" "Swati" swati []]
+ ["suk" "Sukuma" sukuma []]
+ ["sun" "Sundanese" sundanese []]
+ ["sus" "Susu" susu []]
+ ["sux" "Sumerian" sumerian []]
+ ["swa" "Swahili" swahili []]
+ ["swe" "Swedish" swedish []]
+ ["syc" "Classical Syriac" classical-syriac []]
+ ["syr" "Syriac" syriac []]
+
+ ["tah" "Tahitian" tahitian []]
+ ["tai" "Tai languages" tai []]
+ ["tam" "Tamil" tamil []]
+ ["tat" "Tatar" tatar []]
+ ["tel" "Telugu" telugu []]
+ ["tem" "Timne" timne []]
+ ["ter" "Tereno" tereno []]
+ ["tet" "Tetum" tetum []]
+ ["tgk" "Tajik" tajik []]
+ ["tgl" "Tagalog" tagalog []]
+ ["tha" "Thai" thai []]
+ ["tig" "Tigre" tigre []]
+ ["tir" "Tigrinya" tigrinya []]
+ ["tiv" "Tiv" tiv []]
+ ["tkl" "Tokelau" tokelau []]
+ ["tlh" "Klingon; tlhIngan-Hol" klingon []]
+ ["tli" "Tlingit" tlingit []]
+ ["tmh" "Tamashek" tamashek []]
+ ["tog" "Tonga (Nyasa)" tonga []]
+ ["ton" "Tonga (Tonga Islands)" tongan []]
+ ["tpi" "Tok Pisin" tok-pisin []]
+ ["tsi" "Tsimshian" tsimshian []]
+ ["tsn" "Tswana" tswana []]
+ ["tso" "Tsonga" tsonga []]
+ ["tuk" "Turkmen" turkmen []]
+ ["tum" "Tumbuka" tumbuka []]
+ ["tup" "Tupi languages" tupi []]
+ ["tur" "Turkish" turkish []]
+ ["tut" "Altaic languages" altaic []]
+ ["tvl" "Tuvalu" tuvalu []]
+ ["twi" "Twi" twi []]
+ ["tyv" "Tuvinian" tuvinian []]
+
+ ["udm" "Udmurt" udmurt []]
+ ["uga" "Ugaritic" ugaritic []]
+ ["uig" "Uighur; Uyghur" uyghur []]
+ ["ukr" "Ukrainian" ukrainian []]
+ ["umb" "Umbundu" umbundu []]
+ ["urd" "Urdu" urdu []]
+ ["uzb" "Uzbek" uzbek []]
+
+ ["vai" "Vai" vai []]
+ ["ven" "Venda" venda []]
+ ["vie" "Vietnamese" vietnamese []]
+ ["vol" "Volapük" volapük []]
+ ["vot" "Votic" votic []]
+
+ ["wak" "Wakashan languages" wakashan []]
+ ["wal" "Wolaitta; Wolaytta" walamo []]
+ ["war" "Waray" waray []]
+ ["was" "Washo" washo []]
+ ["wen" "Sorbian languages" sorbian []]
+ ["wln" "Walloon" walloon []]
+ ["wol" "Wolof" wolof []]
+
+ ["xal" "Kalmyk; Oirat" kalmyk [[oirat]]]
+ ["xho" "Xhosa" xhosa []]
+
+ ["yao" "Yao" yao []]
+ ["yap" "Yapese" yapese []]
+ ["yid" "Yiddish" yiddish []]
+ ["yor" "Yoruba" yoruba []]
+ ["ypk" "Yupik languages" yupik []]
+
+ ["zap" "Zapotec" zapotec []]
+ ["zbl" "Blissymbols; Blissymbolics; Bliss" blissymbols []]
+ ["zen" "Zenaga" zenaga []]
+ ["zgh" "Standard Moroccan Tamazight" standard-moroccan-tamazight []]
+ ["zha" "Zhuang; Chuang" zhuang []]
+ ["zho" "Chinese" chinese []]
+ ["znd" "Zande languages" zande []]
+ ["zul" "Zulu" zulu []]
+ ["zun" "Zuni" zuni []]
+ ["zza" "Zaza; Dimili; Dimli; Kirdki; Kirmanjki; Zazaki" zaza [[dimili] [dimli] [kirdki] [kirmanjki] [zazaki]]]
)
- (structure: #export equivalence (Equivalence Language)
+ (structure: #export equivalence
+ (Equivalence Language)
+
(def: (= reference sample)
(is? reference sample)))
- (structure: #export hash (Hash Language)
- (def: &equivalence ..equivalence)
+ (structure: #export hash
+ (Hash Language)
+
+ (def: &equivalence
+ ..equivalence)
(def: hash
- (|>> :representation
+ (|>> ..code
(:: text.hash hash))))
)
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 003eb29af..e529fdd19 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -288,9 +288,16 @@
(.list (~+ coverage)))
(~ test)))))))
+(def: coverage-separator
+ Text
+ (text.from-code 31))
+
(def: (covering' module coverage test)
- (-> Text (List Name) Test Test)
- (let [coverage (set.from-list name.hash coverage)]
+ (-> Text Text Test Test)
+ (let [coverage (|> coverage
+ (text.split-all-with ..coverage-separator)
+ (list@map (|>> [module]))
+ (set.from-list name.hash))]
(|> (..context module test)
(random@map (promise@map (function (_ [counters documentation])
[(update@ #expected-coverage (set.union coverage) counters)
@@ -303,10 +310,11 @@
definitions (macro.definitions module)
#let [coverage (|> definitions
(list.filter (|>> product.right product.left))
- (list@map (|>> product.left [module] ..name-code)))]]
+ (list@map product.left)
+ (text.join-with ..coverage-separator))]]
(wrap (list (` ((~! ..covering')
(~ (code.text module))
- (.list (~+ coverage))
+ (~ (code.text coverage))
(~ test)))))))
(def: #export (in-parallel tests)
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
new file mode 100644
index 000000000..fd269f71f
--- /dev/null
+++ b/stdlib/source/program/aedifex.lux
@@ -0,0 +1,93 @@
+(.module:
+ [lux (#- Name)
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [pipe (#+ do>)]
+ ["." try (#+ Try)]
+ ["." io (#+ IO)]
+ [parser
+ ["." cli (#+ program:)]
+ ["<c>" code]]
+ [security
+ ["!" capability]]]
+ [data
+ [binary (#+ Binary)]
+ ["." text
+ ["%" format (#+ format)]
+ ["." encoding]]
+ [format
+ ["." xml]]]
+ [tool
+ [compiler
+ [language
+ [lux
+ ["." syntax]]]]]
+ [world
+ ["." file (#+ Path)]]]
+ ["." / #_
+ ["#" project]
+ ["#." parser]
+ ["#." pom]])
+
+(def: (read-file! path)
+ (-> Path (IO (Try Binary)))
+ (do (try.with io.monad)
+ [project-file (!.use (:: file.system file) [path])]
+ (!.use (:: project-file content) [])))
+
+(def: (write-pom! path project)
+ (-> Path /.Project (IO (Try Any)))
+ (do (try.with io.monad)
+ [file (!.use (:: file.system file) [path])]
+ (|> project
+ /pom.project
+ (:: xml.codec encode)
+ encoding.to-utf8
+ (!.use (:: file over-write)))))
+
+(def: (read-code source-code)
+ (-> Text (Try Code))
+ (let [parse (syntax.parse ""
+ syntax.no-aliases
+ (text.size source-code))
+ start (: Source
+ [["" 0 0] 0 source-code])]
+ (case (parse start)
+ (#.Left [end error])
+ (#try.Failure error)
+
+ (#.Right [end lux-code])
+ (#try.Success lux-code))))
+
+(def: project
+ (-> Binary (Try /.Project))
+ (|>> (do> try.monad
+ [encoding.from-utf8]
+ [..read-code]
+ [(list) (<c>.run /parser.project)])))
+
+(program: [project-file]
+ (do {@ io.monad}
+ [data (..read-file! project-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.Failure error)
+ (wrap (log! (format "Invalid format file:" text.new-line
+ error))))
+
+ (#try.Failure error)
+ (wrap (log! (format "Could not read file: "
+ (%.text project-file)))))))
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
new file mode 100644
index 000000000..2507ad589
--- /dev/null
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -0,0 +1,14 @@
+(.module:
+ [lux (#- Type)])
+
+(type: #export Type
+ Text)
+
+(template [<type> <name>]
+ [(def: #export <name>
+ Type
+ <type>)]
+
+ ["tar" lux-library]
+ ["jar" jvm-library]
+ )
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
new file mode 100644
index 000000000..f3bdbe34f
--- /dev/null
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -0,0 +1,140 @@
+(.module:
+ [lux (#- type)
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<c>" code (#+ Parser)]]]
+ [data
+ ["." text]]
+ [world
+ [net (#+ URL)]]]
+ [//
+ ["/" project]
+ ["//." dependency]])
+
+(def: group
+ (Parser /.Group)
+ <c>.text)
+
+(def: name
+ (Parser /.Name)
+ <c>.text)
+
+(def: version
+ (Parser /.Version)
+ <c>.text)
+
+(def: artifact'
+ (Parser /.Artifact)
+ ($_ <>.and ..group ..name ..version))
+
+(def: artifact
+ (Parser /.Artifact)
+ (<c>.tuple ..artifact'))
+
+(def: url
+ (Parser URL)
+ <c>.text)
+
+(def: scm
+ (Parser /.SCM)
+ ..url)
+
+(def: license
+ (Parser /.License)
+ (<c>.tuple ($_ <>.and
+ ..name
+ ..url
+ (<>.default #/.Repo
+ (<>.or (<c>.this! (' #repo))
+ (<c>.this! (' #manual)))))))
+
+(def: organization
+ (Parser /.Organization)
+ (<| <c>.form
+ (<>.after (<c>.this! (' #organization)))
+ ($_ <>.and
+ ..name
+ ..url)))
+
+(def: developer'
+ (Parser /.Developer)
+ ($_ <>.and
+ ..name
+ ..url
+ (<>.maybe ..organization)
+ ))
+
+(def: developer
+ (Parser /.Developer)
+ (<| <c>.form
+ (<>.after (<c>.this! (' #developer)))
+ ..developer'))
+
+(def: contributor
+ (Parser /.Contributor)
+ (<| <c>.form
+ (<>.after (<c>.this! (' #contributor)))
+ ..developer'))
+
+(def: no-info
+ /.Info
+ {#/.url #.None
+ #/.scm #.None
+ #/.description #.None
+ #/.licenses (list)
+ #/.organization #.None
+ #/.developers (list)
+ #/.contributors (list)})
+
+(def: (bundle tag parser)
+ (All [a] (-> Code (Parser a) (Parser (List a))))
+ (<c>.form (<>.after (<c>.this! tag)
+ (<>.some parser))))
+
+(def: info
+ (Parser /.Info)
+ ($_ <>.and
+ (<>.maybe ..url)
+ (<>.maybe ..scm)
+ (<>.maybe <c>.text)
+ (<>.default (list) (..bundle (' #licenses) ..license))
+ (<>.maybe ..organization)
+ (<>.default (list) (..bundle (' #developers) ..developer))
+ (<>.default (list) (..bundle (' #contributors) ..contributor))
+ ))
+
+(def: repository
+ (Parser /.Repository)
+ ..url)
+
+(def: type
+ (Parser //dependency.Type)
+ <c>.text)
+
+(def: dependency
+ (Parser /.Dependency)
+ (<c>.tuple
+ ($_ <>.and
+ ..artifact'
+ (<>.default //dependency.lux-library ..type)
+ )))
+
+(def: #export project
+ (Parser /.Project)
+ (<| <c>.form
+ (<>.after (<c>.this! (' project:)))
+ (`` ($_ <>.and
+ ..artifact
+ (<| (<>.default ..no-info)
+ <c>.form
+ (<>.after (<c>.this! (' #info)))
+ ..info)
+ (<| (<>.default (list))
+ (..bundle (' #repositories))
+ ..repository)
+ (<| (<>.default (list))
+ (..bundle (' #dependencies))
+ ..dependency)
+ ))))
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
new file mode 100644
index 000000000..a0891951f
--- /dev/null
+++ b/stdlib/source/program/aedifex/project.lux
@@ -0,0 +1,68 @@
+(.module:
+ [lux (#- Name Info)
+ [world
+ [net (#+ URL)]]]
+ [//
+ ["." dependency]])
+
+(type: #export Group
+ Text)
+
+(type: #export Name
+ Text)
+
+(type: #export Version
+ Text)
+
+(type: #export Artifact
+ {#group Group
+ #name Name
+ #version Version})
+
+(type: #export Distribution
+ #Repo
+ #Manual)
+
+(type: #export License
+ [Name
+ URL
+ Distribution])
+
+(type: #export SCM
+ URL)
+
+(type: #export Organization
+ [Name
+ URL])
+
+(type: #export Email
+ Text)
+
+(type: #export Developer
+ [Name
+ 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 Repository
+ URL)
+
+(type: #export Dependency
+ [Artifact dependency.Type])
+
+(type: #export Project
+ {#identity Artifact
+ #info Info
+ #repositories (List Repository)
+ #dependencies (List Dependency)})
diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux
index 8d54fa893..599eb5863 100644
--- a/stdlib/source/test/lux/control/exception.lux
+++ b/stdlib/source/test/lux/control/exception.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*
- [abstract/monad (#+ do)]
+ [abstract
+ [monad (#+ do)]]
[data
- ["." name]
[number
["n" nat]]
["." text ("#@." equivalence)
@@ -33,84 +33,85 @@
value0 report-element
field1 report-element
value1 report-element]
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
+ (_.with-cover [/.Exception])
($_ _.and
- (_.test (%.name (name-of /.return))
- (case (/.return expected)
- (#try.Success actual) (n.= expected actual)
- (#try.Failure _) false))
- (_.test (%.name (name-of /.throw))
- (case (/.throw ..an-exception [])
- (#try.Success _) false
- (#try.Failure _) true))
- (_.test (%.name (name-of /.construct))
- (case (/.throw ..an-exception [])
- (#try.Success _)
- false
-
- (#try.Failure message)
- (text@= message (/.construct ..an-exception []))))
- (_.test (%.name (name-of /.match?))
- (/.match? ..an-exception
- (/.construct ..an-exception [])))
- (_.test (%.name (name-of /.assert))
- (case (/.assert ..an-exception [] assertion-succeeded?)
- (#try.Success _)
- assertion-succeeded?
-
- (#try.Failure message)
- (and (not assertion-succeeded?)
- (text@= message (/.construct ..an-exception [])))))
- (_.test (%.name (name-of /.catch))
- (and (n.= expected
- (|> (/.throw ..an-exception [])
- (/.catch ..an-exception (function (_ ex) expected))
- (/.otherwise (function (_ ex) wrong))))
- (n.= expected
- (|> (/.throw ..another-exception [])
- (/.catch ..an-exception (function (_ ex) wrong))
- (/.catch ..another-exception (function (_ ex) expected))
- (/.otherwise (function (_ ex) wrong))))))
- (_.test (%.name (name-of /.otherwise))
- (n.= expected
- (|> (/.throw ..another-exception [])
- (/.catch ..an-exception (function (_ ex) wrong))
- (/.otherwise (function (_ ex) expected)))))
- (_.test (%.name (name-of /.report))
- (let [report (/.report [field0 value0]
- [field1 value1])]
- (and (text.contains? field0 report)
- (text.contains? value0 report)
- (text.contains? field1 report)
- (text.contains? value1 report))))
- (_.test (%.name (name-of /.enumerate))
- (let [enumeration (/.enumerate %.text (list field0 value0 field1 value1))]
- (and (text.contains? field0 enumeration)
- (text.contains? value0 enumeration)
- (text.contains? field1 enumeration)
- (text.contains? value1 enumeration))))
- (_.test (%.name (name-of /.with))
- (and (case (/.with ..an-exception [] (#try.Success expected))
- (#try.Success actual) (n.= expected actual)
- (#try.Failure _) false)
- (case (/.with ..an-exception [] (#try.Failure ""))
- (#try.Success _) false
- (#try.Failure message) (text@= message (/.construct ..an-exception [])))
- (case (/.with ..an-exception []
- (: (Try Nat)
- (/.throw ..another-exception [])))
- (#try.Success _)
- false
-
- (#try.Failure message)
- (and (text.contains? (/.construct ..an-exception []) message)
- (text.contains? (/.construct ..another-exception []) message)))))
- (_.test (%.name (name-of /.exception:))
- (case (/.throw ..custom-exception [expected])
- (#try.Success _)
- false
-
- (#try.Failure message)
- (and (text.contains? ..label message)
- (text.contains? (%.nat expected) message))))
+ (_.cover [/.return]
+ (case (/.return expected)
+ (#try.Success actual) (n.= expected actual)
+ (#try.Failure _) false))
+ (_.cover [/.throw]
+ (case (/.throw ..an-exception [])
+ (#try.Success _) false
+ (#try.Failure _) true))
+ (_.cover [/.construct]
+ (case (/.throw ..an-exception [])
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (text@= message (/.construct ..an-exception []))))
+ (_.cover [/.match?]
+ (/.match? ..an-exception
+ (/.construct ..an-exception [])))
+ (_.cover [/.assert]
+ (case (/.assert ..an-exception [] assertion-succeeded?)
+ (#try.Success _)
+ assertion-succeeded?
+
+ (#try.Failure message)
+ (and (not assertion-succeeded?)
+ (text@= message (/.construct ..an-exception [])))))
+ (_.cover [/.catch]
+ (and (n.= expected
+ (|> (/.throw ..an-exception [])
+ (/.catch ..an-exception (function (_ ex) expected))
+ (/.otherwise (function (_ ex) wrong))))
+ (n.= expected
+ (|> (/.throw ..another-exception [])
+ (/.catch ..an-exception (function (_ ex) wrong))
+ (/.catch ..another-exception (function (_ ex) expected))
+ (/.otherwise (function (_ ex) wrong))))))
+ (_.cover [/.otherwise]
+ (n.= expected
+ (|> (/.throw ..another-exception [])
+ (/.catch ..an-exception (function (_ ex) wrong))
+ (/.otherwise (function (_ ex) expected)))))
+ (_.cover [/.report]
+ (let [report (/.report [field0 value0]
+ [field1 value1])]
+ (and (text.contains? field0 report)
+ (text.contains? value0 report)
+ (text.contains? field1 report)
+ (text.contains? value1 report))))
+ (_.cover [/.enumerate]
+ (let [enumeration (/.enumerate %.text (list field0 value0 field1 value1))]
+ (and (text.contains? field0 enumeration)
+ (text.contains? value0 enumeration)
+ (text.contains? field1 enumeration)
+ (text.contains? value1 enumeration))))
+ (_.cover [/.with]
+ (and (case (/.with ..an-exception [] (#try.Success expected))
+ (#try.Success actual) (n.= expected actual)
+ (#try.Failure _) false)
+ (case (/.with ..an-exception [] (#try.Failure ""))
+ (#try.Success _) false
+ (#try.Failure message) (text@= message (/.construct ..an-exception [])))
+ (case (/.with ..an-exception []
+ (: (Try Nat)
+ (/.throw ..another-exception [])))
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (and (text.contains? (/.construct ..an-exception []) message)
+ (text.contains? (/.construct ..another-exception []) message)))))
+ (_.cover [/.exception:]
+ (case (/.throw ..custom-exception [expected])
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (and (text.contains? ..label message)
+ (text.contains? (%.nat expected) message))))
))))
diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
index 145e466c0..f795d27c0 100644
--- a/stdlib/source/test/lux/control/function.lux
+++ b/stdlib/source/test/lux/control/function.lux
@@ -7,11 +7,9 @@
[/
["$." monoid]]}]
[data
- ["." name]
[number
["n" nat]]
- ["." text ("#@." equivalence)
- ["%" format (#+ format)]]]
+ ["." text ("#@." equivalence)]]
[math
["." random (#+ Random)]]
["_" test (#+ Test)]]
@@ -26,7 +24,7 @@
f1 (:: @ map n.* random.nat)
dummy random.nat
extra (|> random.nat (random.filter (|>> (n.= expected) not)))]
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
($_ _.and
(let [equivalence (: (Equivalence (-> Nat Nat))
(structure
@@ -35,24 +33,25 @@
(right extra)))))
generator (: (Random (-> Nat Nat))
(:: @ map n.- random.nat))]
- ($monoid.spec equivalence /.monoid generator))
+ (_.with-cover [/.monoid]
+ ($monoid.spec equivalence /.monoid generator)))
- (_.test (%.name (name-of /.identity))
- (n.= expected
- (/.identity expected)))
- (_.test (%.name (name-of /.compose))
- (n.= (f0 (f1 expected))
- ((/.compose f0 f1) expected)))
- (_.test (%.name (name-of /.constant))
- (n.= expected
- ((/.constant expected) dummy)))
- (_.test (%.name (name-of /.flip))
- (let [outcome ((/.flip n.-) expected extra)]
- (and (n.= (n.- extra expected)
- outcome)
- (not (n.= (n.- expected extra)
- outcome)))))
- (_.test (%.name (name-of /.apply))
- (n.= (f0 extra)
- (/.apply extra f0)))
+ (_.cover [/.identity]
+ (n.= expected
+ (/.identity expected)))
+ (_.cover [/.compose]
+ (n.= (f0 (f1 expected))
+ ((/.compose f0 f1) expected)))
+ (_.cover [/.constant]
+ (n.= expected
+ ((/.constant expected) dummy)))
+ (_.cover [/.flip]
+ (let [outcome ((/.flip n.-) expected extra)]
+ (and (n.= (n.- extra expected)
+ outcome)
+ (not (n.= (n.- expected extra)
+ outcome)))))
+ (_.cover [/.apply]
+ (n.= (f0 extra)
+ (/.apply extra f0)))
))))
diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux
index 32bf5f4fc..4855e8c3f 100644
--- a/stdlib/source/test/lux/control/io.lux
+++ b/stdlib/source/test/lux/control/io.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
- ["r" math/random]
+ [math
+ ["." random]]
[abstract
[monad (#+ do)]
{[0 #spec]
@@ -11,7 +11,6 @@
["$." apply]
["$." monad]]}]
[data
- ["." name]
[number
["n" nat]]]]
{1
@@ -30,18 +29,24 @@
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do r.monad
- [sample r.nat
- exit-code r.int]
+ (<| (_.covering /._)
+ (_.with-cover [/.IO])
+ (do random.monad
+ [sample random.nat
+ exit-code random.int]
($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
- (_.test (%.name (name-of /.run))
- (n.= sample
- (/.run (/.io sample))))
- (_.test (%.name (name-of /.exit))
- (exec (/.exit exit-code)
- true))))))
+ (_.cover [/.run /.io]
+ (n.= sample
+ (/.run (/.io sample))))
+ (_.cover [/.exit]
+ ## The /.exit is not actually executed because it would immediately
+ ## terminate the program/tests.
+ (exec (/.exit exit-code)
+ true))))))
diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux
index 701d49741..092152160 100644
--- a/stdlib/source/test/lux/control/parser.lux
+++ b/stdlib/source/test/lux/control/parser.lux
@@ -14,7 +14,6 @@
[parser
["s" code]]]
[data
- ["." name]
[number
["n" nat]]
["." text ("#@." equivalence)
@@ -83,85 +82,85 @@
odd0 (random.filter n.odd? random.nat)
not0 random.bit]
($_ _.and
- (_.test (%.name (name-of /.maybe))
- (and (|> (list (code.nat expected0))
- (/.run (/.maybe s.nat))
- (match (#.Some actual)
- (n.= expected0 actual)))
- (|> (list (code.int (.int expected0)))
- (/.run (/.maybe s.nat))
- (match #.None
- #1))))
- (_.test (%.name (name-of /.some))
- (and (|> (list@map code.nat expected+)
- (/.run (/.some s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) = expected+ actual)))
- (|> (list@map (|>> .int code.int) expected+)
- (/.run (/.some s.nat))
- (match #.Nil
- #1))))
- (_.test (%.name (name-of /.many))
- (and (|> (list@map code.nat expected+)
- (/.run (/.many s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) = expected+ actual)))
- (|> (list (code.nat expected0))
- (/.run (/.many s.nat))
- (match (list actual)
- (n.= expected0 actual)))
- (|> (list@map (|>> .int code.int) expected+)
- (/.run (/.many s.nat))
- fails?)))
- (_.test (%.name (name-of /.filter))
- (and (|> (list (code.nat even0))
- (/.run (/.filter n.even? s.nat))
- (match actual (n.= even0 actual)))
- (|> (list (code.nat odd0))
- (/.run (/.filter n.even? s.nat))
- fails?)))
- (_.test (%.name (name-of /.and))
- (let [even (/.filter n.even? s.nat)
- odd (/.filter n.odd? s.nat)]
- (and (|> (list (code.nat even0) (code.nat odd0))
- (/.run (/.and even odd))
- (match [left right]
- (and (n.= even0 left)
- (n.= odd0 right))))
- (|> (list (code.nat odd0) (code.nat even0))
- (/.run (/.and even odd))
- fails?))))
- (_.test (%.name (name-of /.or))
- (let [even (/.filter n.even? s.nat)
- odd (/.filter n.odd? s.nat)]
- (and (|> (list (code.nat even0))
- (/.run (/.or even odd))
- (match (#.Left actual) (n.= even0 actual)))
- (|> (list (code.nat odd0))
- (/.run (/.or even odd))
- (match (#.Right actual) (n.= odd0 actual)))
- (|> (list (code.bit not0))
- (/.run (/.or even odd))
- fails?))))
- (_.test (%.name (name-of /.either))
- (let [even (/.filter n.even? s.nat)
- odd (/.filter n.odd? s.nat)]
- (and (|> (list (code.nat even0))
- (/.run (/.either even odd))
- (match actual (n.= even0 actual)))
- (|> (list (code.nat odd0))
- (/.run (/.either even odd))
- (match actual (n.= odd0 actual)))
- (|> (list (code.bit not0))
- (/.run (/.either even odd))
- fails?))))
- (_.test (%.name (name-of /.not))
- (and (|> (list (code.nat expected0))
- (/.run (/.not s.nat))
- fails?)
- (|> (list (code.bit not0))
- (/.run (/.not s.nat))
- (match [] #1))))
+ (_.cover [/.maybe]
+ (and (|> (list (code.nat expected0))
+ (/.run (/.maybe s.nat))
+ (match (#.Some actual)
+ (n.= expected0 actual)))
+ (|> (list (code.int (.int expected0)))
+ (/.run (/.maybe s.nat))
+ (match #.None
+ #1))))
+ (_.cover [/.some]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.some s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) = expected+ actual)))
+ (|> (list@map (|>> .int code.int) expected+)
+ (/.run (/.some s.nat))
+ (match #.Nil
+ #1))))
+ (_.cover [/.many]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.many s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) = expected+ actual)))
+ (|> (list (code.nat expected0))
+ (/.run (/.many s.nat))
+ (match (list actual)
+ (n.= expected0 actual)))
+ (|> (list@map (|>> .int code.int) expected+)
+ (/.run (/.many s.nat))
+ fails?)))
+ (_.cover [/.filter]
+ (and (|> (list (code.nat even0))
+ (/.run (/.filter n.even? s.nat))
+ (match actual (n.= even0 actual)))
+ (|> (list (code.nat odd0))
+ (/.run (/.filter n.even? s.nat))
+ fails?)))
+ (_.cover [/.and]
+ (let [even (/.filter n.even? s.nat)
+ odd (/.filter n.odd? s.nat)]
+ (and (|> (list (code.nat even0) (code.nat odd0))
+ (/.run (/.and even odd))
+ (match [left right]
+ (and (n.= even0 left)
+ (n.= odd0 right))))
+ (|> (list (code.nat odd0) (code.nat even0))
+ (/.run (/.and even odd))
+ fails?))))
+ (_.cover [/.or]
+ (let [even (/.filter n.even? s.nat)
+ odd (/.filter n.odd? s.nat)]
+ (and (|> (list (code.nat even0))
+ (/.run (/.or even odd))
+ (match (#.Left actual) (n.= even0 actual)))
+ (|> (list (code.nat odd0))
+ (/.run (/.or even odd))
+ (match (#.Right actual) (n.= odd0 actual)))
+ (|> (list (code.bit not0))
+ (/.run (/.or even odd))
+ fails?))))
+ (_.cover [/.either]
+ (let [even (/.filter n.even? s.nat)
+ odd (/.filter n.odd? s.nat)]
+ (and (|> (list (code.nat even0))
+ (/.run (/.either even odd))
+ (match actual (n.= even0 actual)))
+ (|> (list (code.nat odd0))
+ (/.run (/.either even odd))
+ (match actual (n.= odd0 actual)))
+ (|> (list (code.bit not0))
+ (/.run (/.either even odd))
+ fails?))))
+ (_.cover [/.not]
+ (and (|> (list (code.nat expected0))
+ (/.run (/.not s.nat))
+ fails?)
+ (|> (list (code.bit not0))
+ (/.run (/.not s.nat))
+ (match [] #1))))
)))
(def: combinators-1
@@ -174,74 +173,74 @@
expected+ (random.list variadic random.nat)
separator (random.ascii 1)]
($_ _.and
- (_.test (%.name (name-of /.exactly))
- (and (|> (list@map code.nat expected+)
- (/.run (/.exactly times s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- (list.take times expected+)
- actual)))
- (|> (list@map code.nat expected+)
- (/.run (/.exactly (inc variadic) s.nat))
- fails?)))
- (_.test (%.name (name-of /.at-least))
- (and (|> (list@map code.nat expected+)
- (/.run (/.at-least times s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- expected+
- actual)))
- (|> (list@map code.nat expected+)
- (/.run (/.at-least (inc variadic) s.nat))
- fails?)))
- (_.test (%.name (name-of /.at-most))
- (and (|> (list@map code.nat expected+)
- (/.run (/.at-most times s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- (list.take times expected+)
- actual)))
- (|> (list@map code.nat expected+)
- (/.run (/.at-most (inc variadic) s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- expected+
- actual)))))
- (_.test (%.name (name-of /.between))
- (and (|> (list@map code.nat expected+)
- (/.run (/.between times variadic s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- expected+
- actual)))
- (|> (list@map code.nat (list.take times expected+))
- (/.run (/.between times variadic s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- (list.take times expected+)
- actual)))))
- (_.test (%.name (name-of /.sep-by))
- (|> (list.interpose (code.text separator) (list@map code.nat expected+))
- (/.run (/.sep-by (s.this! (code.text separator)) s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- expected+
- actual))))
- (_.test (%.name (name-of /.remaining))
- (|> (list@map code.nat expected+)
- (/.run /.remaining)
- (match actual
- (:: (list.equivalence code.equivalence) =
- (list@map code.nat expected+)
- actual))))
- (_.test (%.name (name-of /.default))
- (and (|> (/.run (/.default wrong (:: /.monad wrap expected)) (list))
- (match actual (n.= expected actual)))
- (|> (/.run (/.default expected (: (Parser (List Code) Nat)
- (/.fail "yolo")))
- (list))
- (match actual (n.= expected actual)))
- ))
+ (_.cover [/.exactly]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.exactly times s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ (list.take times expected+)
+ actual)))
+ (|> (list@map code.nat expected+)
+ (/.run (/.exactly (inc variadic) s.nat))
+ fails?)))
+ (_.cover [/.at-least]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.at-least times s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ expected+
+ actual)))
+ (|> (list@map code.nat expected+)
+ (/.run (/.at-least (inc variadic) s.nat))
+ fails?)))
+ (_.cover [/.at-most]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.at-most times s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ (list.take times expected+)
+ actual)))
+ (|> (list@map code.nat expected+)
+ (/.run (/.at-most (inc variadic) s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ expected+
+ actual)))))
+ (_.cover [/.between]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.between times variadic s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ expected+
+ actual)))
+ (|> (list@map code.nat (list.take times expected+))
+ (/.run (/.between times variadic s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ (list.take times expected+)
+ actual)))))
+ (_.cover [/.sep-by]
+ (|> (list.interpose (code.text separator) (list@map code.nat expected+))
+ (/.run (/.sep-by (s.this! (code.text separator)) s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ expected+
+ actual))))
+ (_.cover [/.remaining]
+ (|> (list@map code.nat expected+)
+ (/.run /.remaining)
+ (match actual
+ (:: (list.equivalence code.equivalence) =
+ (list@map code.nat expected+)
+ actual))))
+ (_.cover [/.default]
+ (and (|> (/.run (/.default wrong (:: /.monad wrap expected)) (list))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.default expected (: (Parser (List Code) Nat)
+ (/.fail "yolo")))
+ (list))
+ (match actual (n.= expected actual)))
+ ))
)))
(def: combinators-2
@@ -253,47 +252,47 @@
#let [even^ (/.filter n.even? s.nat)
odd^ (/.filter n.odd? s.nat)]]
($_ _.and
- (_.test (%.name (name-of /.rec))
- (let [parser (/.rec (function (_ self)
- (/.either s.nat
- (s.tuple self))))
- level-0 (code.nat expected)
- level-up (: (-> Code Code)
- (|>> list code.tuple))]
- (and (|> (list level-0)
- (/.run parser)
- (match actual (n.= expected actual)))
- (|> (list (level-up level-0))
- (/.run parser)
- (match actual (n.= expected actual)))
- (|> (list (level-up (level-up level-0)))
- (/.run parser)
- (match actual (n.= expected actual))))))
- (_.test (%.name (name-of /.after))
- (and (|> (/.run (/.after even^ s.nat)
- (list (code.nat even) (code.nat expected)))
- (match actual (n.= expected actual)))
- (|> (/.run (/.after even^ s.nat)
- (list (code.nat odd) (code.nat expected)))
- fails?)))
- (_.test (%.name (name-of /.before))
- (and (|> (/.run (/.before even^ s.nat)
- (list (code.nat expected) (code.nat even)))
- (match actual (n.= expected actual)))
- (|> (/.run (/.before even^ s.nat)
- (list (code.nat expected) (code.nat odd)))
- fails?)))
- (_.test (%.name (name-of /.parses?))
- (and (|> (/.run (/.parses? even^)
- (list (code.nat even)))
- (match verdict verdict))
- (|> (/.run (/.parses? even^)
- (list (code.nat odd)))
- (match verdict (not verdict)))))
- (_.test (%.name (name-of /.codec))
- (|> (/.run (/.codec n.decimal s.text)
- (list (code.text (%.nat expected))))
- (match actual (n.= expected actual))))
+ (_.cover [/.rec]
+ (let [parser (/.rec (function (_ self)
+ (/.either s.nat
+ (s.tuple self))))
+ level-0 (code.nat expected)
+ level-up (: (-> Code Code)
+ (|>> list code.tuple))]
+ (and (|> (list level-0)
+ (/.run parser)
+ (match actual (n.= expected actual)))
+ (|> (list (level-up level-0))
+ (/.run parser)
+ (match actual (n.= expected actual)))
+ (|> (list (level-up (level-up level-0)))
+ (/.run parser)
+ (match actual (n.= expected actual))))))
+ (_.cover [/.after]
+ (and (|> (/.run (/.after even^ s.nat)
+ (list (code.nat even) (code.nat expected)))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.after even^ s.nat)
+ (list (code.nat odd) (code.nat expected)))
+ fails?)))
+ (_.cover [/.before]
+ (and (|> (/.run (/.before even^ s.nat)
+ (list (code.nat expected) (code.nat even)))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.before even^ s.nat)
+ (list (code.nat expected) (code.nat odd)))
+ fails?)))
+ (_.cover [/.parses?]
+ (and (|> (/.run (/.parses? even^)
+ (list (code.nat even)))
+ (match verdict verdict))
+ (|> (/.run (/.parses? even^)
+ (list (code.nat odd)))
+ (match verdict (not verdict)))))
+ (_.cover [/.codec]
+ (|> (/.run (/.codec n.decimal s.text)
+ (list (code.text (%.nat expected))))
+ (match actual (n.= expected actual))))
)))
(def: injection
@@ -316,33 +315,37 @@
[expected random.nat
failure (random.ascii 1)
assertion (random.ascii 1)]
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
+ (_.with-cover [/.Parser])
($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
- (_.test (%.name (name-of /.run))
- (|> (/.run (:: /.monad wrap expected) (list))
- (match actual (n.= expected actual))))
- (_.test (%.name (name-of /.fail))
- (|> (list)
- (/.run (/.fail failure))
- (should-fail failure)))
- (_.test (%.name (name-of /.lift))
- (and (|> (list)
- (/.run (/.lift (#try.Success expected)))
- (match actual (n.= expected actual)))
- (|> (list)
- (/.run (/.lift (#try.Failure failure)))
- (should-fail failure))))
- (_.test (%.name (name-of /.assert))
- (and (|> (list (code.bit #1) (code.int +123))
- (/.run (/.assert assertion #1))
- (match [] true))
- (|> (list (code.bit #1) (code.int +123))
- (/.run (/.assert assertion #0))
- fails?)))
+ (_.cover [/.run]
+ (|> (/.run (:: /.monad wrap expected) (list))
+ (match actual (n.= expected actual))))
+ (_.cover [/.fail]
+ (|> (list)
+ (/.run (/.fail failure))
+ (should-fail failure)))
+ (_.cover [/.lift]
+ (and (|> (list)
+ (/.run (/.lift (#try.Success expected)))
+ (match actual (n.= expected actual)))
+ (|> (list)
+ (/.run (/.lift (#try.Failure failure)))
+ (should-fail failure))))
+ (_.cover [/.assert]
+ (and (|> (list (code.bit #1) (code.int +123))
+ (/.run (/.assert assertion #1))
+ (match [] true))
+ (|> (list (code.bit #1) (code.int +123))
+ (/.run (/.assert assertion #0))
+ fails?)))
..combinators-0
..combinators-1
..combinators-2
diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux
index 7bf7e5e0f..1efc39cbc 100644
--- a/stdlib/source/test/lux/control/pipe.lux
+++ b/stdlib/source/test/lux/control/pipe.lux
@@ -5,106 +5,105 @@
[monad (#+ do)]]
[data
["." identity]
- ["." name]
[number
["n" nat]]
["." text ("#@." equivalence)
["%" format (#+ format)]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
["." /]})
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do {@ r.monad}
- [sample r.nat]
+ (<| (_.covering /._)
+ (do {@ random.monad}
+ [sample random.nat]
($_ _.and
(do @
- [another r.nat]
- (_.test (%.name (name-of /.new>))
- (n.= (inc another)
- (|> sample
- (n.* 3)
- (n.+ 4)
- (/.new> another [inc])))))
- (_.test (%.name (name-of /.let>))
- (n.= (n.+ sample sample)
- (|> sample
- (/.let> x [(n.+ x x)]))))
- (_.test (%.name (name-of /.cond>))
- (text@= (cond (n.= 0 sample) "zero"
- (n.even? sample) "even"
- "odd")
+ [another random.nat]
+ (_.cover [/.new>]
+ (n.= (inc another)
(|> sample
- (/.cond> [(n.= 0)] [(/.new> "zero" [])]
- [n.even?] [(/.new> "even" [])]
- [(/.new> "odd" [])]))))
- (_.test (%.name (name-of /.if>))
- (text@= (if (n.even? sample)
- "even"
- "odd")
- (|> sample
- (/.if> [n.even?]
- [(/.new> "even" [])]
- [(/.new> "odd" [])]))))
- (_.test (%.name (name-of /.when>))
- (n.= (if (n.even? sample)
- (n.* 2 sample)
- sample)
- (|> sample
- (/.when> [n.even?]
- [(n.* 2)]))))
- (_.test (%.name (name-of /.loop>))
- (n.= (n.* 10 sample)
- (|> sample
- (/.loop> [(n.= (n.* 10 sample)) not]
- [(n.+ sample)]))))
- (_.test (%.name (name-of /.do>))
- (n.= (inc (n.+ 4 (n.* 3 sample)))
- (|> sample
- (/.do> identity.monad
- [(n.* 3)]
- [(n.+ 4)]
- [inc]))))
- (_.test (%.name (name-of /.exec>))
- (n.= (n.* 10 sample)
- (|> sample
- (/.exec> [%.nat (format "sample = ") log!])
- (n.* 10))))
- (_.test (%.name (name-of /.tuple>))
- (let [[left middle right] (|> sample
- (/.tuple> [inc]
- [dec]
- [%.nat]))]
- (and (n.= (inc sample) left)
- (n.= (dec sample) middle)
- (text@= (%.nat sample) right))))
- (_.test (%.name (name-of /.case>))
- (text@= (case (n.% 10 sample)
- 0 "zero"
- 1 "one"
- 2 "two"
- 3 "three"
- 4 "four"
- 5 "five"
- 6 "six"
- 7 "seven"
- 8 "eight"
- 9 "nine"
- _ "???")
- (|> sample
- (n.% 10)
- (/.case> 0 "zero"
- 1 "one"
- 2 "two"
- 3 "three"
- 4 "four"
- 5 "five"
- 6 "six"
- 7 "seven"
- 8 "eight"
- 9 "nine"
- _ "???"))))
+ (n.* 3)
+ (n.+ 4)
+ (/.new> another [inc])))))
+ (_.cover [/.let>]
+ (n.= (n.+ sample sample)
+ (|> sample
+ (/.let> x [(n.+ x x)]))))
+ (_.cover [/.cond>]
+ (text@= (cond (n.= 0 sample) "zero"
+ (n.even? sample) "even"
+ "odd")
+ (|> sample
+ (/.cond> [(n.= 0)] [(/.new> "zero" [])]
+ [n.even?] [(/.new> "even" [])]
+ [(/.new> "odd" [])]))))
+ (_.cover [/.if>]
+ (text@= (if (n.even? sample)
+ "even"
+ "odd")
+ (|> sample
+ (/.if> [n.even?]
+ [(/.new> "even" [])]
+ [(/.new> "odd" [])]))))
+ (_.cover [/.when>]
+ (n.= (if (n.even? sample)
+ (n.* 2 sample)
+ sample)
+ (|> sample
+ (/.when> [n.even?]
+ [(n.* 2)]))))
+ (_.cover [/.loop>]
+ (n.= (n.* 10 sample)
+ (|> sample
+ (/.loop> [(n.= (n.* 10 sample)) not]
+ [(n.+ sample)]))))
+ (_.cover [/.do>]
+ (n.= (inc (n.+ 4 (n.* 3 sample)))
+ (|> sample
+ (/.do> identity.monad
+ [(n.* 3)]
+ [(n.+ 4)]
+ [inc]))))
+ (_.cover [/.exec>]
+ (n.= (n.* 10 sample)
+ (|> sample
+ (/.exec> [%.nat (format "sample = ") log!])
+ (n.* 10))))
+ (_.cover [/.tuple>]
+ (let [[left middle right] (|> sample
+ (/.tuple> [inc]
+ [dec]
+ [%.nat]))]
+ (and (n.= (inc sample) left)
+ (n.= (dec sample) middle)
+ (text@= (%.nat sample) right))))
+ (_.cover [/.case>]
+ (text@= (case (n.% 10 sample)
+ 0 "zero"
+ 1 "one"
+ 2 "two"
+ 3 "three"
+ 4 "four"
+ 5 "five"
+ 6 "six"
+ 7 "seven"
+ 8 "eight"
+ 9 "nine"
+ _ "???")
+ (|> sample
+ (n.% 10)
+ (/.case> 0 "zero"
+ 1 "one"
+ 2 "two"
+ 3 "three"
+ 4 "four"
+ 5 "five"
+ 6 "six"
+ 7 "seven"
+ 8 "eight"
+ 9 "nine"
+ _ "???"))))
))))
diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux
index 29a21d045..7b6a8a8c3 100644
--- a/stdlib/source/test/lux/control/reader.lux
+++ b/stdlib/source/test/lux/control/reader.lux
@@ -9,13 +9,10 @@
["$." apply]
["$." monad]]}]
[data
- ["." name]
[number
- ["n" nat]]
- [text
- ["%" format (#+ format)]]]
+ ["n" nat]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
["." / (#+ Reader)
[//
@@ -33,28 +30,32 @@
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do r.monad
- [sample r.nat
- factor r.nat]
+ (<| (_.covering /._)
+ (_.with-cover [/.Reader])
+ (do random.monad
+ [sample random.nat
+ factor random.nat]
($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
- (_.test (%.name (name-of /.ask))
- (n.= sample
- (/.run sample /.ask)))
- (_.test (%.name (name-of /.local))
- (n.= (n.* factor sample)
- (/.run sample (/.local (n.* factor) /.ask))))
+ (_.cover [/.run /.ask]
+ (n.= sample
+ (/.run sample /.ask)))
+ (_.cover [/.local]
+ (n.= (n.* factor sample)
+ (/.run sample (/.local (n.* factor) /.ask))))
(let [(^open "io@.") io.monad]
- (_.test (%.name (name-of /.with))
- (|> (: (/.Reader Any (IO Nat))
- (do (/.with io.monad)
- [a (/.lift (io@wrap sample))
- b (wrap factor)]
- (wrap (n.* b a))))
- (/.run [])
- io.run
- (n.= (n.* factor sample)))))))))
+ (_.cover [/.with /.lift]
+ (|> (: (/.Reader Any (IO Nat))
+ (do (/.with io.monad)
+ [a (/.lift (io@wrap sample))
+ b (wrap factor)]
+ (wrap (n.* b a))))
+ (/.run [])
+ io.run
+ (n.= (n.* factor sample)))))))))
diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux
index 550b3b872..763a4be0c 100644
--- a/stdlib/source/test/lux/control/region.lux
+++ b/stdlib/source/test/lux/control/region.lux
@@ -15,15 +15,12 @@
[control
["." try (#+ Try)]]
[data
- ["." name]
[number
["n" nat]]
- [text
- ["%" format (#+ format)]]
[collection
["." list]]]
[math
- ["r" random]]
+ ["." random]]
[type (#+ :share)]]
{1
["." / (#+ Region)
@@ -75,107 +72,111 @@
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do {@ r.monad}
- [expected-clean-ups (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1))))]
+ (<| (_.covering /._)
+ (_.with-cover [/.Region])
+ (do {@ random.monad}
+ [expected-clean-ups (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1))))]
($_ _.and
- ($functor.spec ..injection ..comparison (: (All [! r]
- (Functor (Region r (thread.Thread !))))
- (/.functor thread.functor)))
- ($apply.spec ..injection ..comparison (: (All [! r]
- (Apply (Region r (thread.Thread !))))
- (/.apply thread.monad)))
- ($monad.spec ..injection ..comparison (: (All [! r]
- (Monad (Region r (thread.Thread !))))
- (/.monad thread.monad)))
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison (: (All [! r]
+ (Functor (Region r (thread.Thread !))))
+ (/.functor thread.functor))))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison (: (All [! r]
+ (Apply (Region r (thread.Thread !))))
+ (/.apply thread.monad))))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison (: (All [! r]
+ (Monad (Region r (thread.Thread !))))
+ (/.monad thread.monad))))
- (_.test (%.name (name-of /.run))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @
- count-clean-up (function (_ value)
- (do @
- [_ (thread.update inc clean-up-counter)]
- (wrap (#try.Success []))))]
- outcome (/.run @
- (do {@ (/.monad @)}
- [_ (monad.map @ (/.acquire //@ count-clean-up)
- (enum.range n.enum 1 expected-clean-ups))]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (success? outcome)
- (n.= expected-clean-ups
- actual-clean-ups))))))
- (_.test (%.name (name-of /.fail))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @
- count-clean-up (function (_ value)
- (do @
- [_ (thread.update inc clean-up-counter)]
- (wrap (#try.Success []))))]
- outcome (/.run @
- (do {@ (/.monad @)}
- [_ (monad.map @ (/.acquire //@ count-clean-up)
- (enum.range n.enum 1 expected-clean-ups))
- _ (/.fail //@ (exception.construct ..oops []))]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (failure? outcome)
- (n.= expected-clean-ups
- actual-clean-ups))))))
- (_.test (%.name (name-of /.throw))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @
- count-clean-up (function (_ value)
- (do @
- [_ (thread.update inc clean-up-counter)]
- (wrap (#try.Success []))))]
- outcome (/.run @
- (do {@ (/.monad @)}
- [_ (monad.map @ (/.acquire //@ count-clean-up)
- (enum.range n.enum 1 expected-clean-ups))
- _ (/.throw //@ ..oops [])]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (failure? outcome)
- (n.= expected-clean-ups
- actual-clean-ups))))))
- (_.test (%.name (name-of /.acquire))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @
- count-clean-up (function (_ value)
- (do @
- [_ (thread.update inc clean-up-counter)]
- (wrap (: (Try Any)
- (exception.throw ..oops [])))))]
- outcome (/.run @
- (do {@ (/.monad @)}
- [_ (monad.map @ (/.acquire //@ count-clean-up)
- (enum.range n.enum 1 expected-clean-ups))]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (or (n.= 0 expected-clean-ups)
- (failure? outcome))
- (n.= expected-clean-ups
- actual-clean-ups))))))
- (_.test (%.name (name-of /.lift))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @]
- outcome (/.run @
- (do (/.monad @)
- [_ (/.lift //@ (thread.write expected-clean-ups clean-up-counter))]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (success? outcome)
- (n.= expected-clean-ups
- actual-clean-ups))))))
+ (_.cover [/.run]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @
+ count-clean-up (function (_ value)
+ (do @
+ [_ (thread.update inc clean-up-counter)]
+ (wrap (#try.Success []))))]
+ outcome (/.run @
+ (do {@ (/.monad @)}
+ [_ (monad.map @ (/.acquire //@ count-clean-up)
+ (enum.range n.enum 1 expected-clean-ups))]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (success? outcome)
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
+ (_.cover [/.fail]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @
+ count-clean-up (function (_ value)
+ (do @
+ [_ (thread.update inc clean-up-counter)]
+ (wrap (#try.Success []))))]
+ outcome (/.run @
+ (do {@ (/.monad @)}
+ [_ (monad.map @ (/.acquire //@ count-clean-up)
+ (enum.range n.enum 1 expected-clean-ups))
+ _ (/.fail //@ (exception.construct ..oops []))]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (failure? outcome)
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
+ (_.cover [/.throw]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @
+ count-clean-up (function (_ value)
+ (do @
+ [_ (thread.update inc clean-up-counter)]
+ (wrap (#try.Success []))))]
+ outcome (/.run @
+ (do {@ (/.monad @)}
+ [_ (monad.map @ (/.acquire //@ count-clean-up)
+ (enum.range n.enum 1 expected-clean-ups))
+ _ (/.throw //@ ..oops [])]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (failure? outcome)
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
+ (_.cover [/.acquire]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @
+ count-clean-up (function (_ value)
+ (do @
+ [_ (thread.update inc clean-up-counter)]
+ (wrap (: (Try Any)
+ (exception.throw ..oops [])))))]
+ outcome (/.run @
+ (do {@ (/.monad @)}
+ [_ (monad.map @ (/.acquire //@ count-clean-up)
+ (enum.range n.enum 1 expected-clean-ups))]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (or (n.= 0 expected-clean-ups)
+ (failure? outcome))
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
+ (_.cover [/.lift]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @]
+ outcome (/.run @
+ (do (/.monad @)
+ [_ (/.lift //@ (thread.write expected-clean-ups clean-up-counter))]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (success? outcome)
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
))))
diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux
index d193cc159..4a4f8409a 100644
--- a/stdlib/source/test/lux/control/security/policy.lux
+++ b/stdlib/source/test/lux/control/security/policy.lux
@@ -14,12 +14,11 @@
[security
["!" capability]]]
[data
- ["." name]
["." text ("#@." equivalence)]
[number
["n" nat]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private with-policy)]})
@@ -71,22 +70,31 @@
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do r.monad
+ (<| (_.covering /._)
+ (_.with-cover [/.Policy
+ /.Can-Upgrade /.Can-Downgrade
+ /.can-upgrade /.can-downgrade])
+ (do random.monad
[#let [policy-0 (policy [])]
- raw-password (r.ascii 10)
+ raw-password (random.ascii 10)
#let [password (:: policy-0 password raw-password)]]
($_ _.and
- ($functor.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.functor)
- ($apply.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.apply)
- ($monad.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.monad)
+ (_.with-cover [/.Privacy /.Private
+ /.Can-Conceal /.Can-Reveal]
+ ($_ _.and
+ (_.with-cover [/.functor]
+ ($functor.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.monad))))
- (_.test "Can work with private values under the same label."
- (and (:: policy-0 = password password)
- (n.= (:: text.hash hash raw-password)
- (:: policy-0 hash password))))
+ (_.cover [/.Privilege /.Context /.with-policy]
+ (and (:: policy-0 = password password)
+ (n.= (:: text.hash hash raw-password)
+ (:: policy-0 hash password))))
(let [policy-1 (policy [])
delegate (/.delegation (:: policy-0 can-downgrade) (:: policy-1 can-upgrade))]
- (_.test "Can use delegation to share private values between policies."
- (:: policy-1 = (delegate password) (delegate password))))
+ (_.cover [/.Delegation /.delegation]
+ (:: policy-1 = (delegate password) (delegate password))))
))))
diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux
new file mode 100644
index 000000000..1bb81e06a
--- /dev/null
+++ b/stdlib/source/test/lux/locale/language.lux
@@ -0,0 +1,266 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ [hash (#+ Hash)]]
+ [data
+ ["." text]
+ [number
+ ["n" nat]]
+ [collection
+ ["." set (#+ Set)]
+ ["." list ("#@." functor fold)]]]
+ [macro
+ ["." template]]
+ [math
+ ["." random]]]
+ {1
+ ["." /]})
+
+(type: Bundle
+ {#count Nat
+ #names (Set Text)
+ #codes (Set Text)
+ #languages (Set /.Language)
+ #test Test})
+
+(template [<bundle> <languages>]
+ [(def: <bundle>
+ Bundle
+ (let [count (template.count <languages>)
+ languages (: (List /.Language)
+ (`` (list (~~ (template.splice <languages>)))))]
+ {#count count
+ #names (|> languages (list@map /.name) (set.from-list text.hash))
+ #codes (|> languages (list@map /.code) (set.from-list text.hash))
+ #languages (|> languages (set.from-list /.hash))
+ #test (_.cover <languages>
+ true)}))]
+
+ [languages/a [/.afar /.abkhazian /.achinese /.acoli /.adangme
+ /.adyghe /.afro-asiatic /.afrihili /.afrikaans /.ainu
+ /.akan /.akkadian /.aleut /.algonquian /.southern-altai
+ /.amharic /.old-english /.angika /.apache /.arabic
+ /.official-aramaic /.aragonese /.mapudungun /.arapaho /.artificial
+ /.arawak /.assamese /.asturian /.athapascan /.australian
+ /.avaric /.avestan /.awadhi /.aymara /.azerbaijani]]
+ [languages/b [/.banda /.bamileke /.bashkir /.baluchi /.bambara
+ /.balinese /.basa /.baltic /.beja /.belarusian
+ /.bemba /.bengali /.berber /.bhojpuri /.bihari
+ /.bikol /.bini /.bislama /.siksika /.bantu
+ /.tibetan /.bosnian /.braj /.breton /.batak
+ /.buriat /.buginese /.bulgarian /.blin]]
+ [languages/c [/.caddo /.central-american-indian /.galibi-carib /.catalan /.caucasian
+ /.cebuano /.celtic /.czech /.chamorro /.chibcha
+ /.chechen /.chagatai /.chuukese /.mari /.chinook
+ /.choctaw /.chipewyan /.cherokee /.church-slavic /.chuvash
+ /.cheyenne /.chamic /.montenegrin /.coptic /.cornish
+ /.corsican /.creoles-and-pidgins/english /.creoles-and-pidgins/french /.creoles-and-pidgins/portuguese /.cree
+ /.crimean /.creoles-and-pidgins /.kashubian /.cushitic /.welsh]]
+ [languages/d [/.dakota /.danish /.dargwa /.land-dayak /.delaware
+ /.slavey /.dogrib /.dinka /.dhivehi /.dogri
+ /.dravidian /.lower-sorbian /.duala /.middle-dutch /.dyula
+ /.dzongkha]]
+ [languages/e [/.efik /.egyptian /.ekajuk /.greek /.elamite
+ /.english /.middle-english /.esperanto /.estonian /.basque
+ /.ewe /.ewondo]]
+ [languages/f [/.fang /.faroese /.persian /.fanti /.fijian
+ /.filipino /.finnish /.finno-ugrian /.fon /.french
+ /.middle-french /.old-french /.northern-frisian /.eastern-frisian /.western-frisian
+ /.fulah /.friulian]]
+ [languages/g [/.ga /.gayo /.gbaya /.germanic /.german
+ /.geez /.gilbertese /.gaelic /.irish /.galician
+ /.manx /.middle-high-german /.old-high-german /.gondi /.gorontalo
+ /.gothic /.grebo /.ancient-greek /.guarani /.swiss-german
+ /.gujarati /.gwich'in]]
+ [languages/h [/.haida /.haitian /.hausa /.hawaiian /.hebrew
+ /.herero /.hiligaynon /.himachali /.hindi /.hittite
+ /.hmong /.hiri-motu /.croatian /.upper-sorbian /.hungarian
+ /.hupa /.armenian]]
+ [languages/i [/.iban /.igbo /.ido /.sichuan-yi /.ijo
+ /.inuktitut /.interlingue /.iloko /.interlingua /.indic
+ /.indonesian /.indo-european /.ingush /.inupiaq /.iranian
+ /.iroquoian /.icelandic /.italian]]
+ [languages/j [/.javanese /.lojban /.japanese /.judeo-persian /.judeo-arabic]]
+ [languages/k [/.kara-kalpak /.kabyle /.kachin /.kalaallisut /.kamba
+ /.kannada /.karen /.kashmiri /.georgian /.kanuri
+ /.kawi /.kazakh /.kabardian /.khasi /.khoisan
+ /.central-khmer /.khotanese /.gikuyu /.kinyarwanda /.kyrgyz
+ /.kimbundu /.konkani /.komi /.kongo /.korean
+ /.kosraean /.kpelle /.karachay-balkar /.karelian /.kru
+ /.kurukh /.kwanyama /.kumyk /.kurdish /.kutenai]]
+ [languages/l [/.ladino /.lahnda /.lamba /.lao /.latin
+ /.latvian /.lezghian /.limburgan /.lingala /.lithuanian
+ /.mongo /.lozi /.luxembourgish /.luba-lulua /.luba-katanga
+ /.ganda /.luiseno /.lunda /.luo /.lushai]]
+ [languages/m [/.madurese /.magahi /.marshallese /.maithili /.makasar
+ /.malayalam /.mandingo /.austronesian /.marathi /.masai
+ /.moksha /.mandar /.mende /.middle-irish /.mi'kmaq
+ /.minangkabau /.macedonian /.mon-khmer /.malagasy /.maltese
+ /.manchu /.manipuri /.manobo /.mohawk /.mongolian
+ /.mossi /.maori /.malay /.munda /.creek
+ /.mirandese /.marwari /.burmese /.mayan /.erzya]]
+ [languages/n [/.nahuatl /.north-american-indian /.neapolitan /.nauru /.navajo
+ /.south-ndebele /.north-ndebele /.ndonga /.low-german /.nepali
+ /.newari /.nias /.niger-kordofanian /.niuean /.dutch
+ /.nynorsk /.bokmal /.nogai /.old-norse /.norwegian
+ /.n'ko /.northern-sotho /.nubian /.old-newari /.nyanja
+ /.nyamwezi /.nyankole /.nyoro /.nzima]]
+ [languages/o [/.occitan /.ojibwa /.oriya /.oromo /.osage
+ /.ossetic /.ottoman-turkish /.otomian]]
+ [languages/p [/.papuan /.pangasinan /.pahlavi /.pampanga /.punjabi
+ /.papiamento /.palauan /.old-persian /.philippine /.phoenician
+ /.pali /.polish /.pohnpeian /.portuguese /.prakrit
+ /.old-provencal /.pashto]]
+ [languages/q [/.quechua]]
+ [languages/r [/.rajasthani /.rapanui /.rarotongan /.romance /.romansh
+ /.romany /.romanian /.rundi /.aromanian /.russian]]
+ [languages/s [/.sandawe /.sango /.yakut /.south-american-indian /.salishan
+ /.samaritan-aramaic /.sanskrit /.sasak /.santali /.sicilian
+ /.scots /.selkup /.semitic /.old-irish /.sign
+ /.shan /.sidamo /.sinhalese /.siouan /.sino-tibetan
+ /.slavic /.slovak /.slovenian /.southern-sami /.northern-sami
+ /.sami /.lule /.inari /.samoan /.skolt-sami
+ /.shona /.sindhi /.soninke /.sogdian /.somali
+ /.songhai /.southern-sotho /.spanish /.albanian /.sardinian
+ /.sranan-tongo /.serbian /.serer /.nilo-saharan /.swati
+ /.sukuma /.sundanese /.susu /.sumerian /.swahili
+ /.swedish /.classical-syriac /.syriac]]
+ [languages/t [/.tahitian /.tai /.tamil /.tatar /.telugu
+ /.timne /.tereno /.tetum /.tajik /.tagalog
+ /.thai /.tigre /.tigrinya /.tiv /.tokelau
+ /.klingon /.tlingit /.tamashek /.tonga /.tongan
+ /.tok-pisin /.tsimshian /.tswana /.tsonga /.turkmen
+ /.tumbuka /.tupi /.turkish /.altaic /.tuvalu
+ /.twi /.tuvinian]]
+ [languages/u [/.udmurt /.ugaritic /.uyghur /.ukrainian /.umbundu
+ /.urdu /.uzbek]]
+ [languages/v [/.vai /.venda /.vietnamese /.volapük /.votic]]
+ [languages/w [/.wakashan /.walamo /.waray /.washo /.sorbian
+ /.walloon /.wolof]]
+ [languages/x [/.kalmyk /.xhosa]]
+ [languages/y [/.yao /.yapese /.yiddish /.yoruba /.yupik]]
+ [languages/z [/.zapotec /.blissymbols /.zenaga /.standard-moroccan-tamazight /.zhuang
+ /.chinese /.zande /.zulu /.zuni /.zaza]]
+ [languages/etc [/.uncoded /.multiple /.undetermined /.not-applicable]]
+ )
+
+(def: languages
+ (List Bundle)
+ (list ..languages/a
+ ..languages/b
+ ..languages/c
+ ..languages/d
+ ..languages/e
+ ..languages/f
+ ..languages/g
+ ..languages/h
+ ..languages/i
+ ..languages/j
+ ..languages/k
+ ..languages/l
+ ..languages/m
+ ..languages/n
+ ..languages/o
+ ..languages/p
+ ..languages/q
+ ..languages/r
+ ..languages/s
+ ..languages/t
+ ..languages/u
+ ..languages/v
+ ..languages/w
+ ..languages/x
+ ..languages/y
+ ..languages/z
+ ..languages/etc))
+
+(def: (aggregate lens hash territories)
+ (All [a] (-> (-> Bundle (Set a))
+ (Hash a)
+ (List Bundle)
+ [Nat (Set a)]))
+ (list@fold (function (_ bundle [count set])
+ [(n.+ count (get@ #count bundle))
+ (set.union set (lens bundle))])
+ [0 (set.new hash)]
+ territories))
+
+(def: languages-test
+ Test
+ (|> ..languages
+ list.reverse
+ (list@map (get@ #test))
+ (list@fold _.and
+ (`` ($_ _.and
+ (~~ (template [<lens> <tag> <hash>]
+ [(let [[count set] (..aggregate (get@ <tag>) <hash> ..languages)]
+ (_.cover [<lens>]
+ (n.= count (set.size set))))]
+
+ [/.name #names text.hash]
+ [/.code #codes text.hash]
+ [/.equivalence #languages /.hash]
+ ))
+ )))))
+
+(template: (!aliases <reference> <aliases>)
+ (_.cover <aliases>
+ (list.every? (:: /.equivalence = <reference>)
+ (`` (list (~~ (template.splice <aliases>)))))))
+
+(def: aliases-test
+ Test
+ ($_ _.and
+ ## A
+ (!aliases /.official-aramaic [/.imperial-aramaic])
+ (!aliases /.asturian [/.bable /.leonese /.asturleonese])
+ ## B
+ (!aliases /.bini [/.edo])
+ (!aliases /.blin [/.bilin])
+ ## C
+ (!aliases /.catalan [/.valencian])
+ (!aliases /.church-slavic [/.old-slavonic /.church-slavonic /.old-bulgarian /.old-church-slavonic])
+ ## D
+ (!aliases /.dhivehi [/.maldivian])
+ ## G
+ (!aliases /.swiss-german [/.alemannic /.alsatian])
+ ## I
+ (!aliases /.sichuan-yi [/.nuosu])
+ ## K
+ (!aliases /.kachin [/.jingpho])
+ (!aliases /.kalaallisut [/.greenlandic])
+ (!aliases /.khotanese [/.sakan])
+ ## M
+ (!aliases /.mi'kmaq [/.micmac])
+ ## N
+ (!aliases /.newari [/.nepal-bhasa])
+ (!aliases /.dutch [/.flemish])
+ (!aliases /.northern-sotho [/.pedi /.sepedi])
+ (!aliases /.old-newari [/.classical-newari /.classical-nepal-bhasa])
+ (!aliases /.nyanja [/.chichewa /.chewa])
+ ## O
+ (!aliases /.occitan [/.provencal])
+ ## P
+ (!aliases /.pampanga [/.kapampangan])
+ ## R
+ (!aliases /.rarotongan [/.cook-islands-maori])
+ (!aliases /.romanian [/.moldavian /.moldovan])
+ (!aliases /.aromanian [/.arumanian /.macedo-romanian])
+ ## S
+ (!aliases /.spanish [/.castilian])
+ ## X
+ (!aliases /.kalmyk [/.oirat])
+ ## Z
+ (!aliases /.zaza [/.dimili /.dimli /.kirdki /.kirmanjki /.zazaki])
+ ))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Language])
+ ($_ _.and
+ ..languages-test
+ ..aliases-test
+ )))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 18366de69..437621fb4 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -693,19 +693,17 @@
_ instruction
_ /.i2l]
..$Long::wrap)))))
+ ## https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op
+ comparison-standard (: (-> java/lang/Double java/lang/Double Bit)
+ (function (_ reference subject)
+ (for {@.old
+ ("jvm dgt" subject reference)
+
+ @.jvm
+ ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))})))
comparison ($_ _.and
- (_.lift "DCMPL" (comparison /.dcmpl (function (_ reference subject)
- (for {@.old
- ("jvm dlt" subject reference)
-
- @.jvm
- ("jvm double <" ("jvm object cast" reference) ("jvm object cast" subject))}))))
- (_.lift "DCMPG" (comparison /.dcmpg (function (_ reference subject)
- (for {@.old
- ("jvm dgt" subject reference)
-
- @.jvm
- ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))})))))]
+ (_.lift "DCMPL" (comparison /.dcmpl comparison-standard))
+ (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))]
($_ _.and
(<| (_.context "literal")
literal)
--
cgit v1.2.3