From 664e02d1b5e5aa479869c4e17ec4128f5cfd04e2 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Jun 2022 03:15:23 -0400 Subject: New "parser" hierarchy. [Part 6] --- stdlib/source/documentation/lux/world.lux | 6 +- stdlib/source/documentation/lux/world/console.lux | 40 +- .../source/documentation/lux/world/environment.lux | 31 ++ stdlib/source/documentation/lux/world/file.lux | 87 ++-- .../source/documentation/lux/world/file/watch.lux | 57 ++- .../documentation/lux/world/input/keyboard.lux | 20 +- stdlib/source/documentation/lux/world/net.lux | 25 +- .../documentation/lux/world/net/http/client.lux | 52 +-- .../documentation/lux/world/net/http/status.lux | 232 ++++------- stdlib/source/documentation/lux/world/net/uri.lux | 15 +- .../lux/world/output/video/resolution.lux | 86 ++-- stdlib/source/documentation/lux/world/program.lux | 34 -- stdlib/source/documentation/lux/world/shell.lux | 57 ++- .../library/lux/control/parser/environment.lux | 44 --- stdlib/source/library/lux/test.lux | 4 +- stdlib/source/library/lux/world/environment.lux | 439 ++++++++++++++++++++ stdlib/source/library/lux/world/net/http.lux | 9 +- stdlib/source/library/lux/world/program.lux | 440 --------------------- stdlib/source/library/lux/world/shell.lux | 8 +- stdlib/source/parser/lux/world/environment.lux | 44 +++ .../source/specification/lux/world/environment.lux | 32 ++ stdlib/source/specification/lux/world/program.lux | 32 -- stdlib/source/specification/lux/world/shell.lux | 8 +- stdlib/source/test/lux/control/parser.lux | 6 +- .../source/test/lux/control/parser/environment.lux | 53 --- stdlib/source/test/lux/world.lux | 4 +- stdlib/source/test/lux/world/environment.lux | 113 ++++++ stdlib/source/test/lux/world/program.lux | 78 ---- stdlib/source/test/lux/world/shell.lux | 8 +- 29 files changed, 953 insertions(+), 1111 deletions(-) create mode 100644 stdlib/source/documentation/lux/world/environment.lux delete mode 100644 stdlib/source/documentation/lux/world/program.lux delete mode 100644 stdlib/source/library/lux/control/parser/environment.lux create mode 100644 stdlib/source/library/lux/world/environment.lux delete mode 100644 stdlib/source/library/lux/world/program.lux create mode 100644 stdlib/source/parser/lux/world/environment.lux create mode 100644 stdlib/source/specification/lux/world/environment.lux delete mode 100644 stdlib/source/specification/lux/world/program.lux delete mode 100644 stdlib/source/test/lux/control/parser/environment.lux create mode 100644 stdlib/source/test/lux/world/environment.lux delete mode 100644 stdlib/source/test/lux/world/program.lux (limited to 'stdlib/source') diff --git a/stdlib/source/documentation/lux/world.lux b/stdlib/source/documentation/lux/world.lux index 2bcdaf3b3..7376eb311 100644 --- a/stdlib/source/documentation/lux/world.lux +++ b/stdlib/source/documentation/lux/world.lux @@ -2,7 +2,7 @@ [library [lux (.except) [program (.only program:)] - ["$" documentation (.only documentation:)] + ["$" documentation] ["[0]" debug] [control ["[0]" io]] @@ -18,7 +18,7 @@ ["[1][0]" output ["[1]/[0]" video ["[1]/[0]" resolution]]] - ["[1][0]" program] + ["[1][0]" environment] ["[1][0]" shell]]) (.def .public documentation @@ -29,5 +29,5 @@ /input/keyboard.documentation /net.documentation /output/video/resolution.documentation - /program.documentation + /environment.documentation /shell.documentation)) diff --git a/stdlib/source/documentation/lux/world/console.lux b/stdlib/source/documentation/lux/world/console.lux index 9c5004ae1..44376fa63 100644 --- a/stdlib/source/documentation/lux/world/console.lux +++ b/stdlib/source/documentation/lux/world/console.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] ["@" target] [data ["[0]" text (.only \n) @@ -11,32 +11,28 @@ [\\library ["[0]" /]]) -(documentation: (/.Console !) - "An interface to console/terminal I/O.") - -(documentation: /.write_line - "Writes the message on the console and appends a new-line/line-feed at the end." - [(write_line message console)]) - -(documentation: (/.Mock s) - (format "A mock/simulation of a console." - \n "Useful for testing.")) - -(documentation: /.mock - "" - [(mock mock init)]) - (.def .public documentation (.List $.Module) (`` (`` ($.module /._ "" - [..Console - ..write_line - ..Mock - ..mock - ($.default /.async) + [($.default /.async) (~~ (for @.jvm (~~ (these ($.default /.cannot_open) ($.default /.cannot_close) ($.default /.default))) - (~~ (these))))] + (~~ (these)))) + + ($.documentation (/.Console !) + "An interface to console/terminal I/O.") + + ($.documentation /.write_line + "Writes the message on the console and appends a new-line/line-feed at the end." + [(write_line message console)]) + + ($.documentation (/.Mock s) + (format "A mock/simulation of a console." + \n "Useful for testing.")) + + ($.documentation /.mock + "" + [(mock mock init)])] [])))) diff --git a/stdlib/source/documentation/lux/world/environment.lux b/stdlib/source/documentation/lux/world/environment.lux new file mode 100644 index 000000000..b8663936b --- /dev/null +++ b/stdlib/source/documentation/lux/world/environment.lux @@ -0,0 +1,31 @@ +(.require + [library + [lux (.except) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]] + [macro + ["[0]" template]]]] + [\\library + ["[0]" /]]) + +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.unknown_environment_variable) + ($.default /.async) + ($.default /.default) + + ($.documentation (/.Environment !) + "Access to ambient environment data and the capacity to exit the program.") + + ($.documentation /.environment + "Assembles the environment variables available to the program." + [(environment monad program)]) + + ($.documentation /.mock + "" + [(mock environment home directory)])] + [])) diff --git a/stdlib/source/documentation/lux/world/file.lux b/stdlib/source/documentation/lux/world/file.lux index 753ebd8ea..3ae7449e6 100644 --- a/stdlib/source/documentation/lux/world/file.lux +++ b/stdlib/source/documentation/lux/world/file.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] ["@" target] [data ["[0]" text (.only \n) @@ -13,61 +13,52 @@ ["[0]" / ["[1][0]" watch]]) -(documentation: /.Path - "A path to a file or a directory in a file-system.") - -(documentation: (/.System !) - "An interface to a file-system.") - -(documentation: /.parent - "If a path represents a nested file/directory, extracts its parent directory." - [(parent fs path)]) - -(documentation: /.name - "The un-nested name of a file/directory." - [(name fs path)]) - -(documentation: /.rooted - "A nested path for a file/directory, given a root/parent path and a file/directory name within it." - [(rooted fs parent child)]) - -(documentation: /.exists? - "Checks if either a file or a directory exists at the given path." - [(exists? monad fs path)]) - -(documentation: /.mock - (format "A purely in-memory simulation of a file-system." - \n "Useful for testing.") - [(mock separator)]) - -(documentation: /.make_directories - (format "Creates the directory specified by the given path." - \n "Also, creates every super-directory necessary to make the given path valid.") - [(make_directories monad fs path)]) - -(documentation: /.make_file - "Creates a new file with the given content if-and-only-if the file does not already exist." - [(make_file monad fs content path)]) - (.def .public documentation (.List $.Module) (`` (`` ($.module /._ "" - [..Path - ..System - ..parent - ..name - ..rooted - ..exists? - ..mock - ..make_directories - ..make_file - ($.default /.async) + [($.default /.async) ($.default /.cannot_make_file) ($.default /.cannot_find_file) ($.default /.cannot_delete) ($.default /.cannot_make_directory) ($.default /.cannot_find_directory) (~~ (for @.lua (~~ (these)) - (~~ (these ($.default /.default)))))] + (~~ (these ($.default /.default))))) + + ($.documentation /.Path + "A path to a file or a directory in a file-system.") + + ($.documentation (/.System !) + "An interface to a file-system.") + + ($.documentation /.parent + "If a path represents a nested file/directory, extracts its parent directory." + [(parent fs path)]) + + ($.documentation /.name + "The un-nested name of a file/directory." + [(name fs path)]) + + ($.documentation /.rooted + "A nested path for a file/directory, given a root/parent path and a file/directory name within it." + [(rooted fs parent child)]) + + ($.documentation /.exists? + "Checks if either a file or a directory exists at the given path." + [(exists? monad fs path)]) + + ($.documentation /.mock + (format "A purely in-memory simulation of a file-system." + \n "Useful for testing.") + [(mock separator)]) + + ($.documentation /.make_directories + (format "Creates the directory specified by the given path." + \n "Also, creates every super-directory necessary to make the given path valid.") + [(make_directories monad fs path)]) + + ($.documentation /.make_file + "Creates a new file with the given content if-and-only-if the file does not already exist." + [(make_file monad fs content path)])] [/watch.documentation])))) diff --git a/stdlib/source/documentation/lux/world/file/watch.lux b/stdlib/source/documentation/lux/world/file/watch.lux index 94ec46172..c4c3f371c 100644 --- a/stdlib/source/documentation/lux/world/file/watch.lux +++ b/stdlib/source/documentation/lux/world/file/watch.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] ["@" target] [data ["[0]" text (.only \n) @@ -11,40 +11,11 @@ [\\library ["[0]" /]]) -(documentation: /.Concern - "A particular concern to watch-out for.") - -(documentation: /.also - "" - [(also left right)]) - -(documentation: (/.Watcher !) - "Machinery for watching a file-system for changes to files and directories.") - -(documentation: /.polling - (format "A simple watcher that works for any file-system." - "Polls files and directories to detect changes.") - [(polling fs)]) - -(documentation: /.mock - (format "A fake/emulated watcher." - \n "Must be given a path separator for the file-system.") - [(mock separator)]) - -(for @.jvm (these (documentation: /.default - "The default watcher for the default file-system.")) - (these)) - (.def .public documentation (.List $.Module) (`` (`` ($.module /._ "" - [..Concern - ..also - ..Watcher - ..polling - ..mock - ($.default /.creation) + [($.default /.creation) ($.default /.creation?) ($.default /.modification) ($.default /.modification?) @@ -53,6 +24,28 @@ ($.default /.all) ($.default /.not_being_watched) ($.default /.cannot_poll_a_non_existent_directory) - (~~ (for @.jvm (~~ (these ..default)) + + ($.documentation /.Concern + "A particular concern to watch-out for.") + + ($.documentation /.also + "" + [(also left right)]) + + ($.documentation (/.Watcher !) + "Machinery for watching a file-system for changes to files and directories.") + + ($.documentation /.polling + (format "A simple watcher that works for any file-system." + "Polls files and directories to detect changes.") + [(polling fs)]) + + ($.documentation /.mock + (format "A fake/emulated watcher." + \n "Must be given a path separator for the file-system.") + [(mock separator)]) + + (~~ (for @.jvm (~~ (these ($.documentation /.default + "The default watcher for the default file-system."))) (~~ (these))))] [])))) diff --git a/stdlib/source/documentation/lux/world/input/keyboard.lux b/stdlib/source/documentation/lux/world/input/keyboard.lux index 86011916c..33e98ac17 100644 --- a/stdlib/source/documentation/lux/world/input/keyboard.lux +++ b/stdlib/source/documentation/lux/world/input/keyboard.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,19 +10,11 @@ [\\library ["[0]" /]]) -(documentation: /.Key - "A key from a keyboard, identify by a numeric ID.") - -(documentation: /.Press - "A key-press for a key.") - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Key - ..Press - ($.default /.back_space) + [($.default /.back_space) ($.default /.enter) ($.default /.shift) ($.default /.control) @@ -105,5 +97,11 @@ ($.default /.f23) ($.default /.f24) ($.default /.release) - ($.default /.press)] + ($.default /.press) + + ($.documentation /.Key + "A key from a keyboard, identify by a numeric ID.") + + ($.documentation /.Press + "A key-press for a key.")] [])) diff --git a/stdlib/source/documentation/lux/world/net.lux b/stdlib/source/documentation/lux/world/net.lux index 2ef8db1be..5f309dcb4 100644 --- a/stdlib/source/documentation/lux/world/net.lux +++ b/stdlib/source/documentation/lux/world/net.lux @@ -2,7 +2,7 @@ [library [lux (.except) [program (.only program:)] - ["$" documentation (.only documentation:)] + ["$" documentation] ["[0]" debug] [control ["[0]" io]]]] @@ -14,23 +14,20 @@ ["[1]/[0]" client] ["[1]/[0]" status]]]) -(documentation: /.Address - "A TCP/IP address.") - -(documentation: /.Port - "A TCP/IP port.") - -(documentation: /.URL - "A Uniform Resource Locator.") - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Address - ..Port - ..URL - ($.default /.Location)] + [($.default /.Location) + + ($.documentation /.Address + "A TCP/IP address.") + + ($.documentation /.Port + "A TCP/IP port.") + + ($.documentation /.URL + "A Uniform Resource Locator.")] [/uri.documentation /http/client.documentation /http/status.documentation])) diff --git a/stdlib/source/documentation/lux/world/net/http/client.lux b/stdlib/source/documentation/lux/world/net/http/client.lux index 27cb1e449..c0a113a36 100644 --- a/stdlib/source/documentation/lux/world/net/http/client.lux +++ b/stdlib/source/documentation/lux/world/net/http/client.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] ["@" target] [data ["[0]" text (.only \n) @@ -11,40 +11,30 @@ [\\library ["[0]" /]]) -(documentation: (/.Client !) - "A HTTP client capable of issuing requests to a HTTP server.") - -(with_template [] - [(documentation: - (format "A " (text.upper_cased (template.text [])) " request."))] - - [/.post] - [/.get] - [/.put] - [/.patch] - [/.delete] - [/.head] - [/.connect] - [/.options] - [/.trace] - ) - (.def .public documentation (.List $.Module) (`` (`` ($.module /._ "" - [..Client - ..post - ..get - ..put - ..patch - ..delete - ..head - ..connect - ..options - ..trace - ($.default /.async) + [($.default /.async) ($.default /.headers) (~~ (for @.jvm (~~ (these ($.default /.default))) - (~~ (these))))] + (~~ (these)))) + + ($.documentation (/.Client !) + "A HTTP client capable of issuing requests to a HTTP server.") + + (~~ (with_template [] + [($.documentation + (format "A " (text.upper_cased (template.text [])) " request."))] + + [/.post] + [/.get] + [/.put] + [/.patch] + [/.delete] + [/.head] + [/.connect] + [/.options] + [/.trace] + ))] [])))) diff --git a/stdlib/source/documentation/lux/world/net/http/status.lux b/stdlib/source/documentation/lux/world/net/http/status.lux index 1999f23e9..3d34f709a 100644 --- a/stdlib/source/documentation/lux/world/net/http/status.lux +++ b/stdlib/source/documentation/lux/world/net/http/status.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,159 +10,87 @@ [\\library ["[0]" /]]) -(with_template [] - [(documentation: - (|> (template.text []) - (text.replaced "_" " ") - text.upper_cased - (format (%.nat ) ": ")))] +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "" + [(~~ (with_template [] + [($.documentation + (|> (template.text []) + (text.replaced "_" " ") + text.upper_cased + (format (%.nat ) ": ")))] - ... 1xx Informational response - [/.continue] - [/.switching_protocols] - [/.processing] - [/.early_hints] + ... 1xx Informational response + [/.continue] + [/.switching_protocols] + [/.processing] + [/.early_hints] - ... 2xx Success - [/.ok] - [/.created] - [/.accepted] - [/.non_authoritative_information] - [/.no_content] - [/.reset_content] - [/.partial_content] - [/.multi_status] - [/.already_reported] - [/.im_used] + ... 2xx Success + [/.ok] + [/.created] + [/.accepted] + [/.non_authoritative_information] + [/.no_content] + [/.reset_content] + [/.partial_content] + [/.multi_status] + [/.already_reported] + [/.im_used] - ... 3xx Redirection - [/.multiple_choices] - [/.moved_permanently] - [/.found] - [/.see_other] - [/.not_modified] - [/.use_proxy] - [/.switch_proxy] - [/.temporary_redirect] - [/.permanent_redirect] + ... 3xx Redirection + [/.multiple_choices] + [/.moved_permanently] + [/.found] + [/.see_other] + [/.not_modified] + [/.use_proxy] + [/.switch_proxy] + [/.temporary_redirect] + [/.permanent_redirect] - ... 4xx Client errors - [/.bad_request] - [/.unauthorized] - [/.payment_required] - [/.forbidden] - [/.not_found] - [/.method_not_allowed] - [/.not_acceptable] - [/.proxy_authentication_required] - [/.request_timeout] - [/.conflict] - [/.gone] - [/.length_required] - [/.precondition_failed] - [/.payload_too_large] - [/.uri_too_long] - [/.unsupported_media_type] - [/.range_not_satisfiable] - [/.expectation_failed] - [/.im_a_teapot] - [/.misdirected_request] - [/.unprocessable_entity] - [/.locked] - [/.failed_dependency] - [/.upgrade_required] - [/.precondition_required] - [/.too_many_requests] - [/.request_header_fields_too_large] - [/.unavailable_for_legal_reasons] + ... 4xx Client errors + [/.bad_request] + [/.unauthorized] + [/.payment_required] + [/.forbidden] + [/.not_found] + [/.method_not_allowed] + [/.not_acceptable] + [/.proxy_authentication_required] + [/.request_timeout] + [/.conflict] + [/.gone] + [/.length_required] + [/.precondition_failed] + [/.payload_too_large] + [/.uri_too_long] + [/.unsupported_media_type] + [/.range_not_satisfiable] + [/.expectation_failed] + [/.im_a_teapot] + [/.misdirected_request] + [/.unprocessable_entity] + [/.locked] + [/.failed_dependency] + [/.upgrade_required] + [/.precondition_required] + [/.too_many_requests] + [/.request_header_fields_too_large] + [/.unavailable_for_legal_reasons] - ... 5xx Server errors - [/.internal_server_error] - [/.not_implemented] - [/.bad_gateway] - [/.service_unavailable] - [/.gateway_timeout] - [/.http_version_not_supported] - [/.variant_also_negotiates] - [/.insufficient_storage] - [/.loop_detected] - [/.not_extended] - [/.network_authentication_required] - ) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [ ... 1xx Informational response - ..continue - ..switching_protocols - ..processing - ..early_hints - - ... 2xx Success - ..ok - ..created - ..accepted - ..non_authoritative_information - ..no_content - ..reset_content - ..partial_content - ..multi_status - ..already_reported - ..im_used - - ... 3xx Redirection - ..multiple_choices - ..moved_permanently - ..found - ..see_other - ..not_modified - ..use_proxy - ..switch_proxy - ..temporary_redirect - ..permanent_redirect - - ... 4xx Client errors - ..bad_request - ..unauthorized - ..payment_required - ..forbidden - ..not_found - ..method_not_allowed - ..not_acceptable - ..proxy_authentication_required - ..request_timeout - ..conflict - ..gone - ..length_required - ..precondition_failed - ..payload_too_large - ..uri_too_long - ..unsupported_media_type - ..range_not_satisfiable - ..expectation_failed - ..im_a_teapot - ..misdirected_request - ..unprocessable_entity - ..locked - ..failed_dependency - ..upgrade_required - ..precondition_required - ..too_many_requests - ..request_header_fields_too_large - ..unavailable_for_legal_reasons - - ... 5xx Server errors - ..internal_server_error - ..not_implemented - ..bad_gateway - ..service_unavailable - ..gateway_timeout - ..http_version_not_supported - ..variant_also_negotiates - ..insufficient_storage - ..loop_detected - ..not_extended - ..network_authentication_required] - [])) + ... 5xx Server errors + [/.internal_server_error] + [/.not_implemented] + [/.bad_gateway] + [/.service_unavailable] + [/.gateway_timeout] + [/.http_version_not_supported] + [/.variant_also_negotiates] + [/.insufficient_storage] + [/.loop_detected] + [/.not_extended] + [/.network_authentication_required] + ))] + []))) diff --git a/stdlib/source/documentation/lux/world/net/uri.lux b/stdlib/source/documentation/lux/world/net/uri.lux index c96fa1ec5..64aadc1fd 100644 --- a/stdlib/source/documentation/lux/world/net/uri.lux +++ b/stdlib/source/documentation/lux/world/net/uri.lux @@ -2,23 +2,20 @@ [library [lux (.except) [program (.only program:)] - ["$" documentation (.only documentation:)] + ["$" documentation] ["[0]" debug] [control ["[0]" io]]]] [\\library ["[0]" /]]) -(documentation: /.URI - "A Uniform Resource Identifier.") - -(documentation: /.separator - "A separator for the pieces of a URI.") - (.def .public documentation (.List $.Module) ($.module /._ "" - [..URI - ..separator] + [($.documentation /.URI + "A Uniform Resource Identifier.") + + ($.documentation /.separator + "A separator for the pieces of a URI.")] [])) diff --git a/stdlib/source/documentation/lux/world/output/video/resolution.lux b/stdlib/source/documentation/lux/world/output/video/resolution.lux index 97d312c77..6efada0de 100644 --- a/stdlib/source/documentation/lux/world/output/video/resolution.lux +++ b/stdlib/source/documentation/lux/world/output/video/resolution.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data ["[0]" text (.only \n) ["%" \\format (.only format)]]] @@ -10,56 +10,40 @@ [\\library ["[0]" /]]) -(documentation: /.Resolution - "A screen resolution.") +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.hash) + ($.default /.equivalence) -(with_template [] - [(documentation: - (let [name (|> (template.text []) - (text.replaced "_" " ") - text.upper_cased)] - (format name " resolution: " - (%.nat (the /.#width )) - "x" (%.nat (the /.#height )) - ".")))] + ($.documentation /.Resolution + "A screen resolution.") - [/.svga] - [/.wsvga] - [/.xga] - [/.xga+] - [/.wxga_16:9] - [/.wxga_5:3] - [/.wxga_16:10] - [/.sxga] - [/.wxga+] - [/.hd+] - [/.wsxga+] - [/.fhd] - [/.wuxga] - [/.wqhd] - [/.uhd_4k] - ) + (~~ (with_template [] + [($.documentation + (let [name (|> (template.text []) + (text.replaced "_" " ") + text.upper_cased)] + (format name " resolution: " + (%.nat (the /.#width )) + "x" (%.nat (the /.#height )) + ".")))] -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..Resolution - ..svga - ..wsvga - ..xga - ..xga+ - ..wxga_16:9 - ..wxga_5:3 - ..wxga_16:10 - ..sxga - ..wxga+ - ..hd+ - ..wsxga+ - ..fhd - ..wuxga - ..wqhd - ..uhd_4k - ($.default /.hash) - ($.default /.equivalence)] - [])) + [/.svga] + [/.wsvga] + [/.xga] + [/.xga+] + [/.wxga_16:9] + [/.wxga_5:3] + [/.wxga_16:10] + [/.sxga] + [/.wxga+] + [/.hd+] + [/.wsxga+] + [/.fhd] + [/.wuxga] + [/.wqhd] + [/.uhd_4k] + ))] + []))) diff --git a/stdlib/source/documentation/lux/world/program.lux b/stdlib/source/documentation/lux/world/program.lux deleted file mode 100644 index 0e932c07d..000000000 --- a/stdlib/source/documentation/lux/world/program.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.require - [library - [lux (.except) - ["$" documentation (.only documentation:)] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]] - [macro - ["[0]" template]]]] - [\\library - ["[0]" /]]) - -(documentation: (/.Program !) - "Access to ambient program data and the capacity to exit the program.") - -(documentation: /.environment - "Assembles the environment variables available to the program." - [(environment monad program)]) - -(documentation: /.mock - "" - [(mock environment home directory)]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..Program - ..environment - ..mock - ($.default /.unknown_environment_variable) - ($.default /.async) - ($.default /.default)] - [])) diff --git a/stdlib/source/documentation/lux/world/shell.lux b/stdlib/source/documentation/lux/world/shell.lux index b2ad55851..d6ae9df5f 100644 --- a/stdlib/source/documentation/lux/world/shell.lux +++ b/stdlib/source/documentation/lux/world/shell.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] ["@" target] [data ["[0]" text (.only \n) @@ -11,43 +11,36 @@ [\\library ["[0]" /]]) -(documentation: /.Exit - "A program exit code.") - -(documentation: (/.Process !) - "The means for communicating with a program/process being executed by the operating system.") - -(documentation: /.Command - "A command that can be executed by the operating system.") - -(documentation: /.Argument - "A parameter for a command.") - -(documentation: (/.Shell !) - "The means for issuing commands to the operating system.") - -(documentation: (/.Mock s) - "A simulated process.") - -(documentation: /.mock - "" - [(mock mock init)]) - (.def .public documentation (.List $.Module) (`` (`` ($.module /._ "" - [..Exit - ..Process - ..Command - ..Argument - ..Shell - ..Mock - ..mock - ($.default /.normal) + [($.default /.normal) ($.default /.error) ($.default /.async) (~~ (for @.jvm (~~ (these ($.default /.no_more_output) ($.default /.default))) - (~~ (these))))] + (~~ (these)))) + + ($.documentation /.Exit + "A program exit code.") + + ($.documentation (/.Process !) + "The means for communicating with a program/process being executed by the operating system.") + + ($.documentation /.Command + "A command that can be executed by the operating system.") + + ($.documentation /.Argument + "A parameter for a command.") + + ($.documentation (/.Shell !) + "The means for issuing commands to the operating system.") + + ($.documentation (/.Mock s) + "A simulated process.") + + ($.documentation /.mock + "" + [(mock mock init)])] [])))) diff --git a/stdlib/source/library/lux/control/parser/environment.lux b/stdlib/source/library/lux/control/parser/environment.lux deleted file mode 100644 index df9bf0fbc..000000000 --- a/stdlib/source/library/lux/control/parser/environment.lux +++ /dev/null @@ -1,44 +0,0 @@ -(.require - [library - [lux (.except) - [control - ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] - [data - ["[0]" product] - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" dictionary (.only Dictionary)]]]]] - ["[0]" //]) - -(type .public Property - Text) - -(type .public Environment - (Dictionary Property Text)) - -(exception .public (unknown_property [property Property]) - (exception.report - "Property" (%.text property))) - -(type .public (Parser a) - (//.Parser Environment a)) - -(def .public empty - Environment - (dictionary.empty text.hash)) - -(def .public (property name) - (-> Property (Parser Text)) - (function (_ environment) - (case (dictionary.value name environment) - {.#Some value} - {try.#Success [environment value]} - - {.#None} - (exception.except ..unknown_property [name])))) - -(def .public (result parser environment) - (All (_ a) (-> (Parser a) Environment (Try a))) - (at try.monad each product.right (parser environment))) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index 110675c5d..5f086c633 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -39,7 +39,7 @@ ["[0]" meta (.only) ["[0]" symbol]] [world - ["[0]" program] + ["[0]" environment] ["[0]" console]]]]) (type .public Tally @@ -259,7 +259,7 @@ {.#Some console} (console.write_line report console)) ))] - (async.future (at program.default exit + (async.future (at environment.default exit (case (the #failures tally) 0 ..success_exit_code _ ..failure_exit_code))))) diff --git a/stdlib/source/library/lux/world/environment.lux b/stdlib/source/library/lux/world/environment.lux new file mode 100644 index 000000000..2955c5343 --- /dev/null +++ b/stdlib/source/library/lux/world/environment.lux @@ -0,0 +1,439 @@ +(.`` (.`` (.require + [library + [lux (.except) + ["@" target] + [abstract + ["[0]" monad (.only Monad do)]] + [control + ["[0]" function] + ["[0]" io (.only IO)] + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)] + [concurrency + ["[0]" atom] + ["[0]" async (.only Async)]]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" array (.only Array)] + ["[0]" dictionary (.only Dictionary)] + ["[0]" list (.use "[1]#[0]" functor)]]] + ["[0]" ffi (.only import) + (.~~ (.for "JavaScript" (.~~ (.these ["[0]" node_js])) + "{old}" (.~~ (.these ["node_js" //math])) + (.~~ (.these))))] + ["[0]" macro (.only) + ["[0]" template]] + [math + [number + ["i" int]]]]] + ["[0]" \\parser] + [// + [file (.only Path)] + [shell (.only Exit)]]))) + +(exception .public (unknown_environment_variable [name Text]) + (exception.report + "Name" (%.text name))) + +(type .public (Environment !) + (Interface + (is (-> Any (! (List Text))) + available_variables) + (is (-> Text (! (Try Text))) + variable) + (is Path + home) + (is Path + directory) + (is (-> Exit (! Nothing)) + exit))) + +(def .public (environment monad environment) + (All (_ !) (-> (Monad !) (Environment !) (! \\parser.Environment))) + (do [! monad] + [variables (at environment available_variables []) + entries (monad.each ! (function (_ name) + (at ! each (|>> [name]) (at environment variable name))) + variables)] + (in (|> entries + (list.all (function (_ [name value]) + (case value + {try.#Success value} + {.#Some [name value]} + + {try.#Failure _} + {.#None}))) + (dictionary.of_list text.hash))))) + +(`` (def .public (async environment) + (-> (Environment IO) (Environment Async)) + (implementation + (~~ (with_template [] + [(def + (at environment ))] + + [home] + [directory] + )) + + (~~ (with_template [] + [(def + (|>> (at environment ) async.future))] + + [available_variables] + [variable] + [exit] + ))))) + +(def .public (mock environment home directory) + (-> \\parser.Environment Path Path (Environment IO)) + (let [@dead? (atom.atom false)] + (implementation + (def available_variables + (function.constant (io.io (dictionary.keys environment)))) + (def (variable name) + (io.io (case (dictionary.value name environment) + {.#Some value} + {try.#Success value} + + {.#None} + (exception.except ..unknown_environment_variable [name])))) + (def home + home) + (def directory + directory) + (def exit + (|>> %.int panic! io.io))))) + +... Do not trust the values of environment variables +... https://wiki.sei.cmu.edu/confluence/display/java/ENV02-J.+Do+not+trust+the+values+of+environment+variables + +(with_expansions [ (these (import java/lang/String + "[1]::[0]") + + (import (java/util/Iterator a) + "[1]::[0]" + (hasNext [] boolean) + (next [] a)) + + (import (java/util/Set a) + "[1]::[0]" + (iterator [] (java/util/Iterator a))) + + (import (java/util/Map k v) + "[1]::[0]" + (keySet [] (java/util/Set k))) + + (import java/lang/System + "[1]::[0]" + ("static" getenv [] (java/util/Map java/lang/String java/lang/String)) + ("static" getenv "as" resolveEnv [java/lang/String] "io" "?" java/lang/String) + ("static" getProperty [java/lang/String] "?" java/lang/String) + ("static" exit [int] "io" void)) + + (def (jvm::consume iterator) + (All (_ a) (-> (java/util/Iterator a) (List a))) + (if (ffi.of_boolean (java/util/Iterator::hasNext iterator)) + {.#Item (java/util/Iterator::next iterator) + (jvm::consume iterator)} + {.#End})) + )] + (for @.old (these ) + @.jvm (these ) + @.js (these (def default_exit! + (-> Exit (IO Nothing)) + (|>> %.int panic! io.io)) + + (import NodeJs_Process + "[1]::[0]" + (exit [ffi.Number] "io" Nothing) + (cwd [] "io" Path)) + + (def (exit_node_js! code) + (-> Exit (IO Nothing)) + (case (ffi.global ..NodeJs_Process [process]) + {.#Some process} + (NodeJs_Process::exit (i.frac code) process) + + {.#None} + (..default_exit! code))) + + (import Browser_Window + "[1]::[0]" + (close [] Nothing)) + + (import Browser_Location + "[1]::[0]" + (reload [] Nothing)) + + (def (exit_browser! code) + (-> Exit (IO Nothing)) + (case [(ffi.global ..Browser_Window [window]) + (ffi.global ..Browser_Location [location])] + [{.#Some window} {.#Some location}] + (exec + (Browser_Window::close window) + (Browser_Location::reload location) + (..default_exit! code)) + + [{.#Some window} {.#None}] + (exec + (Browser_Window::close window) + (..default_exit! code)) + + [{.#None} {.#Some location}] + (exec + (Browser_Location::reload location) + (..default_exit! code)) + + [{.#None} {.#None}] + (..default_exit! code))) + + (import Object + "[1]::[0]" + ("static" entries [Object] (Array (Array ffi.String)))) + + (import NodeJs_OS + "[1]::[0]" + (homedir [] "io" Path))) + @.python (these (import os + "[1]::[0]" + ("static" getcwd [] "io" ffi.String) + ("static" _exit [ffi.Integer] "io" Nothing)) + + (import os/path + "[1]::[0]" + ("static" expanduser [ffi.String] "io" ffi.String)) + + (import os/environ + "[1]::[0]" + ("static" keys [] "io" (Array ffi.String)) + ("static" get [ffi.String] "io" "?" ffi.String))) + @.lua (these (ffi.import LuaFile + "[1]::[0]" + (read [ffi.String] "io" "?" ffi.String) + (close [] "io" ffi.Boolean)) + + (ffi.import (io/popen [ffi.String] "io" "try" "?" LuaFile)) + (ffi.import (os/getenv [ffi.String] "io" "?" ffi.String)) + (ffi.import (os/exit [ffi.Integer] "io" Nothing)) + + (def (run_command default command) + (-> Text Text (IO Text)) + (do [! io.monad] + [outcome (io/popen [command])] + (case outcome + {try.#Success outcome} + (case outcome + {.#Some file} + (do ! + [?output (LuaFile::read "*l" file) + _ (LuaFile::close file)] + (in (maybe.else default ?output))) + + {.#None} + (in default)) + + {try.#Failure _} + (in default))))) + @.ruby (these (ffi.import Env + "[1]::[0]" + ("static" keys [] (Array Text)) + ("static" fetch [Text] "io" "?" Text)) + + (ffi.import "fileutils" FileUtils + "[1]::[0]" + ("static" pwd Path)) + + (ffi.import Dir + "[1]::[0]" + ("static" home Path)) + + (ffi.import Kernel + "[1]::[0]" + ("static" exit [Int] "io" Nothing))) + + ... @.php + ... (these (ffi.import (exit [Int] "io" Nothing)) + ... ... https://www.php.net/manual/en/function.exit.php + ... (ffi.import (getcwd [] "io" ffi.String)) + ... ... https://www.php.net/manual/en/function.getcwd.php + ... (ffi.import (getenv "as" getenv/1 [ffi.String] "io" ffi.String)) + ... (ffi.import (getenv "as" getenv/0 [] "io" (Array ffi.String))) + ... ... https://www.php.net/manual/en/function.getenv.php + ... ... https://www.php.net/manual/en/function.array-keys.php + ... (ffi.import (array_keys [(Array ffi.String)] (Array ffi.String))) + ... ) + + ... @.scheme + ... (these (ffi.import (exit [Int] "io" Nothing)) + ... ... https://srfi.schemers.org/srfi-98/srfi-98.html + ... (primitive Pair Any) + ... (primitive PList Any) + ... (ffi.import (get-environment-variables [] "io" PList)) + ... (ffi.import (car [Pair] Text)) + ... (ffi.import (cdr [Pair] Text)) + ... (ffi.import (car "as" head [PList] Pair)) + ... (ffi.import (cdr "as" tail [PList] PList))) + + (these))) + +(def .public default + (Environment IO) + (implementation + (def (available_variables _) + (with_expansions [ (|> (java/lang/System::getenv) + java/util/Map::keySet + java/util/Set::iterator + ..jvm::consume + (list#each (|>> ffi.of_string)) + io.io)] + (for @.old + @.jvm + @.js (io.io (if ffi.on_node_js? + (case (ffi.global Object [process env]) + {.#Some process/env} + (|> (Object::entries [process/env]) + (array.list {.#None}) + (list#each (|>> (array.item 0) maybe.trusted))) + + {.#None} + (list)) + (list))) + @.python (at io.monad each (array.list {.#None}) (os/environ::keys [])) + ... Lua offers no way to get all the environment variables available. + @.lua (io.io (list)) + @.ruby (io.io (array.list {.#None} (Env::keys []))) + ... @.php (do io.monad + ... [environment (..getenv/0 [])] + ... (in (|> environment + ... ..array_keys + ... (array.list {.#None}) + ... (list#each (function (_ variable) + ... [variable ("php array read" (as Nat variable) environment)])) + ... (dictionary.of_list text.hash)))) + ... @.scheme (do io.monad + ... [input (..get-environment-variables [])] + ... (loop (again [input input + ... output \\parser.empty]) + ... (if ("scheme object nil?" input) + ... (in output) + ... (let [entry (..head input)] + ... (again (..tail input) + ... (dictionary.has (..car entry) (..cdr entry) output)))))) + ))) + + (def (variable name) + (template.let [(!fetch ) + [(do io.monad + [value (|> name )] + (in (case value + {.#Some value} + {try.#Success ( value)} + + {.#None} + (exception.except ..unknown_environment_variable [name]))))]] + (with_expansions [ (!fetch (<| java/lang/System::resolveEnv ffi.as_string) ffi.of_string)] + (for @.old + @.jvm + @.js (io.io (if ffi.on_node_js? + (case (do maybe.monad + [process/env (ffi.global Object [process env])] + (array.item (as Nat name) + (as (Array Text) process/env))) + {.#Some value} + {try.#Success value} + + {.#None} + (exception.except ..unknown_environment_variable [name])) + (exception.except ..unknown_environment_variable [name]))) + @.python (!fetch os/environ::get |>) + @.lua (!fetch os/getenv |>) + @.ruby (!fetch Env::fetch |>) + )))) + + (def home + (io.run! + (with_expansions [ (io.io "~") + (|> (java/lang/System::getProperty (ffi.as_string "user.home")) + (maybe#each (|>> ffi.of_string)) + (maybe.else "") + io.io)] + (for @.old + @.jvm + @.js (if ffi.on_node_js? + (|> (node_js.require "os") + maybe.trusted + (as NodeJs_OS) + NodeJs_OS::homedir) + ) + @.python (os/path::expanduser "~") + @.lua (..run_command "~" "echo ~") + @.ruby (io.io (Dir::home)) + ... @.php (do io.monad + ... [output (..getenv/1 ["HOME"])] + ... (in (if (bit#= false (as Bit output)) + ... "~" + ... output))) + + ... TODO: Replace dummy implementation. + )))) + + (def directory + (io.run! + (with_expansions [ "." + (|> (java/lang/System::getProperty (ffi.as_string "user.dir")) + (maybe#each (|>> ffi.of_string)) + (maybe.else "") + io.io)] + (for @.old + @.jvm + @.js (if ffi.on_node_js? + (case (ffi.global ..NodeJs_Process [process]) + {.#Some process} + (NodeJs_Process::cwd process) + + {.#None} + (io.io )) + (io.io )) + @.python (os::getcwd []) + @.lua (do io.monad + [.let [default ] + on_windows (..run_command default "cd")] + (if (same? default on_windows) + (..run_command default "pwd") + (in on_windows))) + @.ruby (io.io (FileUtils::pwd)) + ... @.php (do io.monad + ... [output (..getcwd [])] + ... (in (if (bit#= false (as Bit output)) + ... "." + ... output))) + + ... TODO: Replace dummy implementation. + (io.io ))))) + + (def (exit code) + (with_expansions [ (do io.monad + [_ (java/lang/System::exit (ffi.as_int code))] + (in (undefined)))] + (for @.old + @.jvm + @.js (cond ffi.on_node_js? + (..exit_node_js! code) + + ffi.on_browser? + (..exit_browser! code) + + ... else + (..default_exit! code)) + @.python (os::_exit code) + @.lua (os/exit code) + @.ruby (Kernel::exit code) + ... @.php (..exit [code]) + ... @.scheme (..exit [code]) + ))))) diff --git a/stdlib/source/library/lux/world/net/http.lux b/stdlib/source/library/lux/world/net/http.lux index d98151768..0582c9192 100644 --- a/stdlib/source/library/lux/world/net/http.lux +++ b/stdlib/source/library/lux/world/net/http.lux @@ -4,13 +4,14 @@ [control [try (.only Try)] [concurrency - [frp (.only Channel)]] - [parser - ["[0]" environment (.only Environment)]]] + [frp (.only Channel)]]] [data [binary (.only Binary)]]]] [// (.only URL) - [uri (.only URI)]]) + [uri (.only URI)] + [// + ["[0]" environment + ["[1]" \\parser (.only Environment)]]]]) (type .public Version Text) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux deleted file mode 100644 index 9923535c9..000000000 --- a/stdlib/source/library/lux/world/program.lux +++ /dev/null @@ -1,440 +0,0 @@ -(.`` (.`` (.require - [library - [lux (.except) - ["@" target] - [abstract - ["[0]" monad (.only Monad do)]] - [control - ["[0]" function] - ["[0]" io (.only IO)] - ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] - [concurrency - ["[0]" atom] - ["[0]" async (.only Async)]] - [parser - ["[0]" environment (.only Environment)]]] - [data - ["[0]" bit (.use "[1]#[0]" equivalence)] - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" array (.only Array)] - ["[0]" dictionary (.only Dictionary)] - ["[0]" list (.use "[1]#[0]" functor)]]] - ["[0]" ffi (.only import) - (.~~ (.for "JavaScript" (.~~ (.these ["[0]" node_js])) - "{old}" (.~~ (.these ["node_js" //math])) - (.~~ (.these))))] - ["[0]" macro (.only) - ["[0]" template]] - [math - [number - ["i" int]]]]] - [// - [file (.only Path)] - [shell (.only Exit)]]))) - -(exception .public (unknown_environment_variable [name Text]) - (exception.report - "Name" (%.text name))) - -(type .public (Program !) - (Interface - (is (-> Any (! (List Text))) - available_variables) - (is (-> Text (! (Try Text))) - variable) - (is Path - home) - (is Path - directory) - (is (-> Exit (! Nothing)) - exit))) - -(def .public (environment monad program) - (All (_ !) (-> (Monad !) (Program !) (! Environment))) - (do [! monad] - [variables (at program available_variables []) - entries (monad.each ! (function (_ name) - (at ! each (|>> [name]) (at program variable name))) - variables)] - (in (|> entries - (list.all (function (_ [name value]) - (case value - {try.#Success value} - {.#Some [name value]} - - {try.#Failure _} - {.#None}))) - (dictionary.of_list text.hash))))) - -(`` (def .public (async program) - (-> (Program IO) (Program Async)) - (implementation - (~~ (with_template [] - [(def - (at program ))] - - [home] - [directory] - )) - - (~~ (with_template [] - [(def - (|>> (at program ) async.future))] - - [available_variables] - [variable] - [exit] - ))))) - -(def .public (mock environment home directory) - (-> Environment Path Path (Program IO)) - (let [@dead? (atom.atom false)] - (implementation - (def available_variables - (function.constant (io.io (dictionary.keys environment)))) - (def (variable name) - (io.io (case (dictionary.value name environment) - {.#Some value} - {try.#Success value} - - {.#None} - (exception.except ..unknown_environment_variable [name])))) - (def home - home) - (def directory - directory) - (def exit - (|>> %.int panic! io.io))))) - -... Do not trust the values of environment variables -... https://wiki.sei.cmu.edu/confluence/display/java/ENV02-J.+Do+not+trust+the+values+of+environment+variables - -(with_expansions [ (these (import java/lang/String - "[1]::[0]") - - (import (java/util/Iterator a) - "[1]::[0]" - (hasNext [] boolean) - (next [] a)) - - (import (java/util/Set a) - "[1]::[0]" - (iterator [] (java/util/Iterator a))) - - (import (java/util/Map k v) - "[1]::[0]" - (keySet [] (java/util/Set k))) - - (import java/lang/System - "[1]::[0]" - ("static" getenv [] (java/util/Map java/lang/String java/lang/String)) - ("static" getenv "as" resolveEnv [java/lang/String] "io" "?" java/lang/String) - ("static" getProperty [java/lang/String] "?" java/lang/String) - ("static" exit [int] "io" void)) - - (def (jvm::consume iterator) - (All (_ a) (-> (java/util/Iterator a) (List a))) - (if (ffi.of_boolean (java/util/Iterator::hasNext iterator)) - {.#Item (java/util/Iterator::next iterator) - (jvm::consume iterator)} - {.#End})) - )] - (for @.old (these ) - @.jvm (these ) - @.js (these (def default_exit! - (-> Exit (IO Nothing)) - (|>> %.int panic! io.io)) - - (import NodeJs_Process - "[1]::[0]" - (exit [ffi.Number] "io" Nothing) - (cwd [] "io" Path)) - - (def (exit_node_js! code) - (-> Exit (IO Nothing)) - (case (ffi.global ..NodeJs_Process [process]) - {.#Some process} - (NodeJs_Process::exit (i.frac code) process) - - {.#None} - (..default_exit! code))) - - (import Browser_Window - "[1]::[0]" - (close [] Nothing)) - - (import Browser_Location - "[1]::[0]" - (reload [] Nothing)) - - (def (exit_browser! code) - (-> Exit (IO Nothing)) - (case [(ffi.global ..Browser_Window [window]) - (ffi.global ..Browser_Location [location])] - [{.#Some window} {.#Some location}] - (exec - (Browser_Window::close window) - (Browser_Location::reload location) - (..default_exit! code)) - - [{.#Some window} {.#None}] - (exec - (Browser_Window::close window) - (..default_exit! code)) - - [{.#None} {.#Some location}] - (exec - (Browser_Location::reload location) - (..default_exit! code)) - - [{.#None} {.#None}] - (..default_exit! code))) - - (import Object - "[1]::[0]" - ("static" entries [Object] (Array (Array ffi.String)))) - - (import NodeJs_OS - "[1]::[0]" - (homedir [] "io" Path))) - @.python (these (import os - "[1]::[0]" - ("static" getcwd [] "io" ffi.String) - ("static" _exit [ffi.Integer] "io" Nothing)) - - (import os/path - "[1]::[0]" - ("static" expanduser [ffi.String] "io" ffi.String)) - - (import os/environ - "[1]::[0]" - ("static" keys [] "io" (Array ffi.String)) - ("static" get [ffi.String] "io" "?" ffi.String))) - @.lua (these (ffi.import LuaFile - "[1]::[0]" - (read [ffi.String] "io" "?" ffi.String) - (close [] "io" ffi.Boolean)) - - (ffi.import (io/popen [ffi.String] "io" "try" "?" LuaFile)) - (ffi.import (os/getenv [ffi.String] "io" "?" ffi.String)) - (ffi.import (os/exit [ffi.Integer] "io" Nothing)) - - (def (run_command default command) - (-> Text Text (IO Text)) - (do [! io.monad] - [outcome (io/popen [command])] - (case outcome - {try.#Success outcome} - (case outcome - {.#Some file} - (do ! - [?output (LuaFile::read "*l" file) - _ (LuaFile::close file)] - (in (maybe.else default ?output))) - - {.#None} - (in default)) - - {try.#Failure _} - (in default))))) - @.ruby (these (ffi.import Env - "[1]::[0]" - ("static" keys [] (Array Text)) - ("static" fetch [Text] "io" "?" Text)) - - (ffi.import "fileutils" FileUtils - "[1]::[0]" - ("static" pwd Path)) - - (ffi.import Dir - "[1]::[0]" - ("static" home Path)) - - (ffi.import Kernel - "[1]::[0]" - ("static" exit [Int] "io" Nothing))) - - ... @.php - ... (these (ffi.import (exit [Int] "io" Nothing)) - ... ... https://www.php.net/manual/en/function.exit.php - ... (ffi.import (getcwd [] "io" ffi.String)) - ... ... https://www.php.net/manual/en/function.getcwd.php - ... (ffi.import (getenv "as" getenv/1 [ffi.String] "io" ffi.String)) - ... (ffi.import (getenv "as" getenv/0 [] "io" (Array ffi.String))) - ... ... https://www.php.net/manual/en/function.getenv.php - ... ... https://www.php.net/manual/en/function.array-keys.php - ... (ffi.import (array_keys [(Array ffi.String)] (Array ffi.String))) - ... ) - - ... @.scheme - ... (these (ffi.import (exit [Int] "io" Nothing)) - ... ... https://srfi.schemers.org/srfi-98/srfi-98.html - ... (primitive Pair Any) - ... (primitive PList Any) - ... (ffi.import (get-environment-variables [] "io" PList)) - ... (ffi.import (car [Pair] Text)) - ... (ffi.import (cdr [Pair] Text)) - ... (ffi.import (car "as" head [PList] Pair)) - ... (ffi.import (cdr "as" tail [PList] PList))) - - (these))) - -(def .public default - (Program IO) - (implementation - (def (available_variables _) - (with_expansions [ (|> (java/lang/System::getenv) - java/util/Map::keySet - java/util/Set::iterator - ..jvm::consume - (list#each (|>> ffi.of_string)) - io.io)] - (for @.old - @.jvm - @.js (io.io (if ffi.on_node_js? - (case (ffi.global Object [process env]) - {.#Some process/env} - (|> (Object::entries [process/env]) - (array.list {.#None}) - (list#each (|>> (array.item 0) maybe.trusted))) - - {.#None} - (list)) - (list))) - @.python (at io.monad each (array.list {.#None}) (os/environ::keys [])) - ... Lua offers no way to get all the environment variables available. - @.lua (io.io (list)) - @.ruby (io.io (array.list {.#None} (Env::keys []))) - ... @.php (do io.monad - ... [environment (..getenv/0 [])] - ... (in (|> environment - ... ..array_keys - ... (array.list {.#None}) - ... (list#each (function (_ variable) - ... [variable ("php array read" (as Nat variable) environment)])) - ... (dictionary.of_list text.hash)))) - ... @.scheme (do io.monad - ... [input (..get-environment-variables [])] - ... (loop (again [input input - ... output environment.empty]) - ... (if ("scheme object nil?" input) - ... (in output) - ... (let [entry (..head input)] - ... (again (..tail input) - ... (dictionary.has (..car entry) (..cdr entry) output)))))) - ))) - - (def (variable name) - (template.let [(!fetch ) - [(do io.monad - [value (|> name )] - (in (case value - {.#Some value} - {try.#Success ( value)} - - {.#None} - (exception.except ..unknown_environment_variable [name]))))]] - (with_expansions [ (!fetch (<| java/lang/System::resolveEnv ffi.as_string) ffi.of_string)] - (for @.old - @.jvm - @.js (io.io (if ffi.on_node_js? - (case (do maybe.monad - [process/env (ffi.global Object [process env])] - (array.item (as Nat name) - (as (Array Text) process/env))) - {.#Some value} - {try.#Success value} - - {.#None} - (exception.except ..unknown_environment_variable [name])) - (exception.except ..unknown_environment_variable [name]))) - @.python (!fetch os/environ::get |>) - @.lua (!fetch os/getenv |>) - @.ruby (!fetch Env::fetch |>) - )))) - - (def home - (io.run! - (with_expansions [ (io.io "~") - (|> (java/lang/System::getProperty (ffi.as_string "user.home")) - (maybe#each (|>> ffi.of_string)) - (maybe.else "") - io.io)] - (for @.old - @.jvm - @.js (if ffi.on_node_js? - (|> (node_js.require "os") - maybe.trusted - (as NodeJs_OS) - NodeJs_OS::homedir) - ) - @.python (os/path::expanduser "~") - @.lua (..run_command "~" "echo ~") - @.ruby (io.io (Dir::home)) - ... @.php (do io.monad - ... [output (..getenv/1 ["HOME"])] - ... (in (if (bit#= false (as Bit output)) - ... "~" - ... output))) - - ... TODO: Replace dummy implementation. - )))) - - (def directory - (io.run! - (with_expansions [ "." - (|> (java/lang/System::getProperty (ffi.as_string "user.dir")) - (maybe#each (|>> ffi.of_string)) - (maybe.else "") - io.io)] - (for @.old - @.jvm - @.js (if ffi.on_node_js? - (case (ffi.global ..NodeJs_Process [process]) - {.#Some process} - (NodeJs_Process::cwd process) - - {.#None} - (io.io )) - (io.io )) - @.python (os::getcwd []) - @.lua (do io.monad - [.let [default ] - on_windows (..run_command default "cd")] - (if (same? default on_windows) - (..run_command default "pwd") - (in on_windows))) - @.ruby (io.io (FileUtils::pwd)) - ... @.php (do io.monad - ... [output (..getcwd [])] - ... (in (if (bit#= false (as Bit output)) - ... "." - ... output))) - - ... TODO: Replace dummy implementation. - (io.io ))))) - - (def (exit code) - (with_expansions [ (do io.monad - [_ (java/lang/System::exit (ffi.as_int code))] - (in (undefined)))] - (for @.old - @.jvm - @.js (cond ffi.on_node_js? - (..exit_node_js! code) - - ffi.on_browser? - (..exit_browser! code) - - ... else - (..default_exit! code)) - @.python (os::_exit code) - @.lua (os/exit code) - @.ruby (Kernel::exit code) - ... @.php (..exit [code]) - ... @.scheme (..exit [code]) - ))))) diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index 9c6b37c12..f9d7a6fd6 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -14,9 +14,7 @@ ["?" policy (.only Context Safety Safe)]] [concurrency ["[0]" atom (.only Atom)] - ["[0]" async (.only Async)]] - [parser - [environment (.only Environment)]]] + ["[0]" async (.only Async)]]] [data ["[0]" product] ["[0]" text (.only) @@ -31,7 +29,9 @@ [number (.only hex) ["n" nat]]]]] [// - [file (.only Path)]]) + [file (.only Path)] + [environment + [\\parser (.only Environment)]]]) (type .public Exit Int) diff --git a/stdlib/source/parser/lux/world/environment.lux b/stdlib/source/parser/lux/world/environment.lux new file mode 100644 index 000000000..33089f2a3 --- /dev/null +++ b/stdlib/source/parser/lux/world/environment.lux @@ -0,0 +1,44 @@ +(.require + [library + [lux (.except) + [control + ["//" parser] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)]] + [data + ["[0]" product] + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" dictionary (.only Dictionary)]]]]]) + +(type .public Property + Text) + +(type .public Environment + (Dictionary Property Text)) + +(exception .public (unknown_property [property Property]) + (exception.report + "Property" (%.text property))) + +(type .public (Parser a) + (//.Parser Environment a)) + +(def .public empty + Environment + (dictionary.empty text.hash)) + +(def .public (property name) + (-> Property (Parser Text)) + (function (_ environment) + (case (dictionary.value name environment) + {.#Some value} + {try.#Success [environment value]} + + {.#None} + (exception.except ..unknown_property [name])))) + +(def .public (result parser environment) + (All (_ a) (-> (Parser a) Environment (Try a))) + (at try.monad each product.right (parser environment))) diff --git a/stdlib/source/specification/lux/world/environment.lux b/stdlib/source/specification/lux/world/environment.lux new file mode 100644 index 000000000..2163fc2e1 --- /dev/null +++ b/stdlib/source/specification/lux/world/environment.lux @@ -0,0 +1,32 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)]] + [control + ["[0]" try] + [concurrency + ["[0]" async (.only Async)]]] + [data + ["[0]" text] + [collection + ["[0]" dictionary] + ["[0]" list]]] + [math + ["[0]" random]]]] + [\\library + ["[0]" /]]) + +(def .public (spec subject) + (-> (/.Environment Async) Test) + (do random.monad + [exit random.int] + (in (do [! async.monad] + [environment (/.environment ! subject)] + (_.coverage' [/.Environment] + (and (not (dictionary.empty? environment)) + (list.every? (|>> text.empty? not) + (dictionary.keys environment)) + (not (text.empty? (at subject home))) + (not (text.empty? (at subject directory))))))))) diff --git a/stdlib/source/specification/lux/world/program.lux b/stdlib/source/specification/lux/world/program.lux deleted file mode 100644 index b941158b4..000000000 --- a/stdlib/source/specification/lux/world/program.lux +++ /dev/null @@ -1,32 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)]] - [control - ["[0]" try] - [concurrency - ["[0]" async (.only Async)]]] - [data - ["[0]" text] - [collection - ["[0]" dictionary] - ["[0]" list]]] - [math - ["[0]" random]]]] - [\\library - ["[0]" /]]) - -(def .public (spec subject) - (-> (/.Program Async) Test) - (do random.monad - [exit random.int] - (in (do [! async.monad] - [environment (/.environment ! subject)] - (_.coverage' [/.Program] - (and (not (dictionary.empty? environment)) - (list.every? (|>> text.empty? not) - (dictionary.keys environment)) - (not (text.empty? (at subject home))) - (not (text.empty? (at subject directory))))))))) diff --git a/stdlib/source/specification/lux/world/shell.lux b/stdlib/source/specification/lux/world/shell.lux index 2ac53794c..ddf544c55 100644 --- a/stdlib/source/specification/lux/world/shell.lux +++ b/stdlib/source/specification/lux/world/shell.lux @@ -7,9 +7,7 @@ [control ["[0]" try (.use "[1]#[0]" functor)] [concurrency - ["[0]" async (.only Async) (.use "[1]#[0]" monad)]] - [parser - ["[0]" environment (.only Environment)]]] + ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" equivalence) @@ -22,7 +20,9 @@ [\\library ["[0]" / (.only) [// - [file (.only Path)]]]]) + [file (.only Path)] + ["[0]" environment + ["[1]" \\parser (.only Environment)]]]]]) (with_template [ ] [(def diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 624999201..aa083b543 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -25,9 +25,7 @@ ["[0]" code (.only) ["<[1]>" \\parser]]]]] [\\library - ["[0]" / (.only Parser)]] - ["[0]" / - ["[1][0]" environment]]) + ["[0]" / (.only Parser)]]) (def (should_fail expected input) (All (_ a) (-> Text (Try a) Bit)) @@ -374,6 +372,4 @@ ..combinators_0 ..combinators_1 ..combinators_2 - - /environment.test )))) diff --git a/stdlib/source/test/lux/control/parser/environment.lux b/stdlib/source/test/lux/control/parser/environment.lux deleted file mode 100644 index bc4d924b3..000000000 --- a/stdlib/source/test/lux/control/parser/environment.lux +++ /dev/null @@ -1,53 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)]] - [control - ["[0]" try] - ["[0]" exception]] - [data - ["[0]" text (.use "[1]#[0]" equivalence)] - [collection - ["[0]" dictionary]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / (.only) - ["/[1]" // (.use "[1]#[0]" monad)]]]) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Environment /.Parser]) - (all _.and - (_.coverage [/.empty] - (dictionary.empty? /.empty)) - (do random.monad - [expected random.nat] - (_.coverage [/.result] - (|> (/.result (//#in expected) /.empty) - (at try.functor each (n.= expected)) - (try.else false)))) - (do random.monad - [property (random.alphabetic 1) - expected (random.alphabetic 1)] - (_.coverage [/.Property /.property] - (|> /.empty - (dictionary.has property expected) - (/.result (/.property property)) - (at try.functor each (text#= expected)) - (try.else false)))) - (do random.monad - [property (random.alphabetic 1)] - (_.coverage [/.unknown_property] - (case (/.result (/.property property) /.empty) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.unknown_property error)))) - ))) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index 19576d27d..37b9d2892 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -6,7 +6,7 @@ ["[1][0]" file] ["[1][0]" shell] ["[1][0]" console] - ["[1][0]" program] + ["[1][0]" environment] ["[1][0]" input ["[1]/[0]" keyboard]] ["[1][0]" output @@ -23,7 +23,7 @@ /file.test /shell.test /console.test - /program.test + /environment.test /input/keyboard.test /output/video/resolution.test /net/http/client.test diff --git a/stdlib/source/test/lux/world/environment.lux b/stdlib/source/test/lux/world/environment.lux new file mode 100644 index 000000000..ee9879d21 --- /dev/null +++ b/stdlib/source/test/lux/world/environment.lux @@ -0,0 +1,113 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)]] + [control + ["//" parser (.use "[1]#[0]" monad)] + ["[0]" pipe] + ["[0]" io] + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" text (.use "[1]#[0]" equivalence)] + [collection + ["[0]" dictionary] + ["[0]" list]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]]]] + ["[0]" \\parser (.only Environment)] + [\\library + ["[0]" / (.only) + [// + [file (.only Path)]]]] + [\\specification + ["$[0]" /]]) + +(def \\parser + Test + (<| (_.covering \\parser._) + (_.for [\\parser.Environment \\parser.Parser]) + (all _.and + (_.coverage [\\parser.empty] + (dictionary.empty? \\parser.empty)) + (do random.monad + [expected random.nat] + (_.coverage [\\parser.result] + (|> (\\parser.result (//#in expected) \\parser.empty) + (at try.functor each (n.= expected)) + (try.else false)))) + (do random.monad + [property (random.alphabetic 1) + expected (random.alphabetic 1)] + (_.coverage [\\parser.Property \\parser.property] + (|> \\parser.empty + (dictionary.has property expected) + (\\parser.result (\\parser.property property)) + (at try.functor each (text#= expected)) + (try.else false)))) + (do random.monad + [property (random.alphabetic 1)] + (_.coverage [\\parser.unknown_property] + (case (\\parser.result (\\parser.property property) \\parser.empty) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? \\parser.unknown_property error)))) + ))) + +(def (environment env_size) + (-> Nat (Random Environment)) + (random.dictionary text.hash env_size + (random.alphabetic 5) + (random.alphabetic 5))) + +(def path + (Random Path) + (random.alphabetic 5)) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [env_size (at ! each (|>> (n.% 10) ++) random.nat) + environment (..environment env_size) + home ..path + directory ..path + + unknown (random.alphabetic 1)] + (all _.and + (_.for [/.mock /.async] + ($/.spec (/.async (/.mock environment home directory)))) + (_.coverage [/.environment] + (let [it (/.mock environment home directory)] + (io.run! + (do io.monad + [actual (/.environment io.monad it)] + (in (and (n.= (dictionary.size environment) + (dictionary.size actual)) + (|> actual + dictionary.entries + (list.every? (function (_ [key value]) + (|> environment + (dictionary.value key) + (maybe#each (text#= value)) + (maybe.else false))))))))))) + (_.coverage [/.unknown_environment_variable] + (let [it (/.mock environment home directory)] + (|> unknown + (at it variable) + io.run! + (pipe.case {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.unknown_environment_variable error))))) + + ..\\parser + )))) diff --git a/stdlib/source/test/lux/world/program.lux b/stdlib/source/test/lux/world/program.lux deleted file mode 100644 index 545401bee..000000000 --- a/stdlib/source/test/lux/world/program.lux +++ /dev/null @@ -1,78 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" io] - ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" try] - ["[0]" exception] - [parser - [environment (.only Environment)]]] - [data - ["[0]" text (.use "[1]#[0]" equivalence)] - [collection - ["[0]" dictionary] - ["[0]" list]]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat]]]]] - [\\library - ["[0]" / (.only) - [// - [file (.only Path)]]]] - [\\specification - ["$[0]" /]]) - -(def (environment env_size) - (-> Nat (Random Environment)) - (random.dictionary text.hash env_size - (random.alphabetic 5) - (random.alphabetic 5))) - -(def path - (Random Path) - (random.alphabetic 5)) - -(def .public test - Test - (<| (_.covering /._) - (do [! random.monad] - [env_size (at ! each (|>> (n.% 10) ++) random.nat) - environment (..environment env_size) - home ..path - directory ..path - - unknown (random.alphabetic 1)] - (all _.and - (_.for [/.mock /.async] - ($/.spec (/.async (/.mock environment home directory)))) - (_.coverage [/.environment] - (let [program (/.mock environment home directory)] - (io.run! - (do io.monad - [actual (/.environment io.monad program)] - (in (and (n.= (dictionary.size environment) - (dictionary.size actual)) - (|> actual - dictionary.entries - (list.every? (function (_ [key value]) - (|> environment - (dictionary.value key) - (maybe#each (text#= value)) - (maybe.else false))))))))))) - (_.coverage [/.unknown_environment_variable] - (let [program (/.mock environment home directory)] - (|> unknown - (at program variable) - io.run! - (pipe.case {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.unknown_environment_variable error))))) - )))) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index c8738d3a3..09126a8a3 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -9,9 +9,7 @@ ["[0]" exception (.only exception)] ["[0]" io (.only IO)] [concurrency - ["[0]" async (.only Async)]] - [parser - ["[0]" environment (.only Environment)]]] + ["[0]" async (.only Async)]]] [data ["[0]" text (.use "[1]#[0]" equivalence)] [collection @@ -24,7 +22,9 @@ [\\library ["[0]" / (.only) [// - [file (.only Path)]]]] + [file (.only Path)] + ["[0]" environment + ["[1]" \\parser (.only Environment)]]]]] [\\specification ["$[0]" /]]) -- cgit v1.2.3