From 64dc34f43f8e4dcc4ef9fed679b2f05fb51554b2 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 31 Dec 2018 00:17:59 -0400 Subject: Re-named "lux/world/database" to "lux/world/db". --- stdlib/source/lux/world/database/jdbc.jvm.lux | 170 -------- .../source/lux/world/database/jdbc/input.jvm.lux | 109 ----- .../source/lux/world/database/jdbc/output.jvm.lux | 189 -------- stdlib/source/lux/world/database/sql.lux | 475 --------------------- stdlib/source/lux/world/db/jdbc.jvm.lux | 170 ++++++++ stdlib/source/lux/world/db/jdbc/input.jvm.lux | 109 +++++ stdlib/source/lux/world/db/jdbc/output.jvm.lux | 189 ++++++++ stdlib/source/lux/world/db/sql.lux | 475 +++++++++++++++++++++ 8 files changed, 943 insertions(+), 943 deletions(-) delete mode 100644 stdlib/source/lux/world/database/jdbc.jvm.lux delete mode 100644 stdlib/source/lux/world/database/jdbc/input.jvm.lux delete mode 100644 stdlib/source/lux/world/database/jdbc/output.jvm.lux delete mode 100644 stdlib/source/lux/world/database/sql.lux create mode 100644 stdlib/source/lux/world/db/jdbc.jvm.lux create mode 100644 stdlib/source/lux/world/db/jdbc/input.jvm.lux create mode 100644 stdlib/source/lux/world/db/jdbc/output.jvm.lux create mode 100644 stdlib/source/lux/world/db/sql.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/world/database/jdbc.jvm.lux b/stdlib/source/lux/world/database/jdbc.jvm.lux deleted file mode 100644 index 23370dcc8..000000000 --- a/stdlib/source/lux/world/database/jdbc.jvm.lux +++ /dev/null @@ -1,170 +0,0 @@ -(.module: - [lux (#- and int) - [control - [functor (#+ Functor)] - [apply (#+ Apply)] - [monad (#+ Monad do)] - ["ex" exception] - [concurrency - ["." promise (#+ Promise) ("promise/." Monad)]] - [security - [capability (#+ Capability)]]] - [data - ["." product] - ["." error (#+ Error)] - ["." number] - [text - format] - [collection - [list ("list/." Fold)]]] - ["." 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 number.Equivalence) - -(type: #export (Statement input) - {#sql sql.Statement - #input (Input input) - #value input}) - -## DB -(do-template [ ] - [(type: #export ( !) - (All [i] - (Capability (Statement i) (! (Error )))))] - - [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) - [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 [] - [(def: (|>> (:: db ) promise.future))] - - [execute] [insert] [close] [query]))))) - -(def: #export (connect creds) - (-> Credentials (IO (Error (DB IO)))) - (do (error.ErrorT io.Monad) - [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) - [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) - [_ (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) - [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) - [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) - [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 deleted file mode 100644 index d037d4234..000000000 --- a/stdlib/source/lux/world/database/jdbc/input.jvm.lux +++ /dev/null @@ -1,109 +0,0 @@ -(.module: - [lux (#- and int) - [control - [functor (#+ Contravariant)] - [monad (#+ Monad do)]] - [data - ["." error (#+ Error)] - [collection - [list ("list/." Fold)]]] - [time - ["." instant (#+ Instant)]] - ["." io (#+ IO)] - [world - [binary (#+ Binary)]] - [host (#+ import:)]]) - -(import: #long java/lang/String) - -(do-template [] - [(import: #long - (new [long]))] - - [java/sql/Date] [java/sql/Time] [java/sql/Timestamp] - ) - -(`` (import: #long java/sql/PreparedStatement - (~~ (do-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 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))) - -(do-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] - ) - -(do-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/database/jdbc/output.jvm.lux b/stdlib/source/lux/world/database/jdbc/output.jvm.lux deleted file mode 100644 index a28a6254e..000000000 --- a/stdlib/source/lux/world/database/jdbc/output.jvm.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 - (~~ (do-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 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) - - (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) - - (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]))) - -(do-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] - ) - -(do-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/database/sql.lux b/stdlib/source/lux/world/database/sql.lux deleted file mode 100644 index f4704cd94..000000000 --- a/stdlib/source/lux/world/database/sql.lux +++ /dev/null @@ -1,475 +0,0 @@ -(.module: - [lux (#- Source Definition function and or not type is? int) - [control - [monad (#+ do)]] - [data - ["." text ("text/." Equivalence) - format] - [collection - [list ("list/." Functor)]]] - [type - abstract]]) - -(def: parenthesize - (-> Text Text) - (text.enclose ["(" ")"])) - -## Kind -(do-template [] - [(abstract: #export {} Any)] - - [Literal'] - [Column'] - [Placeholder'] - [(Value' kind)] - - [Function'] - - [Condition'] - - [Index'] - - [Table'] - [View'] - [Source'] - [DB'] - - [No-Limit] [With-Limit] - [No-Offset] [With-Offset] - [Order'] - [No-Order] [With-Order] - [No-Group] [With-Group] - [(Query' order group limit offset)] - - [Command'] - - [No-Where] [With-Where] [Without-Where] - [No-Having] [With-Having] [Without-Having] - [(Action' where having kind)] - - [(Schema' kind)] - [Definition'] - [(Statement' kind)] - ) - -(type: #export Alias Text) - -(def: #export no-alias Alias "") - -(abstract: #export (SQL kind) - {} - - Text - - ## SQL - (do-template [ ] - [(type: #export (SQL ))] - - [Literal (Value' Literal')] - [Column (Value' Column')] - [Placeholder (Value' Placeholder')] - [Value (Value' Any)] - - [Function Function'] - [Condition Condition'] - - [Index Index'] - - [Table Table'] - [View View'] - [Source Source'] - [DB DB'] - - [Order Order'] - - [(Schema kind) (Schema' kind)] - - [(Query where having order group limit offset) (Statement' (Action' where having (Query' order group limit offset)))] - [(Command where having) (Statement' (Action' where having Command'))] - [(Action where having kind) (Statement' (Action' where having kind))] - - [Definition (Statement' Definition')] - [Statement (Statement' Any)] - ) - - (def: Base-Query (.type (Query No-Where No-Having No-Order No-Group No-Limit No-Offset))) - (def: Any-Query (.type (Query Any Any Any Any Any Any))) - - (def: #export read - {#.doc (doc "Only use this function for debugging purposes." - "Do not use this function to actually execute SQL code.")} - (-> (SQL Any) Text) - (|>> :representation)) - - (def: #export (sql action) - (-> Statement Text) - (format (:representation action) ";")) - - (def: enumerate - (-> (List (SQL Any)) Text) - (|>> (list/map (|>> :representation)) - (text.join-with ", "))) - - ## Value - (def: #export ? Placeholder (:abstraction "?")) - - (def: literal - (-> Text Literal) - (|>> :abstraction)) - - (def: #export null Literal (..literal "NULL")) - - (def: #export (int value) - (-> Int Literal) - (..literal (if (i/< +0 value) - (%i value) - (%n (.nat value))))) - - (def: #export function - (-> Text Function) - (|>> :abstraction)) - - (def: #export (call function parameters) - (-> Function (List Value) Value) - (:abstraction (format (:representation function) - (..parenthesize (..enumerate parameters))))) - - ## Condition - (do-template [ ] - [(def: #export ( reference sample) - (-> Value Value Condition) - (:abstraction - (..parenthesize - (format (:representation sample) - " " " " - (:representation reference)))))] - - [= "="] - [<> "<>"] - [is? "IS"] - [> ">"] - [>= ">="] - [< "<"] - [<= "<="] - [like? "LIKE"] - [ilike? "ILIKE"] - ) - - (def: #export (between from to sample) - (-> Value Value Value Condition) - (:abstraction - (..parenthesize - (format (:representation sample) - " BETWEEN " (:representation from) - " AND " (:representation to))))) - - (def: #export (in options value) - (-> (List Value) Value Condition) - (:abstraction - (format (:representation value) - " IN " - (..parenthesize (enumerate options))))) - - (do-template [ ] - [(def: #export ( left right) - (-> Condition Condition Condition) - (:abstraction - (format (..parenthesize (:representation left)) - " " " " - (..parenthesize (:representation right)))))] - - [and "AND"] - [or "OR"] - ) - - (do-template [ ] - [(def: #export - (-> Condition) - (|>> :representation ..parenthesize (format " ") :abstraction))] - - [not Condition "NOT"] - [exists Any-Query "EXISTS"] - ) - - ## Query - (do-template [ ] - [(def: #export - (-> Source) - (|>> :representation :abstraction))] - - [from-table Table (<|)] - [from-view View (<|)] - [from-query Any-Query ..parenthesize] - ) - - (do-template [ ] - [(def: #export ( columns source) - (-> (List [Column Alias]) Source Base-Query) - (:abstraction - (format - " " - (case columns - #.Nil - "*" - - _ - (|> columns - (list/map (.function (_ [column alias]) - (if (text/= ..no-alias alias) - (:representation column) - (format (:representation column) " AS " alias)))) - (text.join-with ", "))) - " FROM " (:representation source))))] - - - [select "SELECT"] - [select-distinct "SELECT DISTINCT"] - ) - - (do-template [ ] - [(def: #export ( table condition prev) - (-> Table Condition Base-Query Base-Query) - (:abstraction - (format (:representation prev) - " " " " - (:representation table) - " ON " (:representation condition))))] - - [inner-join "INNER JOIN"] - [left-join "LEFT JOIN"] - [right-join "RIGHT JOIN"] - [full-outer-join "FULL OUTER JOIN"] - ) - - (do-template [ ] - [(def: #export ( left right) - (-> Any-Query Any-Query (Query Without-Where Without-Having No-Order No-Group No-Limit No-Offset)) - (:abstraction - (format (:representation left) - " " " " - (:representation right))))] - - [union "UNION"] - [union-all "UNION ALL"] - [intersect "INTERSECT"] - ) - - (do-template [ ] - [(def: #export ( value query) - (All - (-> Nat )) - (:abstraction - (format (:representation query) - " " " " - (%n value))))] - - [limit "LIMIT" [where having order group offset] - (Query where having order group No-Limit offset) - (Query where having order group With-Limit offset)] - - [offset "OFFSET" [where having order group limit] - (Query where having order group limit No-Offset) - (Query where having order group limit With-Offset)] - ) - - (do-template [ ] - [(def: #export - Order - (:abstraction ))] - - [ascending "ASC"] - [descending "DESC"] - ) - - (def: #export (order-by pairs query) - (All [where having group limit offset] - (-> (List [Value Order]) - (Query where having No-Order group limit offset) - (Query where having With-Order group limit offset))) - (case pairs - #.Nil - (|> query :representation :abstraction) - - _ - (:abstraction - (format (:representation query) - " ORDER BY " - (|> pairs - (list/map (.function (_ [value order]) - (format (:representation value) " " (:representation order)))) - (text.join-with ", ")))))) - - (def: #export (group-by pairs query) - (All [where having order limit offset] - (-> (List Value) - (Query where having order No-Group limit offset) - (Query where having order With-Group limit offset))) - (case pairs - #.Nil - (|> query :representation :abstraction) - - _ - (:abstraction - (format (:representation query) - " GROUP BY " - (..enumerate pairs))))) - - ## Command - (def: #export (insert table columns rows) - (-> Table (List Column) (List (List Value)) (Command Without-Where Without-Having)) - (:abstraction - (format "INSERT INTO " (:representation table) " " - (..parenthesize (..enumerate columns)) - " VALUES " - (|> rows - (list/map (|>> ..enumerate ..parenthesize)) - (text.join-with ", ")) - ))) - - (def: #export (update table pairs) - (-> Table (List [Column Value]) (Command No-Where No-Having)) - (:abstraction (format "UPDATE " (:representation table) - (case pairs - #.Nil - "" - - _ - (format " SET " (|> pairs - (list/map (.function (_ [column value]) - (format (:representation column) "=" (:representation value)))) - (text.join-with ", "))))))) - - (def: #export delete - (-> Table (Command No-Where No-Having)) - (|>> :representation (format "DELETE FROM ") :abstraction)) - - ## Action - (def: #export (where condition prev) - (All [kind having] - (-> Condition (Action No-Where having kind) (Action With-Where having kind))) - (:abstraction - (format (:representation prev) - " WHERE " - (:representation condition)))) - - (def: #export (having condition prev) - (All [where kind] - (-> Condition (Action where No-Having kind) (Action where With-Having kind))) - (:abstraction - (format (:representation prev) - " HAVING " - (:representation condition)))) - - ## Schema - (def: #export type - (-> Text (Schema Value)) - (|>> :abstraction)) - - (do-template [ ] - [(def: #export ( attr) - (-> (Schema Value) (Schema Value)) - (:abstraction - (format (:representation attr) " " )))] - - [unique "UNIQUE"] - [not-null "NOT NULL"] - [stored "STORED"] - ) - - (def: #export (default value attr) - (-> Value (Schema Value) (Schema Value)) - (:abstraction - (format (:representation attr) " DEFAULT " (:representation value)))) - - (def: #export (define-column name type) - (-> Column (Schema Value) (Schema Column)) - (:abstraction - (format (:representation name) " " (:representation type)))) - - (def: #export (auto-increment offset column) - (-> Int (Schema Column) (Schema Column)) - (:abstraction - (format (:representation column) " AUTO_INCREMENT=" (:representation (..int offset))))) - - (def: #export (create-table or-replace? table columns) - (-> Bit Table (List (Schema Column)) Definition) - (let [command (if or-replace? - "CREATE OR REPLACE TABLE" - "CREATE TABLE IF NOT EXISTS")] - (:abstraction - (format command " " (:representation table) - (..parenthesize (..enumerate columns)))))) - - (def: #export (create-table-as table query) - (-> Table Any-Query Definition) - (:abstraction - (format "CREATE TABLE " (:representation table) " AS " (:representation query)))) - - (do-template [ ] - [(def: #export ( table) - (-> Table Definition) - (:abstraction - (format " TABLE " (:representation table))))] - - [drop "DROP"] - [truncate "TRUNCATE"] - ) - - (def: #export (add-column table column) - (-> Table (Schema Column) Definition) - (:abstraction - (format "ALTER TABLE " (:representation table) " ADD " (:representation column)))) - - (def: #export (drop-column table column) - (-> Table Column Definition) - (:abstraction - (format "ALTER TABLE " (:representation table) " DROP COLUMN " (:representation column)))) - - (do-template [ ] - [(def: #export ( name) - (-> Text ) - (:abstraction name))] - - [column Column] - [table Table] - [view View] - [index Index] - [db DB] - ) - - (do-template [ ] - [(def: #export - (-> Definition) - (|>> :representation (format " ") :abstraction))] - - [create-db DB "CREATE DATABASE"] - [drop-db DB "DROP DATABASE"] - [drop-view View "DROP VIEW"] - ) - - (do-template [ ] - [(def: #export ( view query) - (-> View Any-Query Definition) - (:abstraction - (format " " (:representation view) " AS " (:representation query))))] - - [create-view "CREATE VIEW"] - [create-or-replace-view "CREATE OR REPLACE VIEW"] - ) - - (def: #export (create-index index table unique? columns) - (-> Index Table Bit (List Column) Definition) - (:abstraction - (format "CREATE " (if unique? "UNIQUE" "") " INDEX " (:representation index) - " ON " (:representation table) " " (..parenthesize (..enumerate columns))))) - - (def: #export (with alias query body) - (All [where having order group limit offset] - (-> Table Any-Query - (Query where having order group limit offset) - (Query where having order group limit offset))) - (:abstraction - (format "WITH " (:representation alias) - " AS " (..parenthesize (:representation query)) - " " (:representation body)))) - ) diff --git a/stdlib/source/lux/world/db/jdbc.jvm.lux b/stdlib/source/lux/world/db/jdbc.jvm.lux new file mode 100644 index 000000000..2d3721716 --- /dev/null +++ b/stdlib/source/lux/world/db/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)]] + [security + [capability (#+ Capability)]]] + [data + ["." product] + ["." error (#+ Error)] + ["." number] + [text + format] + [collection + [list ("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) + +(def: #export Equivalence number.Equivalence) + +(type: #export (Statement input) + {#sql sql.Statement + #input (Input input) + #value input}) + +## DB +(do-template [ ] + [(type: #export ( !) + (All [i] + (Capability (Statement i) (! (Error )))))] + + [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) + [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 [] + [(def: (|>> (:: db ) promise.future))] + + [execute] [insert] [close] [query]))))) + +(def: #export (connect creds) + (-> Credentials (IO (Error (DB IO)))) + (do (error.ErrorT io.Monad) + [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) + [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) + [_ (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) + [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) + [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) + [db (promise.future (..connect creds)) + result (action (..async db)) + _ (promise/wrap (io.run (:: db close [])))] + (wrap result))) diff --git a/stdlib/source/lux/world/db/jdbc/input.jvm.lux b/stdlib/source/lux/world/db/jdbc/input.jvm.lux new file mode 100644 index 000000000..d037d4234 --- /dev/null +++ b/stdlib/source/lux/world/db/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)]]] + [time + ["." instant (#+ Instant)]] + ["." io (#+ IO)] + [world + [binary (#+ Binary)]] + [host (#+ import:)]]) + +(import: #long java/lang/String) + +(do-template [] + [(import: #long + (new [long]))] + + [java/sql/Date] [java/sql/Time] [java/sql/Timestamp] + ) + +(`` (import: #long java/sql/PreparedStatement + (~~ (do-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 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))) + +(do-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] + ) + +(do-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.jvm.lux b/stdlib/source/lux/world/db/jdbc/output.jvm.lux new file mode 100644 index 000000000..a28a6254e --- /dev/null +++ b/stdlib/source/lux/world/db/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 [ ] + [( [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 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) + + (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) + + (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]))) + +(do-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] + ) + +(do-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/sql.lux b/stdlib/source/lux/world/db/sql.lux new file mode 100644 index 000000000..f4704cd94 --- /dev/null +++ b/stdlib/source/lux/world/db/sql.lux @@ -0,0 +1,475 @@ +(.module: + [lux (#- Source Definition function and or not type is? int) + [control + [monad (#+ do)]] + [data + ["." text ("text/." Equivalence) + format] + [collection + [list ("list/." Functor)]]] + [type + abstract]]) + +(def: parenthesize + (-> Text Text) + (text.enclose ["(" ")"])) + +## Kind +(do-template [] + [(abstract: #export {} Any)] + + [Literal'] + [Column'] + [Placeholder'] + [(Value' kind)] + + [Function'] + + [Condition'] + + [Index'] + + [Table'] + [View'] + [Source'] + [DB'] + + [No-Limit] [With-Limit] + [No-Offset] [With-Offset] + [Order'] + [No-Order] [With-Order] + [No-Group] [With-Group] + [(Query' order group limit offset)] + + [Command'] + + [No-Where] [With-Where] [Without-Where] + [No-Having] [With-Having] [Without-Having] + [(Action' where having kind)] + + [(Schema' kind)] + [Definition'] + [(Statement' kind)] + ) + +(type: #export Alias Text) + +(def: #export no-alias Alias "") + +(abstract: #export (SQL kind) + {} + + Text + + ## SQL + (do-template [ ] + [(type: #export (SQL ))] + + [Literal (Value' Literal')] + [Column (Value' Column')] + [Placeholder (Value' Placeholder')] + [Value (Value' Any)] + + [Function Function'] + [Condition Condition'] + + [Index Index'] + + [Table Table'] + [View View'] + [Source Source'] + [DB DB'] + + [Order Order'] + + [(Schema kind) (Schema' kind)] + + [(Query where having order group limit offset) (Statement' (Action' where having (Query' order group limit offset)))] + [(Command where having) (Statement' (Action' where having Command'))] + [(Action where having kind) (Statement' (Action' where having kind))] + + [Definition (Statement' Definition')] + [Statement (Statement' Any)] + ) + + (def: Base-Query (.type (Query No-Where No-Having No-Order No-Group No-Limit No-Offset))) + (def: Any-Query (.type (Query Any Any Any Any Any Any))) + + (def: #export read + {#.doc (doc "Only use this function for debugging purposes." + "Do not use this function to actually execute SQL code.")} + (-> (SQL Any) Text) + (|>> :representation)) + + (def: #export (sql action) + (-> Statement Text) + (format (:representation action) ";")) + + (def: enumerate + (-> (List (SQL Any)) Text) + (|>> (list/map (|>> :representation)) + (text.join-with ", "))) + + ## Value + (def: #export ? Placeholder (:abstraction "?")) + + (def: literal + (-> Text Literal) + (|>> :abstraction)) + + (def: #export null Literal (..literal "NULL")) + + (def: #export (int value) + (-> Int Literal) + (..literal (if (i/< +0 value) + (%i value) + (%n (.nat value))))) + + (def: #export function + (-> Text Function) + (|>> :abstraction)) + + (def: #export (call function parameters) + (-> Function (List Value) Value) + (:abstraction (format (:representation function) + (..parenthesize (..enumerate parameters))))) + + ## Condition + (do-template [ ] + [(def: #export ( reference sample) + (-> Value Value Condition) + (:abstraction + (..parenthesize + (format (:representation sample) + " " " " + (:representation reference)))))] + + [= "="] + [<> "<>"] + [is? "IS"] + [> ">"] + [>= ">="] + [< "<"] + [<= "<="] + [like? "LIKE"] + [ilike? "ILIKE"] + ) + + (def: #export (between from to sample) + (-> Value Value Value Condition) + (:abstraction + (..parenthesize + (format (:representation sample) + " BETWEEN " (:representation from) + " AND " (:representation to))))) + + (def: #export (in options value) + (-> (List Value) Value Condition) + (:abstraction + (format (:representation value) + " IN " + (..parenthesize (enumerate options))))) + + (do-template [ ] + [(def: #export ( left right) + (-> Condition Condition Condition) + (:abstraction + (format (..parenthesize (:representation left)) + " " " " + (..parenthesize (:representation right)))))] + + [and "AND"] + [or "OR"] + ) + + (do-template [ ] + [(def: #export + (-> Condition) + (|>> :representation ..parenthesize (format " ") :abstraction))] + + [not Condition "NOT"] + [exists Any-Query "EXISTS"] + ) + + ## Query + (do-template [ ] + [(def: #export + (-> Source) + (|>> :representation :abstraction))] + + [from-table Table (<|)] + [from-view View (<|)] + [from-query Any-Query ..parenthesize] + ) + + (do-template [ ] + [(def: #export ( columns source) + (-> (List [Column Alias]) Source Base-Query) + (:abstraction + (format + " " + (case columns + #.Nil + "*" + + _ + (|> columns + (list/map (.function (_ [column alias]) + (if (text/= ..no-alias alias) + (:representation column) + (format (:representation column) " AS " alias)))) + (text.join-with ", "))) + " FROM " (:representation source))))] + + + [select "SELECT"] + [select-distinct "SELECT DISTINCT"] + ) + + (do-template [ ] + [(def: #export ( table condition prev) + (-> Table Condition Base-Query Base-Query) + (:abstraction + (format (:representation prev) + " " " " + (:representation table) + " ON " (:representation condition))))] + + [inner-join "INNER JOIN"] + [left-join "LEFT JOIN"] + [right-join "RIGHT JOIN"] + [full-outer-join "FULL OUTER JOIN"] + ) + + (do-template [ ] + [(def: #export ( left right) + (-> Any-Query Any-Query (Query Without-Where Without-Having No-Order No-Group No-Limit No-Offset)) + (:abstraction + (format (:representation left) + " " " " + (:representation right))))] + + [union "UNION"] + [union-all "UNION ALL"] + [intersect "INTERSECT"] + ) + + (do-template [ ] + [(def: #export ( value query) + (All + (-> Nat )) + (:abstraction + (format (:representation query) + " " " " + (%n value))))] + + [limit "LIMIT" [where having order group offset] + (Query where having order group No-Limit offset) + (Query where having order group With-Limit offset)] + + [offset "OFFSET" [where having order group limit] + (Query where having order group limit No-Offset) + (Query where having order group limit With-Offset)] + ) + + (do-template [ ] + [(def: #export + Order + (:abstraction ))] + + [ascending "ASC"] + [descending "DESC"] + ) + + (def: #export (order-by pairs query) + (All [where having group limit offset] + (-> (List [Value Order]) + (Query where having No-Order group limit offset) + (Query where having With-Order group limit offset))) + (case pairs + #.Nil + (|> query :representation :abstraction) + + _ + (:abstraction + (format (:representation query) + " ORDER BY " + (|> pairs + (list/map (.function (_ [value order]) + (format (:representation value) " " (:representation order)))) + (text.join-with ", ")))))) + + (def: #export (group-by pairs query) + (All [where having order limit offset] + (-> (List Value) + (Query where having order No-Group limit offset) + (Query where having order With-Group limit offset))) + (case pairs + #.Nil + (|> query :representation :abstraction) + + _ + (:abstraction + (format (:representation query) + " GROUP BY " + (..enumerate pairs))))) + + ## Command + (def: #export (insert table columns rows) + (-> Table (List Column) (List (List Value)) (Command Without-Where Without-Having)) + (:abstraction + (format "INSERT INTO " (:representation table) " " + (..parenthesize (..enumerate columns)) + " VALUES " + (|> rows + (list/map (|>> ..enumerate ..parenthesize)) + (text.join-with ", ")) + ))) + + (def: #export (update table pairs) + (-> Table (List [Column Value]) (Command No-Where No-Having)) + (:abstraction (format "UPDATE " (:representation table) + (case pairs + #.Nil + "" + + _ + (format " SET " (|> pairs + (list/map (.function (_ [column value]) + (format (:representation column) "=" (:representation value)))) + (text.join-with ", "))))))) + + (def: #export delete + (-> Table (Command No-Where No-Having)) + (|>> :representation (format "DELETE FROM ") :abstraction)) + + ## Action + (def: #export (where condition prev) + (All [kind having] + (-> Condition (Action No-Where having kind) (Action With-Where having kind))) + (:abstraction + (format (:representation prev) + " WHERE " + (:representation condition)))) + + (def: #export (having condition prev) + (All [where kind] + (-> Condition (Action where No-Having kind) (Action where With-Having kind))) + (:abstraction + (format (:representation prev) + " HAVING " + (:representation condition)))) + + ## Schema + (def: #export type + (-> Text (Schema Value)) + (|>> :abstraction)) + + (do-template [ ] + [(def: #export ( attr) + (-> (Schema Value) (Schema Value)) + (:abstraction + (format (:representation attr) " " )))] + + [unique "UNIQUE"] + [not-null "NOT NULL"] + [stored "STORED"] + ) + + (def: #export (default value attr) + (-> Value (Schema Value) (Schema Value)) + (:abstraction + (format (:representation attr) " DEFAULT " (:representation value)))) + + (def: #export (define-column name type) + (-> Column (Schema Value) (Schema Column)) + (:abstraction + (format (:representation name) " " (:representation type)))) + + (def: #export (auto-increment offset column) + (-> Int (Schema Column) (Schema Column)) + (:abstraction + (format (:representation column) " AUTO_INCREMENT=" (:representation (..int offset))))) + + (def: #export (create-table or-replace? table columns) + (-> Bit Table (List (Schema Column)) Definition) + (let [command (if or-replace? + "CREATE OR REPLACE TABLE" + "CREATE TABLE IF NOT EXISTS")] + (:abstraction + (format command " " (:representation table) + (..parenthesize (..enumerate columns)))))) + + (def: #export (create-table-as table query) + (-> Table Any-Query Definition) + (:abstraction + (format "CREATE TABLE " (:representation table) " AS " (:representation query)))) + + (do-template [ ] + [(def: #export ( table) + (-> Table Definition) + (:abstraction + (format " TABLE " (:representation table))))] + + [drop "DROP"] + [truncate "TRUNCATE"] + ) + + (def: #export (add-column table column) + (-> Table (Schema Column) Definition) + (:abstraction + (format "ALTER TABLE " (:representation table) " ADD " (:representation column)))) + + (def: #export (drop-column table column) + (-> Table Column Definition) + (:abstraction + (format "ALTER TABLE " (:representation table) " DROP COLUMN " (:representation column)))) + + (do-template [ ] + [(def: #export ( name) + (-> Text ) + (:abstraction name))] + + [column Column] + [table Table] + [view View] + [index Index] + [db DB] + ) + + (do-template [ ] + [(def: #export + (-> Definition) + (|>> :representation (format " ") :abstraction))] + + [create-db DB "CREATE DATABASE"] + [drop-db DB "DROP DATABASE"] + [drop-view View "DROP VIEW"] + ) + + (do-template [ ] + [(def: #export ( view query) + (-> View Any-Query Definition) + (:abstraction + (format " " (:representation view) " AS " (:representation query))))] + + [create-view "CREATE VIEW"] + [create-or-replace-view "CREATE OR REPLACE VIEW"] + ) + + (def: #export (create-index index table unique? columns) + (-> Index Table Bit (List Column) Definition) + (:abstraction + (format "CREATE " (if unique? "UNIQUE" "") " INDEX " (:representation index) + " ON " (:representation table) " " (..parenthesize (..enumerate columns))))) + + (def: #export (with alias query body) + (All [where having order group limit offset] + (-> Table Any-Query + (Query where having order group limit offset) + (Query where having order group limit offset))) + (:abstraction + (format "WITH " (:representation alias) + " AS " (..parenthesize (:representation query)) + " " (:representation body)))) + ) -- cgit v1.2.3