path: root/stdlib/source/library/lux/world/environment.lux

(.`` (.`` (.require
           [library
            [lux (.except)
             [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))))]
             [math
              [number
               ["i" int]]]
             [meta
              ["[0]" macro (.only)
               ["[0]" template]]
              [compiler
               ["@" target]]]]]
           ["[0]" \\parser]
           [//
            [file (.only Path)]
            [shell (.only Exit)]])))

(exception.def .public (unknown_environment_variable name)
  (Exception Text)
  (exception.report
   (list ["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 (of environment available_variables [])
     entries (monad.each ! (function (_ name)
                             (of ! each (|>> [name]) (of environment variable name)))
                         variables)]
    (in (|> entries
            (list.all (function (_ [name value])
                        (when 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 [<method>]
             [(def <method>
                (of environment <method>))]

             [home]
             [directory]
             ))

       (,, (with_template [<method>]
             [(def <method>
                (|>> (of environment <method>) 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 (when (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 [<jvm> (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>)
       @.jvm (these <jvm>)
       @.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))
                     (when (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))
                     (when [(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])]
                        (when outcome
                          {try.#Success outcome}
                          (when 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
       ...        (nominal.def Pair Any)
       ...        (nominal.def 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 [<jvm> (|> (java/lang/System::getenv)
                                 java/util/Map::keySet
                                 java/util/Set::iterator
                                 ..jvm::consume
                                 (list#each (|>> ffi.of_string))
                                 io.io)]
       (for @.old <jvm>
            @.jvm <jvm>
            @.js (io.io (if ffi.on_node_js?
                          (when (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 (of 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 <method> <post>)
                    [(do io.monad
                       [value (|> name <method>)]
                       (in (when value
                             {.#Some value}
                             {try.#Success (<post> value)}

                             {.#None}
                             (exception.except ..unknown_environment_variable [name]))))]]
       (with_expansions [<jvm> (!fetch (<| java/lang/System::resolveEnv ffi.as_string) ffi.of_string)]
         (for @.old <jvm>
              @.jvm <jvm>
              @.js (io.io (if ffi.on_node_js?
                            (when (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 [<default> (io.io "~")
                        <jvm> (|> (java/lang/System::getProperty (ffi.as_string "user.home"))
                                  (maybe#each (|>> ffi.of_string))
                                  (maybe.else "")
                                  io.io)]
        (for @.old <jvm>
             @.jvm <jvm>
             @.js (if ffi.on_node_js?
                    (|> (node_js.require "os")
                        maybe.trusted
                        (as NodeJs_OS)
                        NodeJs_OS::homedir)
                    <default>)
             @.python (os/path::expanduser "~")
             @.lua (..run_command "~" "echo ~")
             @.ruby (Dir::home)
             ... @.php (do io.monad
             ...         [output (..getenv/1 ["HOME"])]
             ...         (in (if (bit#= false (as Bit output))
             ...                 "~"
             ...                 output)))
             
             ... TODO: Replace dummy implementation.
             <default>))))

   (def directory
     (io.run!
      (with_expansions [<default> "."
                        <jvm> (|> (java/lang/System::getProperty (ffi.as_string "user.dir"))
                                  (maybe#each (|>> ffi.of_string))
                                  (maybe.else "")
                                  io.io)]
        (for @.old <jvm>
             @.jvm <jvm>
             @.js (if ffi.on_node_js?
                    (when (ffi.global ..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 (same? default on_windows)
                       (..run_command default "pwd")
                       (in on_windows)))
             @.ruby (FileUtils::pwd)
             ... @.php (do io.monad
             ...         [output (..getcwd [])]
             ...         (in (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 (ffi.as_int code))]
                               (in (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 (Kernel::exit code)
            ... @.php (..exit [code])
            ... @.scheme (..exit [code])
            )))))