diff options
| -rw-r--r-- | stdlib/source/lux/world/database/jdbc.jvm.lux | 170 | ||||
| -rw-r--r-- | stdlib/source/lux/world/database/jdbc/input.jvm.lux | 109 | ||||
| -rw-r--r-- | stdlib/source/lux/world/database/jdbc/output.jvm.lux | 189 |
3 files changed, 468 insertions, 0 deletions
diff --git a/stdlib/source/lux/world/database/jdbc.jvm.lux b/stdlib/source/lux/world/database/jdbc.jvm.lux new file mode 100644 index 000000000..23370dcc8 --- /dev/null +++ b/stdlib/source/lux/world/database/jdbc.jvm.lux @@ -0,0 +1,170 @@ +(.module: + [lux (#- and int) + [control + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)] + ["ex" exception] + [concurrency + ["." promise (#+ Promise) ("promise/." Monad<Promise>)]] + [security + [capability (#+ Capability)]]] + [data + ["." product] + ["." error (#+ Error)] + ["." number] + [text + format] + [collection + [list ("list/." Fold<List>)]]] + ["." io (#+ IO)] + [world + [net (#+ URL)] + [database + ["." sql]]] + [host (#+ import:)]] + [/ + ["/." 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) + +(def: #export Equivalence<ID> number.Equivalence<Int>) + +(type: #export (Statement input) + {#sql sql.Statement + #input (Input input) + #value input}) + +## DB +(do-template [<name> <output>] + [(type: #export (<name> !) + (All [i] + (Capability (Statement i) (! (Error <output>)))))] + + [Can-Execute Nat] + [Can-Insert (List ID)] + ) + +(type: #export (Can-Query !) + (All [i o] + (Capability [(Statement i) (Output o)] (! (Error (List o)))))) + +(type: #export (Can-Close !) + (Capability 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.ErrorT io.Monad<IO>) + [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 + (~~ (do-template [<name>] + [(def: <name> (|>> (:: db <name>) promise.future))] + + [execute] [insert] [close] [query]))))) + +(def: #export (connect creds) + (-> Credentials (IO (Error (DB IO)))) + (do (error.ErrorT io.Monad<IO>) + [connection (java/sql/DriverManager::getConnection (get@ #url creds) + (get@ #user creds) + (get@ #password creds))] + (wrap (: (DB IO) + (structure + (def: (execute statement) + (with-statement statement connection + (function (_ prepared) + (do (error.ErrorT io.Monad<IO>) + [row-count (java/sql/PreparedStatement::executeUpdate prepared)] + (wrap (.nat row-count)))))) + + (def: (insert statement) + (with-statement statement connection + (function (_ prepared) + (do (error.ErrorT io.Monad<IO>) + [_ (java/sql/PreparedStatement::executeUpdate prepared) + result-set (io.io (java/sql/Statement::getGeneratedKeys prepared))] + (/output.rows /output.long result-set))))) + + (def: (close _) + (java/sql/Connection::close connection)) + + (def: (query [statement output]) + (with-statement statement connection + (function (_ prepared) + (do (error.ErrorT io.Monad<IO>) + [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.ErrorT io.Monad<IO>) + [db (..connect creds) + result (action db) + _ (:: db close [])] + (wrap result))) + +(def: #export (with-async-db creds action) + (All [a] + (-> Credentials + (-> (DB Promise) (Promise (Error a))) + (Promise (Error a)))) + (do (error.ErrorT promise.Monad<Promise>) + [db (promise.future (..connect creds)) + result (action (..async db)) + _ (promise/wrap (io.run (:: db close [])))] + (wrap result))) diff --git a/stdlib/source/lux/world/database/jdbc/input.jvm.lux b/stdlib/source/lux/world/database/jdbc/input.jvm.lux new file mode 100644 index 000000000..d037d4234 --- /dev/null +++ b/stdlib/source/lux/world/database/jdbc/input.jvm.lux @@ -0,0 +1,109 @@ +(.module: + [lux (#- and int) + [control + [functor (#+ Contravariant)] + [monad (#+ Monad do)]] + [data + ["." error (#+ Error)] + [collection + [list ("list/." Fold<List>)]]] + [time + ["." instant (#+ Instant)]] + ["." io (#+ IO)] + [world + [binary (#+ Binary)]] + [host (#+ import:)]]) + +(import: #long java/lang/String) + +(do-template [<class>] + [(import: #long <class> + (new [long]))] + + [java/sql/Date] [java/sql/Time] [java/sql/Timestamp] + ) + +(`` (import: #long java/sql/PreparedStatement + (~~ (do-template [<name> <type>] + [(<name> [int <type>] #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 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<Error> + [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))) + +(do-template [<function> <type> <setter>] + [(def: #export <function> + (Input <type>) + (function (_ value [idx statement]) + (do error.Monad<Error> + [_ (<setter> (.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] + ) + +(do-template [<function> <setter> <constructor>] + [(def: #export <function> + (Input Instant) + (function (_ value [idx statement]) + (do error.Monad<Error> + [_ (<setter> (.int idx) + (<constructor> (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/database/jdbc/output.jvm.lux b/stdlib/source/lux/world/database/jdbc/output.jvm.lux new file mode 100644 index 000000000..a28a6254e --- /dev/null +++ b/stdlib/source/lux/world/database/jdbc/output.jvm.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 + (~~ (do-template [<method-name> <return-class>] + [(<method-name> [int] #try <return-class>)] + + [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 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 Output) + (def: functor Functor<Output>) + + (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 Output) + (def: functor Functor<Output>) + + (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<Output> + [=left left + =right right] + (wrap [=left =right]))) + +(do-template [<func-name> <method-name> <type>] + [(def: #export <func-name> + (Output <type>) + (function (_ [idx result-set]) + (case (<method-name> [(.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] + ) + +(do-template [<func-name> <method-name>] + [(def: #export <func-name> + (Output Instant) + (function (_ [idx result-set]) + (case (<method-name> [(.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<IO> + [?tail (rows output results)] + (case ?tail + (#error.Success tail) + (wrap (ex.return (#.Cons head tail))) + + (#error.Failure error) + (do io.Monad<IO> + [temp (java/sql/ResultSet::close results)] + (wrap (do error.Monad<Error> + [_ temp] + (error.fail error)))))) + + (#error.Failure error) + (do io.Monad<IO> + [temp (java/sql/ResultSet::close results)] + (wrap (do error.Monad<Error> + [_ temp] + (error.fail error))))) + (do io.Monad<IO> + [temp (java/sql/ResultSet::close results)] + (wrap (do error.Monad<Error> + [_ temp] + (wrap (list)))))) + + (#error.Failure error) + (do io.Monad<IO> + [temp (java/sql/ResultSet::close results)] + (wrap (do error.Monad<Error> + [_ temp] + (error.fail error)))) + )) |