From 8cd61c00de00728759d0362a60dbca8d23e4d8dc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 28 May 2019 22:14:53 -0400 Subject: Both the old JVM interop and the new JVM interop use the same syntax for array types. --- lux-cl/source/program.lux | 2 +- lux-js/source/program.lux | 10 +- lux-lua/source/program.lux | 7 +- lux-php/source/program.lux | 6 +- lux-python/source/program.lux | 4 +- lux-ruby/source/program.lux | 10 +- lux-scheme/source/program.lux | 4 +- new-luxc/source/luxc/lang/host/jvm/def.lux | 10 +- new-luxc/source/luxc/lang/host/jvm/inst.lux | 4 +- new-luxc/source/luxc/lang/translation/r.lux | 2 +- new-luxc/source/program.lux | 4 +- stdlib/source/lux/data/text/encoding.lux | 17 +- stdlib/source/lux/debug.lux | 14 +- stdlib/source/lux/host.jvm.lux | 4 +- stdlib/source/lux/host.old.lux | 87 ++-- stdlib/source/lux/target/jvm/loader.lux | 124 +++++ stdlib/source/lux/target/jvm/loader.old.lux | 126 ----- stdlib/source/lux/target/jvm/reflection.lux | 28 +- .../tool/compiler/phase/extension/analysis/jvm.lux | 22 +- stdlib/source/lux/world/binary.lux | 34 +- stdlib/source/lux/world/db/jdbc.lux | 175 +++++++ stdlib/source/lux/world/db/jdbc.old.lux | 175 ------- stdlib/source/lux/world/db/jdbc/input.lux | 109 ++++ stdlib/source/lux/world/db/jdbc/input.old.lux | 109 ---- stdlib/source/lux/world/db/jdbc/output.lux | 189 +++++++ stdlib/source/lux/world/db/jdbc/output.old.lux | 189 ------- stdlib/source/lux/world/environment.lux | 52 ++ stdlib/source/lux/world/environment.old.lux | 52 -- stdlib/source/lux/world/file.lux | 557 +++++++-------------- stdlib/source/lux/world/net/tcp.lux | 129 +++++ stdlib/source/lux/world/net/tcp.old.lux | 129 ----- stdlib/source/lux/world/net/udp.lux | 124 +++++ stdlib/source/lux/world/net/udp.old.lux | 124 ----- stdlib/source/lux/world/shell.lux | 4 +- 34 files changed, 1222 insertions(+), 1414 deletions(-) create mode 100644 stdlib/source/lux/target/jvm/loader.lux delete mode 100644 stdlib/source/lux/target/jvm/loader.old.lux create mode 100644 stdlib/source/lux/world/db/jdbc.lux delete mode 100644 stdlib/source/lux/world/db/jdbc.old.lux create mode 100644 stdlib/source/lux/world/db/jdbc/input.lux delete mode 100644 stdlib/source/lux/world/db/jdbc/input.old.lux create mode 100644 stdlib/source/lux/world/db/jdbc/output.lux delete mode 100644 stdlib/source/lux/world/db/jdbc/output.old.lux create mode 100644 stdlib/source/lux/world/environment.lux delete mode 100644 stdlib/source/lux/world/environment.old.lux create mode 100644 stdlib/source/lux/world/net/tcp.lux delete mode 100644 stdlib/source/lux/world/net/tcp.old.lux create mode 100644 stdlib/source/lux/world/net/udp.lux delete mode 100644 stdlib/source/lux/world/net/udp.old.lux diff --git a/lux-cl/source/program.lux b/lux-cl/source/program.lux index 5c5a249c8..8d6218297 100644 --- a/lux-cl/source/program.lux +++ b/lux-cl/source/program.lux @@ -138,7 +138,7 @@ (`` (|> sub-value (~~ (template.splice )))) #.None)] - [(Array java/lang/Object) [host-value]] + [[java/lang/Object] [host-value]] [java/lang/Boolean [..host-bit]] [java/lang/Integer [java/lang/Integer::longValue org/armedbear/lisp/Fixnum::getInstance]] [java/lang/Long [org/armedbear/lisp/Bignum::getInstance]] diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index 1a2bfc8d8..30ab46ced 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -55,7 +55,7 @@ (doubleValue [] double)) (import: #long java/util/Arrays - (#static [t] copyOfRange [(Array t) int int] (Array t))) + (#static [t] copyOfRange [[t] int int] [t])) (import: #long javax/script/ScriptEngine (eval [java/lang/String] #try #? java/lang/Object)) @@ -72,7 +72,7 @@ (getSlot [int] #? java/lang/Object) (getMember [java/lang/String] #? java/lang/Object) (hasMember [java/lang/String] boolean) - (call [#? java/lang/Object (Array java/lang/Object)] #try java/lang/Object)) + (call [#? java/lang/Object [java/lang/Object]] #try java/lang/Object)) (import: #long jdk/nashorn/api/scripting/AbstractJSObject) @@ -132,7 +132,7 @@ (isFunction) boolean #1) (jdk/nashorn/api/scripting/AbstractJSObject - (call {this java/lang/Object} {args (Array java/lang/Object)}) java/lang/Object + (call {this java/lang/Object} {args [java/lang/Object]}) java/lang/Object (debug.inspect js-object)) )) @@ -144,7 +144,7 @@ (isFunction) boolean #1) (jdk/nashorn/api/scripting/AbstractJSObject - (call {this java/lang/Object} {args (Array java/lang/Object)}) java/lang/Object + (call {this java/lang/Object} {args [java/lang/Object]}) java/lang/Object (|> (java/util/Arrays::copyOfRange value (|> args (array.read 0) maybe.assume (:coerce Int)) (.int (array.size value))) @@ -156,7 +156,7 @@ (-> (Array java/lang/Object) jdk/nashorn/api/scripting/JSObject) (let [js-object (: (-> java/lang/Object jdk/nashorn/api/scripting/JSObject) (function (_ sub-value) - (<| (case (host.check (Array java/lang/Object) sub-value) + (<| (case (host.check [java/lang/Object] sub-value) (#.Some sub-value) (|> sub-value (:coerce (Array java/lang/Object)) js-structure) #.None) diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux index 13d6862b0..2851fec7d 100644 --- a/lux-lua/source/program.lux +++ b/lux-lua/source/program.lux @@ -104,10 +104,7 @@ (import: #long net/sandius/rembulan/exec/DirectCallExecutor (#static newExecutor [] net/sandius/rembulan/exec/DirectCallExecutor) (schedulingContextFactory [] net/sandius/rembulan/runtime/SchedulingContextFactory) - (call [net/sandius/rembulan/StateContext - java/lang/Object - (Array java/lang/Object)] - #try (Array java/lang/Object))) + (call [net/sandius/rembulan/StateContext java/lang/Object [java/lang/Object]] #try [java/lang/Object])) (exception: (unknown-kind-of-object {object java/lang/Object}) (exception.report @@ -127,7 +124,7 @@ (def: (lux-structure value) (-> (Array java/lang/Object) program/StructureValue) (let [re-wrap (function (_ unwrapped) - (case (host.check (Array java/lang/Object) unwrapped) + (case (host.check [java/lang/Object] unwrapped) (#.Some sub-value) (|> sub-value (:coerce (Array java/lang/Object)) lux-structure (:coerce java/lang/Object)) diff --git a/lux-php/source/program.lux b/lux-php/source/program.lux index f3f445bd9..a65999526 100644 --- a/lux-php/source/program.lux +++ b/lux-php/source/program.lux @@ -79,7 +79,7 @@ (getValue [] php/runtime/Memory)) (import: #long php/runtime/memory/ArrayMemory - (new [(Array java/lang/Object)]) + (new [[java/lang/Object]]) (size [] int) (isMap [] boolean) (get [php/runtime/Memory] php/runtime/Memory)) @@ -98,11 +98,11 @@ (import: #long php/runtime/reflection/FunctionEntity) (import: #long php/runtime/invoke/InvokeHelper - (#static callAny [php/runtime/Memory (Array php/runtime/Memory) php/runtime/env/Environment php/runtime/env/TraceInfo] + (#static callAny [php/runtime/Memory [php/runtime/Memory] php/runtime/env/Environment php/runtime/env/TraceInfo] #try php/runtime/Memory)) (import: #long php/runtime/lang/Closure - (call [php/runtime/env/Environment (Array php/runtime/Memory)] #try php/runtime/Memory)) + (call [php/runtime/env/Environment [php/runtime/Memory]] #try php/runtime/Memory)) (template [] [(interface: diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 41a720b36..756b27b9c 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -70,7 +70,7 @@ (__len__ [] int)) (import: #long org/python/core/PyFunction - (__call__ [(Array org/python/core/PyObject)] org/python/core/PyObject)) + (__call__ [[org/python/core/PyObject]] org/python/core/PyObject)) (import: #long org/python/core/PyArray (new [(java/lang/Class java/lang/Object) java/lang/Object]) @@ -150,7 +150,7 @@ [org/python/core/PyString org/python/core/PyObject::asString] [org/python/core/PyFunction (|>)] [org/python/core/PyArray org/python/core/PyArray::getArray] - [(Array java/lang/Object) (|>)] + [[java/lang/Object] (|>)] )) (~~ (template [ ] [(case (host.check host-object) diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux index 0eeed48ec..48a398233 100644 --- a/lux-ruby/source/program.lux +++ b/lux-ruby/source/program.lux @@ -114,8 +114,8 @@ [[org/jruby/runtime/ThreadContext int java/lang/String org/jruby/runtime/builtin/IRubyObject]] [[org/jruby/runtime/ThreadContext java/lang/String]] [[org/jruby/runtime/ThreadContext java/lang/String org/jruby/runtime/builtin/IRubyObject]] - ## [[org/jruby/runtime/ThreadContext java/lang/String (Array org/jruby/runtime/builtin/IRubyObject)]] - [[org/jruby/runtime/ThreadContext java/lang/String (Array org/jruby/runtime/builtin/IRubyObject) org/jruby/runtime/Block]] + ## [[org/jruby/runtime/ThreadContext java/lang/String [org/jruby/runtime/builtin/IRubyObject]]] + [[org/jruby/runtime/ThreadContext java/lang/String [org/jruby/runtime/builtin/IRubyObject] org/jruby/runtime/Block]] ) (template [ ] [(org/jruby/runtime/builtin/IRubyObject @@ -155,7 +155,7 @@ [callSuper [org/jruby/runtime/ThreadContext - (Array org/jruby/runtime/builtin/IRubyObject) + [org/jruby/runtime/builtin/IRubyObject] org/jruby/runtime/Block] org/jruby/runtime/builtin/IRubyObject] @@ -187,7 +187,7 @@ (org/jruby/runtime/builtin/IRubyObject (callMethod {thread-context org/jruby/runtime/ThreadContext} {member java/lang/String} - {inputs (Array org/jruby/runtime/builtin/IRubyObject)}) + {inputs [org/jruby/runtime/builtin/IRubyObject]}) org/jruby/runtime/builtin/IRubyObject (exec (log! (format "Was called: " (%t member))) @@ -197,7 +197,7 @@ )))) (import: #long org/jruby/RubyProc - (call [org/jruby/runtime/ThreadContext (Array org/jruby/runtime/builtin/IRubyObject)] + (call [org/jruby/runtime/ThreadContext [org/jruby/runtime/builtin/IRubyObject]] org/jruby/runtime/builtin/IRubyObject)) (import: #long org/jruby/Ruby diff --git a/lux-scheme/source/program.lux b/lux-scheme/source/program.lux index b4adddec9..8eb29a3aa 100644 --- a/lux-scheme/source/program.lux +++ b/lux-scheme/source/program.lux @@ -86,7 +86,7 @@ (def: (variant? value) (-> Any Bit) - (case (host.check (Array java/lang/Object) (:coerce java/lang/Object value)) + (case (host.check [java/lang/Object] (:coerce java/lang/Object value)) (#.Some array) ## TODO: Get rid of this coercion ASAP. (let [array (:coerce (Array java/lang/Object) array)] @@ -194,7 +194,7 @@ (def: (lux-value value) (-> java/lang/Object java/lang/Object) - (<| (case (host.check (Array java/lang/Object) value) + (<| (case (host.check [java/lang/Object] value) (#.Some value) ## TODO: Get rid of the coercions below. (if (variant? value) diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index ce236c905..bf4abc8ed 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -57,11 +57,11 @@ (#static COMPUTE_MAXS int) (#static COMPUTE_FRAMES int) (new [int]) - (visit [int int String String String (Array String)] void) + (visit [int int String String String [String]] void) (visitEnd [] void) (visitField [int String String String Object] FieldVisitor) - (visitMethod [int String String String (Array String)] MethodVisitor) - (toByteArray [] (Array byte))) + (visitMethod [int String String String [String]] MethodVisitor) + (toByteArray [] [byte])) (def: (string-array values) (-> (List Text) (Array Text)) @@ -161,7 +161,7 @@ [(def: #export ( version visibility config name parameters super interfaces definitions) (-> //.Version //.Visibility //.Class-Config Text (List Parameter) Class (List Class) //.Def - (host.type (Array byte))) + (host.type [byte])) (let [writer (|> (do-to (ClassWriter::new class-computes) (ClassWriter::visit (version-flag version) ($_ i/+ @@ -188,7 +188,7 @@ (def: #export (interface version visibility config name parameters interfaces definitions) (-> //.Version //.Visibility //.Class-Config Text (List Parameter) (List Class) //.Def - (host.type (Array byte))) + (host.type [byte])) (let [writer (|> (do-to (ClassWriter::new class-computes) (ClassWriter::visit (version-flag version) ($_ i/+ diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index 040f6f04a..aeb9621ef 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -122,8 +122,8 @@ (visitLabel [org/objectweb/asm/Label] void) (visitJumpInsn [int org/objectweb/asm/Label] void) (visitTryCatchBlock [org/objectweb/asm/Label org/objectweb/asm/Label org/objectweb/asm/Label java/lang/String] void) - (visitLookupSwitchInsn [org/objectweb/asm/Label (Array int) (Array org/objectweb/asm/Label)] void) - (visitTableSwitchInsn [int int org/objectweb/asm/Label (Array org/objectweb/asm/Label)] void) + (visitLookupSwitchInsn [org/objectweb/asm/Label [int] [org/objectweb/asm/Label]] void) + (visitTableSwitchInsn [int int org/objectweb/asm/Label [org/objectweb/asm/Label]] void) ) ## [Insts] diff --git a/new-luxc/source/luxc/lang/translation/r.lux b/new-luxc/source/luxc/lang/translation/r.lux index d5a9f35fa..a4a3db1f5 100644 --- a/new-luxc/source/luxc/lang/translation/r.lux +++ b/new-luxc/source/luxc/lang/translation/r.lux @@ -31,7 +31,7 @@ (host.import: java/lang/Object) (host.import: java/lang/String - (getBytes [String] #try (Array byte))) + (getBytes [String] #try [byte])) (host.import: java/lang/CharSequence) diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index 46462ab34..8a00858b1 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -41,10 +41,10 @@ ["." host]]]]]]) (import: #long java/lang/reflect/Method - (invoke [java/lang/Object (Array java/lang/Object)] #try java/lang/Object)) + (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)) (import: #long (java/lang/Class c) - (getMethod [java/lang/String (Array (java/lang/Class java/lang/Object))] #try java/lang/reflect/Method)) + (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method)) (import: #long java/lang/Object (getClass [] (java/lang/Class java/lang/Object))) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index e1066bbcd..2752903a7 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -171,15 +171,14 @@ (|>> :representation)) ) -(`` (for {(~~ (static @.old)) - (as-is (import: #long java/lang/String - (new [(Array byte) java/lang/String]) - (getBytes [java/lang/String] (Array byte)))) - - (~~ (static @.jvm)) - (as-is (import: #long java/lang/String - (new [[byte] java/lang/String]) - (getBytes [java/lang/String] [byte])))})) +(with-expansions [ (as-is (import: #long java/lang/String + (new [[byte] java/lang/String]) + (getBytes [java/lang/String] [byte])))] + (`` (for {(~~ (static @.old)) + (as-is ) + + (~~ (static @.jvm)) + (as-is )}))) (def: #export (to-utf8 value) (-> Text Binary) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 43d3f4762..59b35a223 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -38,13 +38,13 @@ (getClass [] (java/lang/Class java/lang/Object))) (import: #long java/lang/Integer - (longValue [] java/lang/Long)) + (longValue [] long)) (import: #long java/lang/Long - (intValue [] java/lang/Integer)) + (intValue [] int)) (import: #long java/lang/Number - (intValue [] java/lang/Integer) + (intValue [] int) (longValue [] long) (doubleValue [] double)) @@ -57,12 +57,12 @@ (`` (|> value (~~ (template.splice )))) #.None)] - [java/lang/Boolean [%b]] - [java/lang/String [%t]] - [java/lang/Long [.int %i]] + [java/lang/Boolean [(:coerce .Bit) %b]] + [java/lang/String [(:coerce .Text) %t]] + [java/lang/Long [(:coerce .Int) %i]] [java/lang/Number [java/lang/Number::doubleValue %f]] )) - (case (host.check (Array java/lang/Object) object) + (case (host.check [java/lang/Object] object) (#.Some value) (let [value (:coerce (Array java/lang/Object) value)] (case (array.read 0 value) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 88ffc16f6..d4bc8f3d1 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1783,7 +1783,7 @@ "#io means the computation has side effects, and will be wrapped by the IO type." "These options must show up in the following order [#io #try #?] (although, each option can be used independently)." (import: java/lang/String - (new [(Array byte)]) + (new [[byte]]) (#static valueOf [char] String) (#static valueOf #as int-valueOf [int] String)) @@ -1792,7 +1792,7 @@ (get [int] e)) (import: (java/util/ArrayList a) - ([T] toArray [(Array T)] (Array T))) + ([T] toArray [[T]] [T])) "#long makes it so the class-type that is generated is of the fully-qualified name." "In this case, it avoids a clash between the java.util.List type, and Lux's own List type." diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 32bb3887f..5c2ac40d9 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -669,47 +669,48 @@ (def: (generic-type^ imports type-vars) (-> Class-Imports (List Type-Parameter) (Parser GenericType)) - ($_ p.either - (do p.monad - [_ (s.this! (' ?))] - (wrap (#GenericWildcard #.None))) - (s.tuple (do p.monad - [_ (s.this! (' ?)) - bound-kind bound-kind^ - bound (generic-type^ imports type-vars)] - (wrap (#GenericWildcard (#.Some [bound-kind bound]))))) - (do p.monad - [name (full-class-name^ imports) - _ (assert-no-periods name)] - (if (list.member? text.equivalence (list@map product.left type-vars) name) - (wrap (#GenericTypeVar name)) - (wrap (#GenericClass name (list))))) - (s.form (do p.monad - [name (s.this! (' Array)) - component (generic-type^ imports type-vars)] - (case component - (^template [ ] - (#GenericClass #.Nil) - (wrap (#GenericClass (list)))) - (["[Z" "boolean"] - ["[B" "byte"] - ["[S" "short"] - ["[I" "int"] - ["[J" "long"] - ["[F" "float"] - ["[D" "double"] - ["[C" "char"]) - - _ - (wrap (#GenericArray component))))) - (s.form (do p.monad - [name (full-class-name^ imports) - _ (assert-no-periods name) - params (p.some (generic-type^ imports type-vars)) - _ (p.assert (format name " cannot be a type-parameter!") - (not (list.member? text.equivalence (list@map product.left type-vars) name)))] - (wrap (#GenericClass name params)))) - )) + (p.rec + (function (_ recur^) + ($_ p.either + (do p.monad + [_ (s.this! (' ?))] + (wrap (#GenericWildcard #.None))) + (s.tuple (do p.monad + [_ (s.this! (' ?)) + bound-kind bound-kind^ + bound recur^] + (wrap (#GenericWildcard (#.Some [bound-kind bound]))))) + (do p.monad + [name (full-class-name^ imports) + _ (assert-no-periods name)] + (if (list.member? text.equivalence (list@map product.left type-vars) name) + (wrap (#GenericTypeVar name)) + (wrap (#GenericClass name (list))))) + (s.tuple (do p.monad + [component recur^] + (case component + (^template [ ] + (#GenericClass #.Nil) + (wrap (#GenericClass (list)))) + (["[Z" "boolean"] + ["[B" "byte"] + ["[S" "short"] + ["[I" "int"] + ["[J" "long"] + ["[F" "float"] + ["[D" "double"] + ["[C" "char"]) + + _ + (wrap (#GenericArray component))))) + (s.form (do p.monad + [name (full-class-name^ imports) + _ (assert-no-periods name) + params (p.some recur^) + _ (p.assert (format name " cannot be a type-parameter!") + (not (list.member? text.equivalence (list@map product.left type-vars) name)))] + (wrap (#GenericClass name params)))) + )))) (def: (type-param^ imports) (-> Class-Imports (Parser Type-Parameter)) @@ -1816,7 +1817,7 @@ "#io means the computation has side effects, and will be wrapped by the IO type." "These options must show up in the following order [#io #try #?] (although, each option can be used independently)." (import: java/lang/String - (new [(Array byte)]) + (new [[byte]]) (#static valueOf [char] String) (#static valueOf #as int-valueOf [int] String)) @@ -1825,7 +1826,7 @@ (get [int] e)) (import: (java/util/ArrayList a) - ([T] toArray [(Array T)] (Array T))) + ([T] toArray [[T]] [T])) "#long makes it so the class-type that is generated is of the fully-qualified name." "In this case, it avoids a clash between the java.util.List type, and Lux's own List type." diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux new file mode 100644 index 000000000..ae4d0373c --- /dev/null +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -0,0 +1,124 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["ex" exception (#+ exception:)] + ["." io (#+ IO)] + [concurrency + ["." atom (#+ Atom)]]] + [data + ["." error (#+ Error)] + ["." text + format] + [collection + ["." array] + ["." list ("#;." functor)] + ["." dictionary (#+ Dictionary)]]] + [world + ["." binary (#+ Binary)]] + ["." host (#+ import: object do-to)]]) + +(type: #export Library + (Atom (Dictionary Text Binary))) + +(exception: #export (already-stored {class Text}) + (ex.report ["Class" class])) + +(exception: #export (unknown {class Text} {known-classes (List Text)}) + (ex.report ["Class" class] + ["Known classes" (|> known-classes + (list.sort (:: text.order <)) + (list;map (|>> (format text.new-line text.tab))) + (text.join-with ""))])) + +(exception: #export (cannot-define {class Text} {error Text}) + (ex.report ["Class" class] + ["Error" error])) + +(import: #long java/lang/Object + (getClass [] (java/lang/Class java/lang/Object))) + +(import: #long java/lang/String) + +(import: #long java/lang/reflect/Method + (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)) + +(import: #long (java/lang/Class a) + (getDeclaredMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method)) + +(import: #long java/lang/Integer + (#static TYPE (java/lang/Class java/lang/Integer))) + +(import: #long java/lang/reflect/AccessibleObject + (setAccessible [boolean] void)) + +(import: #long java/lang/ClassLoader + (loadClass [java/lang/String] + #io #try (java/lang/Class java/lang/Object))) + +(def: java/lang/ClassLoader::defineClass + java/lang/reflect/Method + (let [signature (|> (host.array (java/lang/Class java/lang/Object) 4) + (host.array-write 0 (:coerce (java/lang/Class java/lang/Object) + (host.class-for java/lang/String))) + (host.array-write 1 (java/lang/Object::getClass (host.array byte 0))) + (host.array-write 2 (:coerce (java/lang/Class java/lang/Object) + (java/lang/Integer::TYPE))) + (host.array-write 3 (:coerce (java/lang/Class java/lang/Object) + (java/lang/Integer::TYPE))))] + (do-to (error.assume + (java/lang/Class::getDeclaredMethod "defineClass" + signature + (host.class-for java/lang/ClassLoader))) + (java/lang/reflect/AccessibleObject::setAccessible true)))) + +(def: #export (define class-name bytecode loader) + (-> Text Binary java/lang/ClassLoader (Error java/lang/Object)) + (let [signature (array.from-list (list (:coerce java/lang/Object + class-name) + (:coerce java/lang/Object + bytecode) + (:coerce java/lang/Object + (host.long-to-int +0)) + (:coerce java/lang/Object + (host.long-to-int (.int (binary.size bytecode))))))] + (java/lang/reflect/Method::invoke loader signature java/lang/ClassLoader::defineClass))) + +(def: #export (new-library _) + (-> Any Library) + (atom.atom (dictionary.new text.hash))) + +(def: #export (memory library) + (-> Library java/lang/ClassLoader) + (object [] java/lang/ClassLoader [] + [] + (java/lang/ClassLoader (findClass self {class-name java/lang/String}) java/lang/Class + (let [classes (|> library atom.read io.run)] + (case (dictionary.get class-name classes) + (#.Some bytecode) + (case (|> self + (..define class-name bytecode)) + (#error.Success class) + (:assume class) + + (#error.Failure error) + (error! (ex.construct ..cannot-define [class-name error]))) + + #.None + (error! (ex.construct ..unknown [class-name (dictionary.keys classes)]))))))) + +(def: #export (store name bytecode library) + (-> Text Binary Library (IO (Error Any))) + (do io.monad + [library' (atom.read library)] + (if (dictionary.contains? name library') + (wrap (ex.throw ..already-stored name)) + (do @ + [_ (atom.update (dictionary.put name bytecode) library)] + (wrap (#error.Success [])))))) + +(def: #export (load name loader) + (-> Text java/lang/ClassLoader + (IO (Error (java/lang/Class java/lang/Object)))) + (java/lang/ClassLoader::loadClass name loader)) diff --git a/stdlib/source/lux/target/jvm/loader.old.lux b/stdlib/source/lux/target/jvm/loader.old.lux deleted file mode 100644 index 57a715107..000000000 --- a/stdlib/source/lux/target/jvm/loader.old.lux +++ /dev/null @@ -1,126 +0,0 @@ -(.module: - [lux #* - [abstract - [monad (#+ do)]] - [control - ["ex" exception (#+ exception:)] - ["." io (#+ IO)] - [concurrency - ["." atom (#+ Atom)]]] - [data - ["." error (#+ Error)] - ["." text - format] - [collection - ["." array] - ["." list ("#;." functor)] - ["." dictionary (#+ Dictionary)]]] - [world - ["." binary (#+ Binary)]] - ["." host (#+ import: object do-to)]]) - -(type: #export Library - (Atom (Dictionary Text Binary))) - -(exception: #export (already-stored {class Text}) - (ex.report ["Class" class])) - -(exception: #export (unknown {class Text} {known-classes (List Text)}) - (ex.report ["Class" class] - ["Known classes" (|> known-classes - (list.sort (:: text.order <)) - (list;map (|>> (format text.new-line text.tab))) - (text.join-with ""))])) - -(exception: #export (cannot-define {class Text} {error Text}) - (ex.report ["Class" class] - ["Error" error])) - -(import: #long java/lang/Object - (getClass [] (java/lang/Class java/lang/Object))) - -(import: #long java/lang/String) - -(import: #long java/lang/reflect/Method - (invoke [java/lang/Object (Array java/lang/Object)] - #try java/lang/Object)) - -(import: #long (java/lang/Class a) - (getDeclaredMethod [java/lang/String (Array (java/lang/Class java/lang/Object))] - #try java/lang/reflect/Method)) - -(import: #long java/lang/Integer - (#static TYPE (java/lang/Class java/lang/Integer))) - -(import: #long java/lang/reflect/AccessibleObject - (setAccessible [boolean] void)) - -(import: #long java/lang/ClassLoader - (loadClass [java/lang/String] - #io #try (java/lang/Class java/lang/Object))) - -(def: java/lang/ClassLoader::defineClass - java/lang/reflect/Method - (let [signature (|> (host.array (java/lang/Class java/lang/Object) 4) - (host.array-write 0 (:coerce (java/lang/Class java/lang/Object) - (host.class-for java/lang/String))) - (host.array-write 1 (java/lang/Object::getClass (host.array byte 0))) - (host.array-write 2 (:coerce (java/lang/Class java/lang/Object) - (java/lang/Integer::TYPE))) - (host.array-write 3 (:coerce (java/lang/Class java/lang/Object) - (java/lang/Integer::TYPE))))] - (do-to (error.assume - (java/lang/Class::getDeclaredMethod "defineClass" - signature - (host.class-for java/lang/ClassLoader))) - (java/lang/reflect/AccessibleObject::setAccessible true)))) - -(def: #export (define class-name bytecode loader) - (-> Text Binary java/lang/ClassLoader (Error java/lang/Object)) - (let [signature (array.from-list (list (:coerce java/lang/Object - class-name) - (:coerce java/lang/Object - bytecode) - (:coerce java/lang/Object - (host.long-to-int +0)) - (:coerce java/lang/Object - (host.long-to-int (.int (binary.size bytecode))))))] - (java/lang/reflect/Method::invoke loader signature java/lang/ClassLoader::defineClass))) - -(def: #export (new-library _) - (-> Any Library) - (atom.atom (dictionary.new text.hash))) - -(def: #export (memory library) - (-> Library java/lang/ClassLoader) - (object [] java/lang/ClassLoader [] - [] - (java/lang/ClassLoader (findClass self {class-name java/lang/String}) java/lang/Class - (let [classes (|> library atom.read io.run)] - (case (dictionary.get class-name classes) - (#.Some bytecode) - (case (|> self - (..define class-name bytecode)) - (#error.Success class) - (:assume class) - - (#error.Failure error) - (error! (ex.construct ..cannot-define [class-name error]))) - - #.None - (error! (ex.construct ..unknown [class-name (dictionary.keys classes)]))))))) - -(def: #export (store name bytecode library) - (-> Text Binary Library (IO (Error Any))) - (do io.monad - [library' (atom.read library)] - (if (dictionary.contains? name library') - (wrap (ex.throw ..already-stored name)) - (do @ - [_ (atom.update (dictionary.put name bytecode) library)] - (wrap (#error.Success [])))))) - -(def: #export (load name loader) - (-> Text java/lang/ClassLoader - (IO (Error (java/lang/Class java/lang/Object)))) - (java/lang/ClassLoader::loadClass name loader)) diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux index 4ae3ce64f..090c5948f 100644 --- a/stdlib/source/lux/target/jvm/reflection.lux +++ b/stdlib/source/lux/target/jvm/reflection.lux @@ -35,15 +35,15 @@ (import: #long java/lang/reflect/ParameterizedType (getRawType [] java/lang/reflect/Type) - (getActualTypeArguments [] (Array java/lang/reflect/Type))) + (getActualTypeArguments [] [java/lang/reflect/Type])) (import: #long (java/lang/reflect/TypeVariable d) (getName [] java/lang/String) - (getBounds [] (Array java/lang/reflect/Type))) + (getBounds [] [java/lang/reflect/Type])) (import: #long (java/lang/reflect/WildcardType d) - (getLowerBounds [] (Array java/lang/reflect/Type)) - (getUpperBounds [] (Array java/lang/reflect/Type))) + (getLowerBounds [] [java/lang/reflect/Type]) + (getUpperBounds [] [java/lang/reflect/Type])) (import: #long java/lang/reflect/Modifier (#static isStatic [int] boolean) @@ -60,29 +60,29 @@ (getName [] java/lang/String) (getModifiers [] int) (getDeclaringClass [] (java/lang/Class java/lang/Object)) - (getTypeParameters [] (Array (java/lang/reflect/TypeVariable java/lang/reflect/Method))) - (getGenericParameterTypes [] (Array java/lang/reflect/Type)) + (getTypeParameters [] [(java/lang/reflect/TypeVariable java/lang/reflect/Method)]) + (getGenericParameterTypes [] [java/lang/reflect/Type]) (getGenericReturnType [] java/lang/reflect/Type) - (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) + (getGenericExceptionTypes [] [java/lang/reflect/Type])) (import: #long (java/lang/reflect/Constructor c) (getModifiers [] int) (getDeclaringClass [] (java/lang/Class c)) - (getTypeParameters [] (Array (java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c)))) - (getGenericParameterTypes [] (Array java/lang/reflect/Type)) - (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) + (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c))]) + (getGenericParameterTypes [] [java/lang/reflect/Type]) + (getGenericExceptionTypes [] [java/lang/reflect/Type])) (import: #long (java/lang/Class c) (#static forName [java/lang/String] #try (java/lang/Class java/lang/Object)) (getName [] java/lang/String) (getModifiers [] int) (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean) - (getTypeParameters [] (Array (java/lang/reflect/TypeVariable (java/lang/Class c)))) - (getGenericInterfaces [] (Array java/lang/reflect/Type)) + (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))]) + (getGenericInterfaces [] [java/lang/reflect/Type]) (getGenericSuperclass [] #? java/lang/reflect/Type) (getDeclaredField [java/lang/String] #try java/lang/reflect/Field) - (getConstructors [] (Array (java/lang/reflect/Constructor java/lang/Object))) - (getDeclaredMethods [] (Array java/lang/reflect/Method))) + (getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)]) + (getDeclaredMethods [] [java/lang/reflect/Method])) (exception: #export (unknown-class {class Text}) (exception.report diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux index 1f7cbe26e..616f030a9 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux @@ -654,7 +654,7 @@ (import: #long (java/lang/reflect/TypeVariable d) (getName [] java/lang/String) - (getBounds [] (Array java/lang/reflect/Type))) + (getBounds [] [java/lang/reflect/Type])) (import: #long java/lang/reflect/Modifier (#static isStatic [int] boolean) @@ -666,29 +666,29 @@ (getName [] java/lang/String) (getModifiers [] int) (getDeclaringClass [] (java/lang/Class java/lang/Object)) - (getTypeParameters [] (Array (java/lang/reflect/TypeVariable java/lang/reflect/Method))) - (getGenericParameterTypes [] (Array java/lang/reflect/Type)) + (getTypeParameters [] [(java/lang/reflect/TypeVariable java/lang/reflect/Method)]) + (getGenericParameterTypes [] [java/lang/reflect/Type]) (getGenericReturnType [] java/lang/reflect/Type) - (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) + (getGenericExceptionTypes [] [java/lang/reflect/Type])) (import: #long (java/lang/reflect/Constructor c) (getModifiers [] int) (getDeclaringClass [] (java/lang/Class c)) - (getTypeParameters [] (Array (java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c)))) - (getGenericParameterTypes [] (Array java/lang/reflect/Type)) - (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) + (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c))]) + (getGenericParameterTypes [] [java/lang/reflect/Type]) + (getGenericExceptionTypes [] [java/lang/reflect/Type])) (import: #long (java/lang/Class c) (#static forName [java/lang/String] #try (java/lang/Class java/lang/Object)) (getName [] java/lang/String) (getModifiers [] int) (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean) - (getTypeParameters [] (Array (java/lang/reflect/TypeVariable (java/lang/Class c)))) - (getGenericInterfaces [] (Array java/lang/reflect/Type)) + (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))]) + (getGenericInterfaces [] [java/lang/reflect/Type]) (getGenericSuperclass [] #? java/lang/reflect/Type) (getDeclaredField [java/lang/String] #try java/lang/reflect/Field) - (getConstructors [] (Array (java/lang/reflect/Constructor java/lang/Object))) - (getDeclaredMethods [] (Array java/lang/reflect/Method))) + (getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)]) + (getDeclaredMethods [] [java/lang/reflect/Method])) (def: (reflection-type mapping typeJ) (-> Mapping Type (Operation .Type)) diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux index 56bf01620..9599ae2f0 100644 --- a/stdlib/source/lux/world/binary.lux +++ b/stdlib/source/lux/world/binary.lux @@ -15,7 +15,7 @@ [text format] [collection - [array (#+ Array)]]]]) + [array (#+)]]]]) (exception: #export (index-out-of-bounds {size Nat} {index Nat}) (exception.report @@ -33,29 +33,21 @@ [inverted-slice] ) -(`` (for {(~~ (static @.old)) - (as-is (type: #export Binary (host.type (Array byte))) +(with-expansions [ (as-is (type: #export Binary (host.type [byte])) - (import: #long java/lang/Object) + (import: #long java/lang/Object) + + (import: #long java/lang/System + (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)) - (import: #long java/lang/System - (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)) - - (import: #long java/util/Arrays - (#static copyOfRange [(Array byte) int int] (Array byte)) - (#static equals [(Array byte) (Array byte)] boolean))) - - (~~ (static @.jvm)) - (as-is (type: #export Binary (host.type [byte])) - - (import: #long java/lang/Object) - - (import: #long java/lang/System - (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)) + (import: #long java/util/Arrays + (#static copyOfRange [[byte] int int] [byte]) + (#static equals [[byte] [byte]] boolean)))] + (`` (for {(~~ (static @.old)) + (as-is ) - (import: #long java/util/Arrays - (#static copyOfRange [[byte] int int] [byte]) - (#static equals [[byte] [byte]] boolean)))})) + (~~ (static @.jvm)) + (as-is )}))) (def: byte-mask I64 diff --git a/stdlib/source/lux/world/db/jdbc.lux b/stdlib/source/lux/world/db/jdbc.lux new file mode 100644 index 000000000..8fd0ecf4c --- /dev/null +++ b/stdlib/source/lux/world/db/jdbc.lux @@ -0,0 +1,175 @@ +(.module: + [lux (#- and int) + [control + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)] + ["ex" exception] + [concurrency + ["." promise (#+ Promise) ("#;." monad)]] + [security + ["!" capability (#+ capability:)]]] + [data + ["." product] + ["." error (#+ Error)] + [text + format] + [collection + ["." list ("#;." fold)]]] + ["." io (#+ IO)] + [world + [net (#+ URL)]] + [host (#+ import:)]] + [// + ["." sql]] + ["." / #_ + ["#." input (#+ Input)] + ["#." output (#+ Output)]]) + +(import: #long java/sql/ResultSet + (getRow [] #try int) + (next [] #try boolean) + (close [] #io #try void)) + +(import: #long java/sql/Statement + (#static NO_GENERATED_KEYS int) + (#static RETURN_GENERATED_KEYS int) + (getGeneratedKeys [] #try java/sql/ResultSet) + (close [] #io #try void)) + +(import: #long java/sql/PreparedStatement + (executeUpdate [] #io #try int) + (executeQuery [] #io #try java/sql/ResultSet)) + +(import: #long java/sql/Connection + (prepareStatement [String int] #try java/sql/PreparedStatement) + (isValid [int] #try boolean) + (close [] #io #try void)) + +(import: #long java/sql/DriverManager + (#static getConnection [String String String] #io #try java/sql/Connection)) + +(type: #export Credentials + {#url URL + #user Text + #password Text}) + +(type: #export ID Int) + +(type: #export (Statement input) + {#sql sql.Statement + #input (Input input) + #value input}) + +(template [ ] + [(capability: #export ( ! i) + ( (Statement i) (! (Error ))))] + + [Can-Execute can-execute Nat] + [Can-Insert can-insert (List ID)] + ) + +(capability: #export (Can-Query ! i o) + (can-query [(Statement i) (Output o)] (! (Error (List o))))) + +(capability: #export (Can-Close !) + (can-close Any (! (Error Any)))) + +(signature: #export (DB !) + (: (Can-Execute !) + execute) + (: (Can-Insert !) + insert) + (: (Can-Query !) + query) + (: (Can-Close !) + close)) + +(def: (with-statement statement conn action) + (All [i a] + (-> (Statement i) java/sql/Connection + (-> java/sql/PreparedStatement (IO (Error a))) + (IO (Error a)))) + (do (error.with io.monad) + [prepared (io.io (java/sql/Connection::prepareStatement (sql.sql (get@ #sql statement)) + (java/sql/Statement::RETURN_GENERATED_KEYS) + conn)) + _ (io.io ((get@ #input statement) (get@ #value statement) [1 prepared])) + result (action prepared) + _ (java/sql/Statement::close prepared)] + (wrap result))) + +(def: #export (async db) + (-> (DB IO) (DB Promise)) + (`` (structure + (~~ (template [ ] + [(def: ( (|>> (!.use (:: db )) promise.future)))] + + [execute can-execute] + [insert can-insert] + [close can-close] + [query can-query]))))) + +(def: #export (connect creds) + (-> Credentials (IO (Error (DB IO)))) + (do (error.with io.monad) + [connection (java/sql/DriverManager::getConnection (get@ #url creds) + (get@ #user creds) + (get@ #password creds))] + (wrap (: (DB IO) + (structure + (def: execute + (..can-execute + (function (execute statement) + (with-statement statement connection + (function (_ prepared) + (do (error.with io.monad) + [row-count (java/sql/PreparedStatement::executeUpdate prepared)] + (wrap (.nat row-count)))))))) + + (def: insert + (..can-insert + (function (insert statement) + (with-statement statement connection + (function (_ prepared) + (do (error.with io.monad) + [_ (java/sql/PreparedStatement::executeUpdate prepared) + result-set (io.io (java/sql/Statement::getGeneratedKeys prepared))] + (/output.rows /output.long result-set))))))) + + (def: close + (..can-close + (function (close _) + (java/sql/Connection::close connection)))) + + (def: query + (..can-query + (function (query [statement output]) + (with-statement statement connection + (function (_ prepared) + (do (error.with io.monad) + [result-set (java/sql/PreparedStatement::executeQuery prepared)] + (/output.rows output result-set))))))) + ))))) + +(def: #export (with-db creds action) + (All [a] + (-> Credentials + (-> (DB IO) (IO (Error a))) + (IO (Error a)))) + (do (error.with io.monad) + [db (..connect creds) + result (action db) + _ (!.use (:: db close) [])] + (wrap result))) + +(def: #export (with-async-db creds action) + (All [a] + (-> Credentials + (-> (DB Promise) (Promise (Error a))) + (Promise (Error a)))) + (do (error.with promise.monad) + [db (promise.future (..connect creds)) + result (action (..async db)) + _ (promise;wrap (io.run (!.use (:: db close) [])))] + (wrap result))) diff --git a/stdlib/source/lux/world/db/jdbc.old.lux b/stdlib/source/lux/world/db/jdbc.old.lux deleted file mode 100644 index 8fd0ecf4c..000000000 --- a/stdlib/source/lux/world/db/jdbc.old.lux +++ /dev/null @@ -1,175 +0,0 @@ -(.module: - [lux (#- and int) - [control - [functor (#+ Functor)] - [apply (#+ Apply)] - [monad (#+ Monad do)] - ["ex" exception] - [concurrency - ["." promise (#+ Promise) ("#;." monad)]] - [security - ["!" capability (#+ capability:)]]] - [data - ["." product] - ["." error (#+ Error)] - [text - format] - [collection - ["." list ("#;." fold)]]] - ["." io (#+ IO)] - [world - [net (#+ URL)]] - [host (#+ import:)]] - [// - ["." sql]] - ["." / #_ - ["#." input (#+ Input)] - ["#." output (#+ Output)]]) - -(import: #long java/sql/ResultSet - (getRow [] #try int) - (next [] #try boolean) - (close [] #io #try void)) - -(import: #long java/sql/Statement - (#static NO_GENERATED_KEYS int) - (#static RETURN_GENERATED_KEYS int) - (getGeneratedKeys [] #try java/sql/ResultSet) - (close [] #io #try void)) - -(import: #long java/sql/PreparedStatement - (executeUpdate [] #io #try int) - (executeQuery [] #io #try java/sql/ResultSet)) - -(import: #long java/sql/Connection - (prepareStatement [String int] #try java/sql/PreparedStatement) - (isValid [int] #try boolean) - (close [] #io #try void)) - -(import: #long java/sql/DriverManager - (#static getConnection [String String String] #io #try java/sql/Connection)) - -(type: #export Credentials - {#url URL - #user Text - #password Text}) - -(type: #export ID Int) - -(type: #export (Statement input) - {#sql sql.Statement - #input (Input input) - #value input}) - -(template [ ] - [(capability: #export ( ! i) - ( (Statement i) (! (Error ))))] - - [Can-Execute can-execute Nat] - [Can-Insert can-insert (List ID)] - ) - -(capability: #export (Can-Query ! i o) - (can-query [(Statement i) (Output o)] (! (Error (List o))))) - -(capability: #export (Can-Close !) - (can-close Any (! (Error Any)))) - -(signature: #export (DB !) - (: (Can-Execute !) - execute) - (: (Can-Insert !) - insert) - (: (Can-Query !) - query) - (: (Can-Close !) - close)) - -(def: (with-statement statement conn action) - (All [i a] - (-> (Statement i) java/sql/Connection - (-> java/sql/PreparedStatement (IO (Error a))) - (IO (Error a)))) - (do (error.with io.monad) - [prepared (io.io (java/sql/Connection::prepareStatement (sql.sql (get@ #sql statement)) - (java/sql/Statement::RETURN_GENERATED_KEYS) - conn)) - _ (io.io ((get@ #input statement) (get@ #value statement) [1 prepared])) - result (action prepared) - _ (java/sql/Statement::close prepared)] - (wrap result))) - -(def: #export (async db) - (-> (DB IO) (DB Promise)) - (`` (structure - (~~ (template [ ] - [(def: ( (|>> (!.use (:: db )) promise.future)))] - - [execute can-execute] - [insert can-insert] - [close can-close] - [query can-query]))))) - -(def: #export (connect creds) - (-> Credentials (IO (Error (DB IO)))) - (do (error.with io.monad) - [connection (java/sql/DriverManager::getConnection (get@ #url creds) - (get@ #user creds) - (get@ #password creds))] - (wrap (: (DB IO) - (structure - (def: execute - (..can-execute - (function (execute statement) - (with-statement statement connection - (function (_ prepared) - (do (error.with io.monad) - [row-count (java/sql/PreparedStatement::executeUpdate prepared)] - (wrap (.nat row-count)))))))) - - (def: insert - (..can-insert - (function (insert statement) - (with-statement statement connection - (function (_ prepared) - (do (error.with io.monad) - [_ (java/sql/PreparedStatement::executeUpdate prepared) - result-set (io.io (java/sql/Statement::getGeneratedKeys prepared))] - (/output.rows /output.long result-set))))))) - - (def: close - (..can-close - (function (close _) - (java/sql/Connection::close connection)))) - - (def: query - (..can-query - (function (query [statement output]) - (with-statement statement connection - (function (_ prepared) - (do (error.with io.monad) - [result-set (java/sql/PreparedStatement::executeQuery prepared)] - (/output.rows output result-set))))))) - ))))) - -(def: #export (with-db creds action) - (All [a] - (-> Credentials - (-> (DB IO) (IO (Error a))) - (IO (Error a)))) - (do (error.with io.monad) - [db (..connect creds) - result (action db) - _ (!.use (:: db close) [])] - (wrap result))) - -(def: #export (with-async-db creds action) - (All [a] - (-> Credentials - (-> (DB Promise) (Promise (Error a))) - (Promise (Error a)))) - (do (error.with promise.monad) - [db (promise.future (..connect creds)) - result (action (..async db)) - _ (promise;wrap (io.run (!.use (:: db close) [])))] - (wrap result))) diff --git a/stdlib/source/lux/world/db/jdbc/input.lux b/stdlib/source/lux/world/db/jdbc/input.lux new file mode 100644 index 000000000..b160c5a5c --- /dev/null +++ b/stdlib/source/lux/world/db/jdbc/input.lux @@ -0,0 +1,109 @@ +(.module: + [lux (#- and int) + [control + [functor (#+ Contravariant)] + [monad (#+ Monad do)]] + [data + ["." error (#+ Error)] + [collection + ["." list ("#;." fold)]]] + [time + ["." instant (#+ Instant)]] + ["." io (#+ IO)] + [world + [binary (#+ Binary)]] + [host (#+ import:)]]) + +(import: #long java/lang/String) + +(template [] + [(import: #long + (new [long]))] + + [java/sql/Date] [java/sql/Time] [java/sql/Timestamp] + ) + +(`` (import: #long java/sql/PreparedStatement + (~~ (template [ ] + [( [int ] #try void)] + + [setBoolean boolean] + + [setByte byte] + [setShort short] + [setInt int] + [setLong long] + + [setFloat float] + [setDouble double] + + [setString java/lang/String] + [setBytes [byte]] + + [setDate java/sql/Date] + [setTime java/sql/Time] + [setTimestamp java/sql/Timestamp] + )))) + +(type: #export (Input a) + (-> a [Nat java/sql/PreparedStatement] + (Error [Nat java/sql/PreparedStatement]))) + +(structure: #export contravariant (Contravariant Input) + (def: (map-1 f fb) + (function (fa value circumstance) + (fb (f value) circumstance)))) + +(def: #export (and pre post) + (All [l r] (-> (Input l) (Input r) (Input [l r]))) + (function (_ [left right] context) + (do error.monad + [context (pre left context)] + (post right context)))) + +(def: #export (fail error) + (All [a] (-> Text (Input a))) + (function (_ value [idx context]) + (#error.Failure error))) + +(def: #export empty + (Input Any) + (function (_ value context) + (#error.Success context))) + +(template [ ] + [(def: #export + (Input ) + (function (_ value [idx statement]) + (do error.monad + [_ ( (.int idx) value statement)] + (wrap [(.inc idx) statement]))))] + + [boolean Bit java/sql/PreparedStatement::setBoolean] + + [byte Int java/sql/PreparedStatement::setByte] + [short Int java/sql/PreparedStatement::setShort] + [int Int java/sql/PreparedStatement::setInt] + [long Int java/sql/PreparedStatement::setLong] + + [float Frac java/sql/PreparedStatement::setFloat] + [double Frac java/sql/PreparedStatement::setDouble] + + [string Text java/sql/PreparedStatement::setString] + [bytes Binary java/sql/PreparedStatement::setBytes] + ) + +(template [ ] + [(def: #export + (Input Instant) + (function (_ value [idx statement]) + (do error.monad + [_ ( (.int idx) + ( (instant.to-millis value)) + statement)] + (wrap [(.inc idx) statement]))))] + + [date java/sql/PreparedStatement::setDate java/sql/Date::new] + [time java/sql/PreparedStatement::setTime java/sql/Time::new] + [time-stamp java/sql/PreparedStatement::setTimestamp java/sql/Timestamp::new] + ) diff --git a/stdlib/source/lux/world/db/jdbc/input.old.lux b/stdlib/source/lux/world/db/jdbc/input.old.lux deleted file mode 100644 index 68045b058..000000000 --- a/stdlib/source/lux/world/db/jdbc/input.old.lux +++ /dev/null @@ -1,109 +0,0 @@ -(.module: - [lux (#- and int) - [control - [functor (#+ Contravariant)] - [monad (#+ Monad do)]] - [data - ["." error (#+ Error)] - [collection - ["." list ("#;." fold)]]] - [time - ["." instant (#+ Instant)]] - ["." io (#+ IO)] - [world - [binary (#+ Binary)]] - [host (#+ import:)]]) - -(import: #long java/lang/String) - -(template [] - [(import: #long - (new [long]))] - - [java/sql/Date] [java/sql/Time] [java/sql/Timestamp] - ) - -(`` (import: #long java/sql/PreparedStatement - (~~ (template [ ] - [( [int ] #try void)] - - [setBoolean boolean] - - [setByte byte] - [setShort short] - [setInt int] - [setLong long] - - [setFloat float] - [setDouble double] - - [setString java/lang/String] - [setBytes (Array byte)] - - [setDate java/sql/Date] - [setTime java/sql/Time] - [setTimestamp java/sql/Timestamp] - )))) - -(type: #export (Input a) - (-> a [Nat java/sql/PreparedStatement] - (Error [Nat java/sql/PreparedStatement]))) - -(structure: #export contravariant (Contravariant Input) - (def: (map-1 f fb) - (function (fa value circumstance) - (fb (f value) circumstance)))) - -(def: #export (and pre post) - (All [l r] (-> (Input l) (Input r) (Input [l r]))) - (function (_ [left right] context) - (do error.monad - [context (pre left context)] - (post right context)))) - -(def: #export (fail error) - (All [a] (-> Text (Input a))) - (function (_ value [idx context]) - (#error.Failure error))) - -(def: #export empty - (Input Any) - (function (_ value context) - (#error.Success context))) - -(template [ ] - [(def: #export - (Input ) - (function (_ value [idx statement]) - (do error.monad - [_ ( (.int idx) value statement)] - (wrap [(.inc idx) statement]))))] - - [boolean Bit java/sql/PreparedStatement::setBoolean] - - [byte Int java/sql/PreparedStatement::setByte] - [short Int java/sql/PreparedStatement::setShort] - [int Int java/sql/PreparedStatement::setInt] - [long Int java/sql/PreparedStatement::setLong] - - [float Frac java/sql/PreparedStatement::setFloat] - [double Frac java/sql/PreparedStatement::setDouble] - - [string Text java/sql/PreparedStatement::setString] - [bytes Binary java/sql/PreparedStatement::setBytes] - ) - -(template [ ] - [(def: #export - (Input Instant) - (function (_ value [idx statement]) - (do error.monad - [_ ( (.int idx) - ( (instant.to-millis value)) - statement)] - (wrap [(.inc idx) statement]))))] - - [date java/sql/PreparedStatement::setDate java/sql/Date::new] - [time java/sql/PreparedStatement::setTime java/sql/Time::new] - [time-stamp java/sql/PreparedStatement::setTimestamp java/sql/Timestamp::new] - ) diff --git a/stdlib/source/lux/world/db/jdbc/output.lux b/stdlib/source/lux/world/db/jdbc/output.lux new file mode 100644 index 000000000..8c461bb68 --- /dev/null +++ b/stdlib/source/lux/world/db/jdbc/output.lux @@ -0,0 +1,189 @@ +(.module: + [lux (#- and int) + [control + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)] + ["ex" exception]] + [data + ["." error (#+ Error)]] + [time + ["." instant (#+ Instant)]] + ["." io (#+ IO)] + [world + [binary (#+ Binary)]] + [host (#+ import:)]]) + +(import: #long java/lang/String) + +(import: #long java/util/Date + (getTime [] long)) + +(import: #long java/sql/Date) +(import: #long java/sql/Time) +(import: #long java/sql/Timestamp) + +(`` (import: #long java/sql/ResultSet + (~~ (template [ ] + [( [int] #try )] + + [getBoolean boolean] + + [getByte byte] + [getShort short] + [getInt int] + [getLong long] + + [getDouble double] + [getFloat float] + + [getString java/lang/String] + [getBytes [byte]] + + [getDate java/sql/Date] + [getTime java/sql/Time] + [getTimestamp java/sql/Timestamp] + )) + (next [] #try boolean) + (close [] #io #try void))) + +(type: #export (Output a) + (-> [Nat java/sql/ResultSet] (Error [Nat a]))) + +(structure: #export functor (Functor Output) + (def: (map f fa) + (function (_ idx+rs) + (case (fa idx+rs) + (#error.Failure error) + (#error.Failure error) + + (#error.Success [idx' value]) + (#error.Success [idx' (f value)]))))) + +(structure: #export apply (Apply Output) + (def: &functor ..functor) + + (def: (apply ff fa) + (function (_ [idx rs]) + (case (ff [idx rs]) + (#error.Success [idx' f]) + (case (fa [idx' rs]) + (#error.Success [idx'' a]) + (#error.Success [idx'' (f a)]) + + (#error.Failure msg) + (#error.Failure msg)) + + (#error.Failure msg) + (#error.Failure msg))))) + +(structure: #export monad (Monad Output) + (def: &functor ..functor) + + (def: (wrap a) + (function (_ [idx rs]) + (#.Some [idx a]))) + + (def: (join mma) + (function (_ [idx rs]) + (case (mma [idx rs]) + (#error.Failure error) + (#error.Failure error) + + (#error.Success [idx' ma]) + (ma [idx' rs]))))) + +(def: #export (fail error) + (All [a] (-> Text (Output a))) + (function (_ [idx result-set]) + (#error.Failure error))) + +(def: #export (and left right) + (All [a b] + (-> (Output a) (Output b) (Output [a b]))) + (do ..monad + [=left left + =right right] + (wrap [=left =right]))) + +(template [ ] + [(def: #export + (Output ) + (function (_ [idx result-set]) + (case ( [(.int idx)] result-set) + (#error.Failure error) + (#error.Failure error) + + (#error.Success value) + (#error.Success [(inc idx) value]))))] + + [boolean java/sql/ResultSet::getBoolean Bit] + + [byte java/sql/ResultSet::getByte Int] + [short java/sql/ResultSet::getShort Int] + [int java/sql/ResultSet::getInt Int] + [long java/sql/ResultSet::getLong Int] + + [float java/sql/ResultSet::getFloat Frac] + [double java/sql/ResultSet::getDouble Frac] + + [string java/sql/ResultSet::getString Text] + [bytes java/sql/ResultSet::getBytes Binary] + ) + +(template [ ] + [(def: #export + (Output Instant) + (function (_ [idx result-set]) + (case ( [(.int idx)] result-set) + (#error.Failure error) + (#error.Failure error) + + (#error.Success value) + (#error.Success [(inc idx) + (instant.from-millis (java/util/Date::getTime value))]))))] + + [date java/sql/ResultSet::getDate] + [time java/sql/ResultSet::getTime] + [time-stamp java/sql/ResultSet::getTimestamp] + ) + +(def: #export (rows output results) + (All [a] (-> (Output a) java/sql/ResultSet (IO (Error (List a))))) + (case (java/sql/ResultSet::next results) + (#error.Success has-next?) + (if has-next? + (case (output [1 results]) + (#.Some [_ head]) + (do io.monad + [?tail (rows output results)] + (case ?tail + (#error.Success tail) + (wrap (ex.return (#.Cons head tail))) + + (#error.Failure error) + (do io.monad + [temp (java/sql/ResultSet::close results)] + (wrap (do error.monad + [_ temp] + (error.fail error)))))) + + (#error.Failure error) + (do io.monad + [temp (java/sql/ResultSet::close results)] + (wrap (do error.monad + [_ temp] + (error.fail error))))) + (do io.monad + [temp (java/sql/ResultSet::close results)] + (wrap (do error.monad + [_ temp] + (wrap (list)))))) + + (#error.Failure error) + (do io.monad + [temp (java/sql/ResultSet::close results)] + (wrap (do error.monad + [_ temp] + (error.fail error)))) + )) diff --git a/stdlib/source/lux/world/db/jdbc/output.old.lux b/stdlib/source/lux/world/db/jdbc/output.old.lux deleted file mode 100644 index 39c4cb92b..000000000 --- a/stdlib/source/lux/world/db/jdbc/output.old.lux +++ /dev/null @@ -1,189 +0,0 @@ -(.module: - [lux (#- and int) - [control - [functor (#+ Functor)] - [apply (#+ Apply)] - [monad (#+ Monad do)] - ["ex" exception]] - [data - ["." error (#+ Error)]] - [time - ["." instant (#+ Instant)]] - ["." io (#+ IO)] - [world - [binary (#+ Binary)]] - [host (#+ import:)]]) - -(import: #long java/lang/String) - -(import: #long java/util/Date - (getTime [] long)) - -(import: #long java/sql/Date) -(import: #long java/sql/Time) -(import: #long java/sql/Timestamp) - -(`` (import: #long java/sql/ResultSet - (~~ (template [ ] - [( [int] #try )] - - [getBoolean boolean] - - [getByte byte] - [getShort short] - [getInt int] - [getLong long] - - [getDouble double] - [getFloat float] - - [getString java/lang/String] - [getBytes (Array byte)] - - [getDate java/sql/Date] - [getTime java/sql/Time] - [getTimestamp java/sql/Timestamp] - )) - (next [] #try boolean) - (close [] #io #try void))) - -(type: #export (Output a) - (-> [Nat java/sql/ResultSet] (Error [Nat a]))) - -(structure: #export functor (Functor Output) - (def: (map f fa) - (function (_ idx+rs) - (case (fa idx+rs) - (#error.Failure error) - (#error.Failure error) - - (#error.Success [idx' value]) - (#error.Success [idx' (f value)]))))) - -(structure: #export apply (Apply Output) - (def: &functor ..functor) - - (def: (apply ff fa) - (function (_ [idx rs]) - (case (ff [idx rs]) - (#error.Success [idx' f]) - (case (fa [idx' rs]) - (#error.Success [idx'' a]) - (#error.Success [idx'' (f a)]) - - (#error.Failure msg) - (#error.Failure msg)) - - (#error.Failure msg) - (#error.Failure msg))))) - -(structure: #export monad (Monad Output) - (def: &functor ..functor) - - (def: (wrap a) - (function (_ [idx rs]) - (#.Some [idx a]))) - - (def: (join mma) - (function (_ [idx rs]) - (case (mma [idx rs]) - (#error.Failure error) - (#error.Failure error) - - (#error.Success [idx' ma]) - (ma [idx' rs]))))) - -(def: #export (fail error) - (All [a] (-> Text (Output a))) - (function (_ [idx result-set]) - (#error.Failure error))) - -(def: #export (and left right) - (All [a b] - (-> (Output a) (Output b) (Output [a b]))) - (do ..monad - [=left left - =right right] - (wrap [=left =right]))) - -(template [ ] - [(def: #export - (Output ) - (function (_ [idx result-set]) - (case ( [(.int idx)] result-set) - (#error.Failure error) - (#error.Failure error) - - (#error.Success value) - (#error.Success [(inc idx) value]))))] - - [boolean java/sql/ResultSet::getBoolean Bit] - - [byte java/sql/ResultSet::getByte Int] - [short java/sql/ResultSet::getShort Int] - [int java/sql/ResultSet::getInt Int] - [long java/sql/ResultSet::getLong Int] - - [float java/sql/ResultSet::getFloat Frac] - [double java/sql/ResultSet::getDouble Frac] - - [string java/sql/ResultSet::getString Text] - [bytes java/sql/ResultSet::getBytes Binary] - ) - -(template [ ] - [(def: #export - (Output Instant) - (function (_ [idx result-set]) - (case ( [(.int idx)] result-set) - (#error.Failure error) - (#error.Failure error) - - (#error.Success value) - (#error.Success [(inc idx) - (instant.from-millis (java/util/Date::getTime value))]))))] - - [date java/sql/ResultSet::getDate] - [time java/sql/ResultSet::getTime] - [time-stamp java/sql/ResultSet::getTimestamp] - ) - -(def: #export (rows output results) - (All [a] (-> (Output a) java/sql/ResultSet (IO (Error (List a))))) - (case (java/sql/ResultSet::next results) - (#error.Success has-next?) - (if has-next? - (case (output [1 results]) - (#.Some [_ head]) - (do io.monad - [?tail (rows output results)] - (case ?tail - (#error.Success tail) - (wrap (ex.return (#.Cons head tail))) - - (#error.Failure error) - (do io.monad - [temp (java/sql/ResultSet::close results)] - (wrap (do error.monad - [_ temp] - (error.fail error)))))) - - (#error.Failure error) - (do io.monad - [temp (java/sql/ResultSet::close results)] - (wrap (do error.monad - [_ temp] - (error.fail error))))) - (do io.monad - [temp (java/sql/ResultSet::close results)] - (wrap (do error.monad - [_ temp] - (wrap (list)))))) - - (#error.Failure error) - (do io.monad - [temp (java/sql/ResultSet::close results)] - (wrap (do error.monad - [_ temp] - (error.fail error)))) - )) diff --git a/stdlib/source/lux/world/environment.lux b/stdlib/source/lux/world/environment.lux new file mode 100644 index 000000000..8ad10f1f9 --- /dev/null +++ b/stdlib/source/lux/world/environment.lux @@ -0,0 +1,52 @@ +(.module: + [lux #* + [data + ["." text] + [format + [context (#+ Context)]] + [collection + ["." dictionary]]] + [io (#- run)] + [host (#+ import:)]]) + +## 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 + +(import: java/lang/String) + +(import: (java/util/Map$Entry k v) + (getKey [] k) + (getValue [] v)) + +(import: (java/util/Iterator a) + (hasNext [] boolean) + (next [] a)) + +(import: (java/util/Set a) + (iterator [] (Iterator a))) + +(import: (java/util/Map k v) + (entrySet [] (Set (Map$Entry k v)))) + +(import: java/lang/System + (#static getenv [] (Map String String))) + +(def: (consume-iterator f iterator) + (All [a b] (-> (-> a b) (Iterator a) (List b))) + (if (Iterator::hasNext iterator) + (#.Cons (f (Iterator::next iterator)) + (consume-iterator f iterator)) + #.Nil)) + +(def: (entry-to-kv entry) + (All [k v] (-> (Map$Entry k v) [k v])) + [(Map$Entry::getKey entry) + (Map$Entry::getValue entry)]) + +(def: #export read + (IO Context) + (io (|> (System::getenv) + Map::entrySet + Set::iterator + (consume-iterator entry-to-kv) + (dictionary.from-list text.hash)))) diff --git a/stdlib/source/lux/world/environment.old.lux b/stdlib/source/lux/world/environment.old.lux deleted file mode 100644 index 8ad10f1f9..000000000 --- a/stdlib/source/lux/world/environment.old.lux +++ /dev/null @@ -1,52 +0,0 @@ -(.module: - [lux #* - [data - ["." text] - [format - [context (#+ Context)]] - [collection - ["." dictionary]]] - [io (#- run)] - [host (#+ import:)]]) - -## 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 - -(import: java/lang/String) - -(import: (java/util/Map$Entry k v) - (getKey [] k) - (getValue [] v)) - -(import: (java/util/Iterator a) - (hasNext [] boolean) - (next [] a)) - -(import: (java/util/Set a) - (iterator [] (Iterator a))) - -(import: (java/util/Map k v) - (entrySet [] (Set (Map$Entry k v)))) - -(import: java/lang/System - (#static getenv [] (Map String String))) - -(def: (consume-iterator f iterator) - (All [a b] (-> (-> a b) (Iterator a) (List b))) - (if (Iterator::hasNext iterator) - (#.Cons (f (Iterator::next iterator)) - (consume-iterator f iterator)) - #.Nil)) - -(def: (entry-to-kv entry) - (All [k v] (-> (Map$Entry k v) [k v])) - [(Map$Entry::getKey entry) - (Map$Entry::getValue entry)]) - -(def: #export read - (IO Context) - (io (|> (System::getenv) - Map::entrySet - Set::iterator - (consume-iterator entry-to-kv) - (dictionary.from-list text.hash)))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index f25a372fc..f60bb6974 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -17,7 +17,7 @@ ["." text format] [collection - ["." array (#+ Array)] + ["." array] ["." list ("#;." functor)]]] [time ["." instant (#+ Instant)] @@ -185,373 +185,194 @@ ["Instant" (%instant instant)] ["Path" file])) -(`` (for {(~~ (static @.old)) - (as-is (import: #long java/lang/String) - - (import: #long java/io/File - (new [java/lang/String]) - (~~ (template [] - [( [] #io #try boolean)] - - [createNewFile] [mkdir] - [exists] [delete] - [isFile] [isDirectory] - [canRead] [canWrite] [canExecute])) - - (length [] #io #try long) - (listFiles [] #io #try #? (Array java/io/File)) - (getAbsolutePath [] #io #try java/lang/String) - (renameTo [java/io/File] #io #try boolean) - (lastModified [] #io #try long) - (setLastModified [long] #io #try boolean) - (#static separator java/lang/String)) - - (template: (!delete path exception) - (do io.monad - [outcome (java/io/File::delete (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success [])) - - _ - (io.io (exception.throw exception [path]))))) - - (import: #long java/lang/AutoCloseable - (close [] #io #try void)) - - (import: java/io/OutputStream - (write [(Array byte)] #io #try void) - (flush [] #io #try void)) - - (import: java/io/FileOutputStream - (new [java/io/File boolean] #io #try)) - - (import: java/io/InputStream - (read [(Array byte)] #io #try int)) - - (import: java/io/FileInputStream - (new [java/io/File] #io #try)) - - (structure: (file path) - (-> Path (File IO)) - - (~~ (template [ ] - [(def: - (..can-modify - (function ( data) - (do (error.with io.monad) - [stream (FileOutputStream::new (java/io/File::new path) ) - _ (OutputStream::write data stream) - _ (OutputStream::flush stream)] - (java/lang/AutoCloseable::close stream)))))] - - [over-write #0] - [append #1] - )) - - (def: content - (..can-query - (function (content _) - (do (error.with io.monad) - [#let [file (java/io/File::new path)] - size (java/io/File::length file) - #let [data (binary.create (.nat size))] - stream (FileInputStream::new file) - bytes-read (InputStream::read data stream) - _ (java/lang/AutoCloseable::close stream)] - (if (i/= size bytes-read) - (wrap data) - (io.io (exception.throw cannot-read-all-data path))))))) - - (def: size - (..can-query - (function (size _) - (|> path - java/io/File::new - java/io/File::length - (:: (error.with io.monad) map .nat))))) - - (def: last-modified - (..can-query - (function (last-modified _) - (|> path - java/io/File::new - (java/io/File::lastModified) - (:: (error.with io.monad) map (|>> duration.from-millis instant.absolute)))))) - - (def: can-execute? - (..can-query - (function (can-execute? _) - (|> path - java/io/File::new - java/io/File::canExecute)))) - - (def: move - (..can-open - (function (move destination) - (do io.monad - [outcome (java/io/File::renameTo (java/io/File::new destination) - (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success (file destination))) - - _ - (io.io (exception.throw cannot-move [destination path]))))))) - - (def: modify - (..can-modify - (function (modify time-stamp) - (do io.monad - [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis) - (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success [])) - - _ - (io.io (exception.throw cannot-modify [time-stamp path]))))))) - - (def: delete - (..can-delete - (function (delete _) - (!delete path cannot-delete-file))))) - - (structure: (directory path) - (-> Path (Directory IO)) - - (~~ (template [ ] - [(def: - (..can-query - (function ( _) - (do (error.with io.monad) - [?children (java/io/File::listFiles (java/io/File::new path))] - (case ?children - (#.Some children) - (|> children - array.to-list - (monad.filter @ (|>> )) - (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath (:: @ map )))) - (:: @ join)) - - #.None - (io.io (exception.throw not-a-directory [path])))))))] - - [files java/io/File::isFile file] - [directories java/io/File::isDirectory directory] - )) - - (def: discard - (..can-delete - (function (discard _) - (!delete path cannot-discard-directory))))) - - (structure: #export system (System IO) - (~~ (template [ ] - [(def: - (..can-open - (function ( path) - (do io.monad - [#let [file (java/io/File::new path)] - outcome ( file)] - (case outcome - (#error.Success #1) - (wrap (#error.Success ( path))) - - _ - (wrap (exception.throw [path])))))))] - - [file java/io/File::isFile ..file cannot-find-file] - [create-file java/io/File::createNewFile ..file cannot-create-file] - [directory java/io/File::isDirectory ..directory cannot-find-directory] - [create-directory java/io/File::mkdir ..directory cannot-create-directory] - )) - - (def: separator (java/io/File::separator)) - )) - - (~~ (static @.jvm)) - (as-is (import: #long java/lang/String) - (import: #long java/lang/Boolean) - - (import: #long java/io/File - (new [java/lang/String]) - (~~ (template [] - [( [] #io #try boolean)] - - [createNewFile] [mkdir] - [exists] [delete] - [isFile] [isDirectory] - [canRead] [canWrite] [canExecute])) - - (length [] #io #try long) - (listFiles [] #io #try #? [java/io/File]) - (getAbsolutePath [] #io #try java/lang/String) - (renameTo [java/io/File] #io #try boolean) - (lastModified [] #io #try long) - (setLastModified [long] #io #try boolean) - (#static separator java/lang/String)) - - (template: (!delete path exception) - (do io.monad - [outcome (java/io/File::delete (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success [])) - - _ - (io.io (exception.throw exception [path]))))) - - (import: #long java/lang/AutoCloseable - (close [] #io #try void)) - - (import: java/io/OutputStream - (write [[byte]] #io #try void) - (flush [] #io #try void)) - - (import: java/io/FileOutputStream - (new [java/io/File boolean] #io #try)) - - (import: java/io/InputStream - (read [[byte]] #io #try int)) - - (import: java/io/FileInputStream - (new [java/io/File] #io #try)) - - (def: (file path) - (-> Path (File IO)) - (structure - (~~ (template [ ] - [(def: - (..can-modify - (function ( data) - (do (error.with io.monad) - [stream (FileOutputStream::new (java/io/File::new path) ) - _ (OutputStream::write data stream) - _ (OutputStream::flush stream)] - (java/lang/AutoCloseable::close stream)))))] - - [over-write #0] - [append #1] - )) - - (def: content - (..can-query - (function (content _) - (do (error.with io.monad) - [#let [file (java/io/File::new path)] - size (java/io/File::length file) - #let [data (binary.create (.nat size))] - stream (FileInputStream::new file) - bytes-read (InputStream::read data stream) - _ (java/lang/AutoCloseable::close stream)] - (if (i/= size bytes-read) - (wrap data) - (io.io (exception.throw cannot-read-all-data path))))))) - - (def: size - (..can-query - (function (size _) - (|> (java/io/File::new path) - java/io/File::length - (:: (error.with io.monad) map .nat))))) - - (def: last-modified - (..can-query - (function (last-modified _) - (|> (java/io/File::new path) - java/io/File::lastModified - (:: (error.with io.monad) map (|>> duration.from-millis instant.absolute)))))) - - (def: can-execute? - (..can-query - (function (can-execute? _) - (java/io/File::canExecute (java/io/File::new path))))) - - (def: move - (..can-open - (function (move destination) - (do io.monad - [outcome (java/io/File::renameTo (java/io/File::new destination) - (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success (file destination))) - - _ - (io.io (exception.throw cannot-move [destination path]))))))) - - (def: modify - (..can-modify - (function (modify time-stamp) - (do io.monad - [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis) - (java/io/File::new path))] - (case outcome - (#error.Success #1) - (wrap (#error.Success [])) - - _ - (io.io (exception.throw cannot-modify [time-stamp path]))))))) - - (def: delete - (..can-delete - (function (delete _) - (!delete path cannot-delete-file)))))) - - (structure: (directory path) - (-> Path (Directory IO)) - - (~~ (template [ ] - [(def: - (..can-query - (function ( _) - (do (error.with io.monad) - [?children (java/io/File::listFiles (java/io/File::new path))] - (case ?children - (#.Some children) - (|> children - array.to-list - (monad.filter @ (|>> )) - (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath - (:: @ map )))) - (:: @ join)) - - #.None - (io.io (exception.throw not-a-directory [path])))))))] - - [files java/io/File::isFile file] - [directories java/io/File::isDirectory directory] - )) - - (def: discard - (..can-delete - (function (discard _) - (!delete path cannot-discard-directory))))) - - (structure: #export system (System IO) - (~~ (template [ ] - [(def: - (..can-open - (function ( path) - (do io.monad - [#let [file (java/io/File::new path)] - outcome ( file)] - (case outcome - (#error.Success #1) - (wrap (#error.Success ( path))) - - _ - (wrap (exception.throw [path])))))))] - - [file java/io/File::isFile ..file cannot-find-file] - [create-file java/io/File::createNewFile ..file cannot-create-file] - [directory java/io/File::isDirectory ..directory cannot-find-directory] - [create-directory java/io/File::mkdir ..directory cannot-create-directory] - )) - - (def: separator (java/io/File::separator)) - ))})) +(with-expansions [ (as-is (import: #long java/lang/String) + + (import: #long java/io/File + (new [java/lang/String]) + (~~ (template [] + [( [] #io #try boolean)] + + [createNewFile] [mkdir] + [exists] [delete] + [isFile] [isDirectory] + [canRead] [canWrite] [canExecute])) + + (length [] #io #try long) + (listFiles [] #io #try #? [java/io/File]) + (getAbsolutePath [] #io #try java/lang/String) + (renameTo [java/io/File] #io #try boolean) + (lastModified [] #io #try long) + (setLastModified [long] #io #try boolean) + (#static separator java/lang/String)) + + (template: (!delete path exception) + (do io.monad + [outcome (java/io/File::delete (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success [])) + + _ + (io.io (exception.throw exception [path]))))) + + (import: #long java/lang/AutoCloseable + (close [] #io #try void)) + + (import: java/io/OutputStream + (write [[byte]] #io #try void) + (flush [] #io #try void)) + + (import: java/io/FileOutputStream + (new [java/io/File boolean] #io #try)) + + (import: java/io/InputStream + (read [[byte]] #io #try int)) + + (import: java/io/FileInputStream + (new [java/io/File] #io #try)) + + (structure: (file path) + (-> Path (File IO)) + + (~~ (template [ ] + [(def: + (..can-modify + (function ( data) + (do (error.with io.monad) + [stream (FileOutputStream::new (java/io/File::new path) ) + _ (OutputStream::write data stream) + _ (OutputStream::flush stream)] + (java/lang/AutoCloseable::close stream)))))] + + [over-write #0] + [append #1] + )) + + (def: content + (..can-query + (function (content _) + (do (error.with io.monad) + [#let [file (java/io/File::new path)] + size (java/io/File::length file) + #let [data (binary.create (.nat size))] + stream (FileInputStream::new file) + bytes-read (InputStream::read data stream) + _ (java/lang/AutoCloseable::close stream)] + (if (i/= size bytes-read) + (wrap data) + (io.io (exception.throw cannot-read-all-data path))))))) + + (def: size + (..can-query + (function (size _) + (|> path + java/io/File::new + java/io/File::length + (:: (error.with io.monad) map .nat))))) + + (def: last-modified + (..can-query + (function (last-modified _) + (|> path + java/io/File::new + (java/io/File::lastModified) + (:: (error.with io.monad) map (|>> duration.from-millis instant.absolute)))))) + + (def: can-execute? + (..can-query + (function (can-execute? _) + (|> path + java/io/File::new + java/io/File::canExecute)))) + + (def: move + (..can-open + (function (move destination) + (do io.monad + [outcome (java/io/File::renameTo (java/io/File::new destination) + (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success (file destination))) + + _ + (io.io (exception.throw cannot-move [destination path]))))))) + + (def: modify + (..can-modify + (function (modify time-stamp) + (do io.monad + [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis) + (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success [])) + + _ + (io.io (exception.throw cannot-modify [time-stamp path]))))))) + + (def: delete + (..can-delete + (function (delete _) + (!delete path cannot-delete-file))))) + + (structure: (directory path) + (-> Path (Directory IO)) + + (~~ (template [ ] + [(def: + (..can-query + (function ( _) + (do (error.with io.monad) + [?children (java/io/File::listFiles (java/io/File::new path))] + (case ?children + (#.Some children) + (|> children + array.to-list + (monad.filter @ (|>> )) + (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath (:: @ map )))) + (:: @ join)) + + #.None + (io.io (exception.throw not-a-directory [path])))))))] + + [files java/io/File::isFile file] + [directories java/io/File::isDirectory directory] + )) + + (def: discard + (..can-delete + (function (discard _) + (!delete path cannot-discard-directory))))) + + (structure: #export system (System IO) + (~~ (template [ ] + [(def: + (..can-open + (function ( path) + (do io.monad + [#let [file (java/io/File::new path)] + outcome ( file)] + (case outcome + (#error.Success #1) + (wrap (#error.Success ( path))) + + _ + (wrap (exception.throw [path])))))))] + + [file java/io/File::isFile ..file cannot-find-file] + [create-file java/io/File::createNewFile ..file cannot-create-file] + [directory java/io/File::isDirectory ..directory cannot-find-directory] + [create-directory java/io/File::mkdir ..directory cannot-create-directory] + )) + + (def: separator (java/io/File::separator)) + ))] + (`` (for {(~~ (static @.old)) + (as-is ) + + (~~ (static @.jvm)) + (as-is )}))) (template [ ] [(def: #export ( monad system path) diff --git a/stdlib/source/lux/world/net/tcp.lux b/stdlib/source/lux/world/net/tcp.lux new file mode 100644 index 000000000..a0fa13c8a --- /dev/null +++ b/stdlib/source/lux/world/net/tcp.lux @@ -0,0 +1,129 @@ +(.module: + [lux #* + [host (#+ import:)] + ["@" target] + [abstract + monad] + [control + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise Resolver)] + ["." frp (#+ Channel Sink)]] + [security + ["!" capability]]] + [data + ["." error (#+ Error)]] + [world + ["." binary (#+ Binary)]]] + ["." // (#+ Can-Read Can-Write Can-Close)]) + +(signature: #export (TCP !) + (: (Can-Read ! [Nat Binary]) + read) + + (: (Can-Write ! Binary) + write) + + (: (Can-Close !) + close)) + +(def: #export (async tcp) + (-> (TCP IO) (TCP Promise)) + (`` (structure (~~ (template [ ] + [(def: ( (|>> (!.use (:: tcp )) promise.future)))] + + [read //.can-read] + [write //.can-write] + [close //.can-close]))))) + +(with-expansions [ (as-is (import: java/lang/AutoCloseable + (close [] #io #try void)) + + (import: java/io/Flushable + (flush [] #io #try void)) + + (import: java/io/InputStream + (read [[byte] int int] #io #try int)) + + (import: java/io/OutputStream + (write [[byte] int int] #io #try void)) + + (import: java/net/Socket + (new [String int] #io #try) + (getInputStream [] #try InputStream) + (getOutputStream [] #try OutputStream)) + + (import: java/net/ServerSocket + (new [int] #io #try) + (accept [] #io #try Socket)) + + (def: (tcp socket) + (-> Socket (Error (TCP IO))) + (do error.monad + [input (Socket::getInputStream socket) + output (Socket::getOutputStream socket)] + (wrap (: (TCP IO) + (structure (def: read + (//.can-read + (function (read size) + (do (error.with io.monad) + [#let [data (binary.create size)] + bytes-read (InputStream::read data +0 (.int size) input)] + (wrap [(.nat bytes-read) + data]))))) + + (def: write + (//.can-write + (function (write data) + (do (error.with io.monad) + [_ (OutputStream::write data +0 (.int (binary.size data)) + output)] + (Flushable::flush output))))) + + (def: close + (//.can-close + (function (close _) + (do (error.with io.monad) + [_ (AutoCloseable::close input) + _ (AutoCloseable::close output)] + (AutoCloseable::close socket)))))))))) + + (def: #export (client address port) + (-> //.Address //.Port (IO (Error (TCP IO)))) + (do (error.with io.monad) + [socket (Socket::new address (.int port))] + (io.io (tcp socket)))) + + (def: #export (server port) + (-> //.Port (IO (Error [(Resolver Any) + (Channel (TCP IO))]))) + (do (error.with io.monad) + [server (ServerSocket::new (.int port)) + #let [[close-signal close-resolver] (: [(Promise Any) (Resolver Any)] + (promise.promise [])) + _ (promise.await (function (_ _) + (AutoCloseable::close server)) + close-signal) + [output sink] (: [(Channel (TCP IO)) (Sink (TCP IO))] + (frp.channel [])) + _ (: (Promise Any) + (promise.future + (loop [_ []] + (do io.monad + [?client (do (error.with io.monad) + [socket (ServerSocket::accept server)] + (io.io (tcp socket)))] + (case ?client + (#error.Failure error) + (wrap []) + + (#error.Success client) + (do @ + [_ (:: sink feed client)] + (recur [])))))))]] + (wrap [close-resolver output]))))] + (`` (for {(~~ (static @.old)) + (as-is ) + + (~~ (static @.jvm)) + (as-is )}))) diff --git a/stdlib/source/lux/world/net/tcp.old.lux b/stdlib/source/lux/world/net/tcp.old.lux deleted file mode 100644 index 85d306799..000000000 --- a/stdlib/source/lux/world/net/tcp.old.lux +++ /dev/null @@ -1,129 +0,0 @@ -(.module: - [lux #* - [host (#+ import:)] - ["@" target] - [abstract - monad] - [control - ["." io (#+ IO)] - [concurrency - ["." promise (#+ Promise Resolver)] - ["." frp (#+ Channel Sink)]] - [security - ["!" capability]]] - [data - ["." error (#+ Error)]] - [world - ["." binary (#+ Binary)]]] - ["." // (#+ Can-Read Can-Write Can-Close)]) - -(signature: #export (TCP !) - (: (Can-Read ! [Nat Binary]) - read) - - (: (Can-Write ! Binary) - write) - - (: (Can-Close !) - close)) - -(def: #export (async tcp) - (-> (TCP IO) (TCP Promise)) - (`` (structure (~~ (template [ ] - [(def: ( (|>> (!.use (:: tcp )) promise.future)))] - - [read //.can-read] - [write //.can-write] - [close //.can-close]))))) - -(with-expansions [ (as-is (import: java/lang/AutoCloseable - (close [] #io #try void)) - - (import: java/io/Flushable - (flush [] #io #try void)) - - (import: java/io/InputStream - (read [(Array byte) int int] #io #try int)) - - (import: java/io/OutputStream - (write [(Array byte) int int] #io #try void)) - - (import: java/net/Socket - (new [String int] #io #try) - (getInputStream [] #try InputStream) - (getOutputStream [] #try OutputStream)) - - (import: java/net/ServerSocket - (new [int] #io #try) - (accept [] #io #try Socket)) - - (def: (tcp socket) - (-> Socket (Error (TCP IO))) - (do error.monad - [input (Socket::getInputStream socket) - output (Socket::getOutputStream socket)] - (wrap (: (TCP IO) - (structure (def: read - (//.can-read - (function (read size) - (do (error.with io.monad) - [#let [data (binary.create size)] - bytes-read (InputStream::read data +0 (.int size) input)] - (wrap [(.nat bytes-read) - data]))))) - - (def: write - (//.can-write - (function (write data) - (do (error.with io.monad) - [_ (OutputStream::write data +0 (.int (binary.size data)) - output)] - (Flushable::flush output))))) - - (def: close - (//.can-close - (function (close _) - (do (error.with io.monad) - [_ (AutoCloseable::close input) - _ (AutoCloseable::close output)] - (AutoCloseable::close socket)))))))))) - - (def: #export (client address port) - (-> //.Address //.Port (IO (Error (TCP IO)))) - (do (error.with io.monad) - [socket (Socket::new address (.int port))] - (io.io (tcp socket)))) - - (def: #export (server port) - (-> //.Port (IO (Error [(Resolver Any) - (Channel (TCP IO))]))) - (do (error.with io.monad) - [server (ServerSocket::new (.int port)) - #let [[close-signal close-resolver] (: [(Promise Any) (Resolver Any)] - (promise.promise [])) - _ (promise.await (function (_ _) - (AutoCloseable::close server)) - close-signal) - [output sink] (: [(Channel (TCP IO)) (Sink (TCP IO))] - (frp.channel [])) - _ (: (Promise Any) - (promise.future - (loop [_ []] - (do io.monad - [?client (do (error.with io.monad) - [socket (ServerSocket::accept server)] - (io.io (tcp socket)))] - (case ?client - (#error.Failure error) - (wrap []) - - (#error.Success client) - (do @ - [_ (:: sink feed client)] - (recur [])))))))]] - (wrap [close-resolver output]))))] - (`` (for {(~~ (static @.old)) - (as-is ) - - (~~ (static @.jvm)) - (as-is )}))) diff --git a/stdlib/source/lux/world/net/udp.lux b/stdlib/source/lux/world/net/udp.lux new file mode 100644 index 000000000..df9244186 --- /dev/null +++ b/stdlib/source/lux/world/net/udp.lux @@ -0,0 +1,124 @@ +(.module: + [lux #* + [host (#+ import:)] + ["@" target] + [abstract + monad] + [control + ["ex" exception (#+ exception:)] + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." error (#+ Error)] + ["." maybe] + [collection + ["." array]]] + [world + ["." binary (#+ Binary)]]] + ["." // (#+ Location Can-Read Can-Write Can-Close)]) + +(exception: #export (cannot-resolve-address {address //.Address}) + (ex.report ["Address" address])) + +(exception: #export (multiple-candidate-addresses {address //.Address}) + (ex.report ["Address" address])) + +(signature: #export (UDP !) + (: (Can-Read ! [Nat Location Binary]) + read) + + (: (Can-Write ! [Location Binary]) + write) + + (: (Can-Close !) + close)) + +(def: #export (async udp) + (-> (UDP IO) (UDP Promise)) + (`` (structure (~~ (template [ ] + [(def: ( (|>> (!.use (:: udp )) promise.future)))] + + [read //.can-read] + [write //.can-write] + [close //.can-close]))))) + +(with-expansions [ (as-is (import: java/lang/AutoCloseable + (close [] #io #try void)) + + (import: java/io/Flushable + (flush [] #io #try void)) + + (import: java/net/InetAddress + (#static getAllByName [String] #io #try [InetAddress]) + (getHostAddress [] String)) + + (import: java/net/DatagramPacket + (new #as new|send [[byte] int int InetAddress int]) + (new #as new|receive [[byte] int int]) + (getAddress [] InetAddress) + (getPort [] int) + (getLength [] int)) + + (import: java/net/DatagramSocket + (new #as new|client [] #io #try) + (new #as new|server [int] #io #try) + (receive [DatagramPacket] #io #try void) + (send [DatagramPacket] #io #try void)) + + (def: (resolve address) + (-> //.Address (IO (Error InetAddress))) + (do (error.with io.monad) + [addresses (InetAddress::getAllByName address)] + (: (IO (Error InetAddress)) + (case (array.size addresses) + 0 (io.io (ex.throw cannot-resolve-address address)) + 1 (wrap (maybe.assume (array.read 0 addresses))) + _ (io.io (ex.throw multiple-candidate-addresses address)))))) + + (def: (udp socket) + (-> DatagramSocket (UDP IO)) + (structure (def: read + (//.can-read + (function (read size) + (let [data (binary.create size) + packet (DatagramPacket::new|receive data +0 (.int size))] + (do (error.with io.monad) + [_ (DatagramSocket::receive packet socket) + #let [bytes-read (.nat (DatagramPacket::getLength packet))]] + (wrap [bytes-read + {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress) + #//.port (.nat (DatagramPacket::getPort packet))} + data])))))) + + (def: write + (//.can-write + (function (write [location data]) + (do (error.with io.monad) + [address (resolve (get@ #//.address location))] + (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location))) + socket))))) + + (def: close + (//.can-close + (function (close _) + (AutoCloseable::close socket)))))) + + (def: #export client + (IO (Error (UDP IO))) + (|> (DatagramSocket::new|client) + (:: (error.with io.monad) map ..udp))) + + (def: #export server + (-> //.Port (IO (Error (UDP IO)))) + (|>> .int + DatagramSocket::new|server + (:: (error.with io.monad) map ..udp))) + )] + (`` (for {(~~ (static @.old)) + (as-is ) + + (~~ (static @.jvm)) + (as-is )}))) diff --git a/stdlib/source/lux/world/net/udp.old.lux b/stdlib/source/lux/world/net/udp.old.lux deleted file mode 100644 index 1f78f4b0d..000000000 --- a/stdlib/source/lux/world/net/udp.old.lux +++ /dev/null @@ -1,124 +0,0 @@ -(.module: - [lux #* - [host (#+ import:)] - ["@" target] - [abstract - monad] - [control - ["ex" exception (#+ exception:)] - ["." io (#+ IO)] - [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] - [data - ["." error (#+ Error)] - ["." maybe] - [collection - ["." array]]] - [world - ["." binary (#+ Binary)]]] - ["." // (#+ Location Can-Read Can-Write Can-Close)]) - -(exception: #export (cannot-resolve-address {address //.Address}) - (ex.report ["Address" address])) - -(exception: #export (multiple-candidate-addresses {address //.Address}) - (ex.report ["Address" address])) - -(signature: #export (UDP !) - (: (Can-Read ! [Nat Location Binary]) - read) - - (: (Can-Write ! [Location Binary]) - write) - - (: (Can-Close !) - close)) - -(def: #export (async udp) - (-> (UDP IO) (UDP Promise)) - (`` (structure (~~ (template [ ] - [(def: ( (|>> (!.use (:: udp )) promise.future)))] - - [read //.can-read] - [write //.can-write] - [close //.can-close]))))) - -(with-expansions [ (as-is (import: java/lang/AutoCloseable - (close [] #io #try void)) - - (import: java/io/Flushable - (flush [] #io #try void)) - - (import: java/net/InetAddress - (#static getAllByName [String] #io #try (Array InetAddress)) - (getHostAddress [] String)) - - (import: java/net/DatagramPacket - (new #as new|send [(Array byte) int int InetAddress int]) - (new #as new|receive [(Array byte) int int]) - (getAddress [] InetAddress) - (getPort [] int) - (getLength [] int)) - - (import: java/net/DatagramSocket - (new #as new|client [] #io #try) - (new #as new|server [int] #io #try) - (receive [DatagramPacket] #io #try void) - (send [DatagramPacket] #io #try void)) - - (def: (resolve address) - (-> //.Address (IO (Error InetAddress))) - (do (error.with io.monad) - [addresses (InetAddress::getAllByName address)] - (: (IO (Error InetAddress)) - (case (array.size addresses) - 0 (io.io (ex.throw cannot-resolve-address address)) - 1 (wrap (maybe.assume (array.read 0 addresses))) - _ (io.io (ex.throw multiple-candidate-addresses address)))))) - - (def: (udp socket) - (-> DatagramSocket (UDP IO)) - (structure (def: read - (//.can-read - (function (read size) - (let [data (binary.create size) - packet (DatagramPacket::new|receive data +0 (.int size))] - (do (error.with io.monad) - [_ (DatagramSocket::receive packet socket) - #let [bytes-read (.nat (DatagramPacket::getLength packet))]] - (wrap [bytes-read - {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress) - #//.port (.nat (DatagramPacket::getPort packet))} - data])))))) - - (def: write - (//.can-write - (function (write [location data]) - (do (error.with io.monad) - [address (resolve (get@ #//.address location))] - (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location))) - socket))))) - - (def: close - (//.can-close - (function (close _) - (AutoCloseable::close socket)))))) - - (def: #export client - (IO (Error (UDP IO))) - (|> (DatagramSocket::new|client) - (:: (error.with io.monad) map ..udp))) - - (def: #export server - (-> //.Port (IO (Error (UDP IO)))) - (|>> .int - DatagramSocket::new|server - (:: (error.with io.monad) map ..udp))) - )] - (`` (for {(~~ (static @.old)) - (as-is ) - - (~~ (static @.jvm)) - (as-is )}))) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index d7fedc6d0..3f0ae519e 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -96,7 +96,7 @@ (new [java/io/InputStream])) (import: #long java/io/OutputStream - (write [(Array byte)] #io #try void)) + (write [[byte]] #io #try void)) (import: #long java/lang/Process (getInputStream [] #io #try java/io/InputStream) @@ -139,7 +139,7 @@ java/lang/Process::destroy))))))))) (import: #long java/lang/ProcessBuilder - (new [(Array java/lang/String)]) + (new [[java/lang/String]]) (environment [] #io #try (java/util/Map java/lang/String java/lang/String)) (start [] #io #try java/lang/Process)) -- cgit v1.2.3