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/project.clj | 3 + 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 +- 20 files changed, 1751 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') diff --git a/stdlib/project.clj b/stdlib/project.clj index d37eb70e7..8a79475c2 100644 --- a/stdlib/project.clj +++ b/stdlib/project.clj @@ -24,6 +24,9 @@ :profiles {:bibliotheca {:description "Standard library for the Lux programming language." :dependencies [] :lux {:test "test/lux"}} + :aedifex {:description "A build system/tool made exclusively for Lux." + :dependencies [] + :lux {:program "program/aedifex"}} :scriptum {:description "A documentation generator for Lux code." :dependencies [] :lux {:program "program/scriptum"}} 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 [ ] + [(def: #export + (-> Language Text) + (|>> :representation (get@ )))] - (template [ +] - [(def: #export Language (:abstraction )) + [name #name] + [code #code] + ) + + (template [ +] + [(def: #export + Language + (:abstraction {#name + #code })) (`` (template [] - [(def: #export Language )] + [(def: #export + Language + )] (~~ (template.splice +))))] - ["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:)] + ["" 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) (.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 [ ] + [(def: #export + 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 + ["" code (#+ Parser)]]] + [data + ["." text]] + [world + [net (#+ URL)]]] + [// + ["/" project] + ["//." dependency]]) + +(def: group + (Parser /.Group) + .text) + +(def: name + (Parser /.Name) + .text) + +(def: version + (Parser /.Version) + .text) + +(def: artifact' + (Parser /.Artifact) + ($_ <>.and ..group ..name ..version)) + +(def: artifact + (Parser /.Artifact) + (.tuple ..artifact')) + +(def: url + (Parser URL) + .text) + +(def: scm + (Parser /.SCM) + ..url) + +(def: license + (Parser /.License) + (.tuple ($_ <>.and + ..name + ..url + (<>.default #/.Repo + (<>.or (.this! (' #repo)) + (.this! (' #manual))))))) + +(def: organization + (Parser /.Organization) + (<| .form + (<>.after (.this! (' #organization))) + ($_ <>.and + ..name + ..url))) + +(def: developer' + (Parser /.Developer) + ($_ <>.and + ..name + ..url + (<>.maybe ..organization) + )) + +(def: developer + (Parser /.Developer) + (<| .form + (<>.after (.this! (' #developer))) + ..developer')) + +(def: contributor + (Parser /.Contributor) + (<| .form + (<>.after (.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)))) + (.form (<>.after (.this! tag) + (<>.some parser)))) + +(def: info + (Parser /.Info) + ($_ <>.and + (<>.maybe ..url) + (<>.maybe ..scm) + (<>.maybe .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) + .text) + +(def: dependency + (Parser /.Dependency) + (.tuple + ($_ <>.and + ..artifact' + (<>.default //dependency.lux-library ..type) + ))) + +(def: #export project + (Parser /.Project) + (<| .form + (<>.after (.this! (' project:))) + (`` ($_ <>.and + ..artifact + (<| (<>.default ..no-info) + .form + (<>.after (.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 [ ] + [(def: + Bundle + (let [count (template.count ) + languages (: (List /.Language) + (`` (list (~~ (template.splice )))))] + {#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 + 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 [ ] + [(let [[count set] (..aggregate (get@ ) ..languages)] + (_.cover [] + (n.= count (set.size set))))] + + [/.name #names text.hash] + [/.code #codes text.hash] + [/.equivalence #languages /.hash] + )) + ))))) + +(template: (!aliases ) + (_.cover + (list.every? (:: /.equivalence = ) + (`` (list (~~ (template.splice ))))))) + +(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