diff options
Diffstat (limited to 'stdlib/source/lux/world/program.lux')
| -rw-r--r-- | stdlib/source/lux/world/program.lux | 450 |
1 files changed, 0 insertions, 450 deletions
diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux deleted file mode 100644 index c64f9ffa7..000000000 --- a/stdlib/source/lux/world/program.lux +++ /dev/null @@ -1,450 +0,0 @@ -(.module: - [lux #* - ["@" target] - ["." ffi (#+ import:)] - [abstract - ["." monad (#+ Monad do)]] - [control - ["." function] - ["." io (#+ IO)] - ["." try (#+ Try)] - ["." exception (#+ exception:)] - [concurrency - ["." atom] - ["." promise (#+ Promise)]] - [parser - ["." environment (#+ Environment)]]] - [data - ["." bit ("#\." equivalence)] - ["." maybe] - ["." text - ["%" format (#+ format)]] - [collection - ["." array (#+ Array)] - ["." dictionary (#+ Dictionary)] - ["." list ("#\." functor)]]] - ["." macro - ["." template]] - [math - [number - ["i" int]]] - [type - abstract]] - [// - [file (#+ Path)] - [shell (#+ Exit)]]) - -(exception: #export (unknown_environment_variable {name Text}) - (exception.report - ["Name" (%.text name)])) - -(interface: #export (Program !) - (: (-> Any (! (List Text))) - available_variables) - (: (-> Text (! (Try Text))) - variable) - (: Path - home) - (: Path - directory) - (: (-> Exit (! Nothing)) - exit)) - -(def: #export (environment monad program) - (All [!] (-> (Monad !) (Program !) (! Environment))) - (do {! monad} - [variables (\ program available_variables []) - entries (monad.map ! (function (_ name) - (\ ! map (|>> [name]) (\ program variable name))) - variables)] - (wrap (|> entries - (list.all (function (_ [name value]) - (case value - (#try.Success value) - (#.Some [name value]) - - (#try.Failure _) - #.None))) - (dictionary.from_list text.hash))))) - -(`` (implementation: #export (async program) - (-> (Program IO) (Program Promise)) - - (~~ (template [<method>] - [(def: <method> - (\ program <method>))] - - [home] - [directory] - )) - - (~~ (template [<method>] - [(def: <method> - (|>> (\ program <method>) promise.future))] - - [available_variables] - [variable] - [exit] - )))) - -(def: #export (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.get name environment) - (#.Some value) - (#try.Success value) - - #.None - (exception.throw ..unknown_environment_variable [name])))) - (def: home - home) - (def: directory - directory) - (def: (exit code) - (io.io (error! (%.int code))))))) - -## 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 [<jvm> (as_is (import: java/lang/String) - - (import: (java/util/Iterator a) - ["#::." - (hasNext [] boolean) - (next [] a)]) - - (import: (java/util/Set a) - ["#::." - (iterator [] (java/util/Iterator a))]) - - (import: (java/util/Map k v) - ["#::." - (keySet [] (java/util/Set k))]) - - (import: java/lang/System - ["#::." - (#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 (java/util/Iterator::hasNext iterator) - (#.Cons (java/util/Iterator::next iterator) - (jvm\\consume iterator)) - #.Nil)) - )] - (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>) - @.js (as_is (def: default_exit! - (-> Exit (IO Nothing)) - (|>> %.int error! io.io)) - - (import: NodeJs_Process - ["#::." - (exit [ffi.Number] #io Nothing) - (cwd [] #io Path)]) - - (def: (exit_node_js! code) - (-> Exit (IO Nothing)) - (case (ffi.constant ..NodeJs_Process [process]) - (#.Some process) - (NodeJs_Process::exit (i.frac code) process) - - #.None - (..default_exit! code))) - - (import: Browser_Window - ["#::." - (close [] Nothing)]) - - (import: Browser_Location - ["#::." - (reload [] Nothing)]) - - (def: (exit_browser! code) - (-> Exit (IO Nothing)) - (case [(ffi.constant ..Browser_Window [window]) - (ffi.constant ..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 - ["#::." - (#static entries [Object] (Array (Array ffi.String)))]) - - (import: NodeJs_OS - ["#::." - (homedir [] #io Path)]) - - (template [<name> <path>] - [(def: (<name> _) - (-> [] (Maybe (-> ffi.String Any))) - (ffi.constant (-> ffi.String Any) <path>))] - - [normal_require [require]] - [global_require [global require]] - [process_load [global process mainModule constructor _load]] - ) - - (def: (require _) - (-> [] (-> ffi.String Any)) - (case [(normal_require []) (global_require []) (process_load [])] - (^or [(#.Some require) _ _] - [_ (#.Some require) _] - [_ _ (#.Some require)]) - require - - _ - (undefined)))) - @.python (as_is (import: os - ["#::." - (#static getcwd [] #io ffi.String) - (#static _exit [ffi.Integer] #io Nothing)]) - - (import: os/path - ["#::." - (#static expanduser [ffi.String] #io ffi.String)]) - - (import: os/environ - ["#::." - (#static keys [] #io (Array ffi.String)) - (#static get [ffi.String] #io #? ffi.String)])) - @.lua (as_is (ffi.import: LuaFile - ["#::." - (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)] - (wrap (maybe.default default ?output))) - - #.None - (wrap default)) - - (#try.Failure _) - (wrap default))))) - @.ruby (as_is (ffi.import: Env #as RubyEnv - ["#::." - (#static keys [] (Array Text)) - (#static fetch [Text] #io #? Text)]) - - (ffi.import: "fileutils" FileUtils #as RubyFileUtils - ["#::." - (#static pwd [] #io Path)]) - - (ffi.import: Dir #as RubyDir - ["#::." - (#static home [] #io Path)]) - - (ffi.import: Kernel #as RubyKernel - ["#::." - (#static exit [Int] #io Nothing)])) - - ## @.php - ## (as_is (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 - ## (as_is (ffi.import: (exit [Int] #io Nothing)) - ## ## https://srfi.schemers.org/srfi-98/srfi-98.html - ## (abstract: Pair Any) - ## (abstract: 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))) - } - (as_is))) - -(implementation: #export default - (Program IO) - - (def: (available_variables _) - (with_expansions [<jvm> (io.io (|> (java/lang/System::getenv) - java/util/Map::keySet - java/util/Set::iterator - ..jvm\\consume))] - (for {@.old <jvm> - @.jvm <jvm> - @.js (io.io (if ffi.on_node_js? - (case (ffi.constant Object [process env]) - (#.Some process/env) - (|> (Object::entries [process/env]) - array.to_list - (list\map (|>> (array.read 0) maybe.assume))) - - #.None - (list)) - (list))) - @.python (\ io.monad map array.to_list (os/environ::keys [])) - ## Lua offers no way to get all the environment variables available. - @.lua (io.io (list)) - @.ruby (|> (RubyEnv::keys []) - array.to_list - io.io) - ## @.php (do io.monad - ## [environment (..getenv/0 [])] - ## (wrap (|> environment - ## ..array_keys - ## array.to_list - ## (list\map (function (_ variable) - ## [variable ("php array read" (:as Nat variable) environment)])) - ## (dictionary.from_list text.hash)))) - ## @.scheme (do io.monad - ## [input (..get-environment-variables [])] - ## (loop [input input - ## output environment.empty] - ## (if ("scheme object nil?" input) - ## (wrap output) - ## (let [entry (..head input)] - ## (recur (..tail input) - ## (dictionary.put (..car entry) (..cdr entry) output)))))) - }))) - - (def: (variable name) - (template.let [(!fetch <method>) - [(do io.monad - [value (<method> name)] - (wrap (case value - (#.Some value) - (#try.Success value) - - #.None - (exception.throw ..unknown_environment_variable [name]))))]] - (with_expansions [<jvm> (!fetch java/lang/System::resolveEnv)] - (for {@.old <jvm> - @.jvm <jvm> - @.js (io.io (if ffi.on_node_js? - (case (do maybe.monad - [process/env (ffi.constant Object [process env])] - (array.read (:as Nat name) - (:as (Array Text) process/env))) - (#.Some value) - (#try.Success value) - - #.None - (exception.throw ..unknown_environment_variable [name])) - (exception.throw ..unknown_environment_variable [name]))) - @.python (!fetch os/environ::get) - @.lua (!fetch os/getenv) - @.ruby (!fetch RubyEnv::fetch) - })))) - - (def: home - (io.run - (with_expansions [<default> (io.io "~") - <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] - (for {@.old <jvm> - @.jvm <jvm> - @.js (if ffi.on_node_js? - (|> (..require [] "os") - (:as NodeJs_OS) - (NodeJs_OS::homedir [])) - <default>) - @.python (os/path::expanduser ["~"]) - @.lua (..run_command "~" "echo ~") - @.ruby (RubyDir::home []) - ## @.php (do io.monad - ## [output (..getenv/1 ["HOME"])] - ## (wrap (if (bit\= false (:as Bit output)) - ## "~" - ## output))) - } - ## TODO: Replace dummy implementation. - <default>)))) - - (def: directory - (io.run - (with_expansions [<default> "." - <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] - (for {@.old <jvm> - @.jvm <jvm> - @.js (if ffi.on_node_js? - (case (ffi.constant ..NodeJs_Process [process]) - (#.Some process) - (NodeJs_Process::cwd [] process) - - #.None - (io.io <default>)) - (io.io <default>)) - @.python (os::getcwd []) - @.lua (do io.monad - [#let [default <default>] - on_windows (..run_command default "cd")] - (if (is? default on_windows) - (..run_command default "pwd") - (wrap on_windows))) - @.ruby (RubyFileUtils::pwd []) - ## @.php (do io.monad - ## [output (..getcwd [])] - ## (wrap (if (bit\= false (:as Bit output)) - ## "." - ## output))) - } - ## TODO: Replace dummy implementation. - (io.io <default>))))) - - (def: (exit code) - (with_expansions [<jvm> (do io.monad - [_ (java/lang/System::exit code)] - (wrap (undefined)))] - (for {@.old <jvm> - @.jvm <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 (RubyKernel::exit [code]) - ## @.php (..exit [code]) - ## @.scheme (..exit [code]) - })))) |