aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/world/database/jdbc.jvm.lux170
-rw-r--r--stdlib/source/lux/world/database/jdbc/input.jvm.lux109
-rw-r--r--stdlib/source/lux/world/database/jdbc/output.jvm.lux189
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))))
+ ))