WIP: Added SQL library.

1 files changed, 475 insertions, 0 deletions

diff --git a/stdlib/source/lux/world/database/sql.lux b/stdlib/source/lux/world/database/sql.lux
new file mode 100644
index 000000000..f4704cd94
--- /dev/null
+++ b/stdlib/source/lux/world/database/sql.lux
@@ -0,0 +1,475 @@
+(.module:
+  [lux (#- Source Definition function and or not type is? int)
+   [control
+    [monad (#+ do)]]
+   [data
+    ["." text ("text/." Equivalence<Text>)
+     format]
+    [collection
+     [list ("list/." Functor<List>)]]]
+   [type
+    abstract]])
+
+(def: parenthesize
+  (-> Text Text)
+  (text.enclose ["(" ")"]))
+
+## Kind
+(do-template [<declaration>]
+  [(abstract: #export <declaration> {} 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 [<declaration> <kind>]
+    [(type: #export <declaration> (SQL <kind>))]
+
+    [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 [<name> <sql-op>]
+    [(def: #export (<name> reference sample)
+       (-> Value Value Condition)
+       (:abstraction
+        (..parenthesize
+         (format (:representation sample)
+                 " " <sql-op> " "
+                 (: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 [<func-name> <sql-op>]
+    [(def: #export (<func-name> left right)
+       (-> Condition Condition Condition)
+       (:abstraction
+        (format (..parenthesize (:representation left))
+                " " <sql-op> " "
+                (..parenthesize (:representation right)))))]
+
+    [and "AND"]
+    [or  "OR"]
+    )
+
+  (do-template [<name> <type> <sql>]
+    [(def: #export <name>
+       (-> <type> Condition)
+       (|>> :representation ..parenthesize (format <sql> " ") :abstraction))]
+
+    [not    Condition "NOT"]
+    [exists Any-Query "EXISTS"]
+    )
+
+  ## Query
+  (do-template [<name> <type> <decoration>]
+    [(def: #export <name>
+       (-> <type> Source)
+       (|>> :representation <decoration> :abstraction))]
+
+    [from-table Table     (<|)]
+    [from-view  View      (<|)]
+    [from-query Any-Query ..parenthesize]
+    )
+
+  (do-template [<func-name> <op>]
+    [(def: #export (<func-name> columns source)
+       (-> (List [Column Alias]) Source Base-Query)
+       (:abstraction
+        (format <op>
+                " "
+                (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 [<name> <join-text>]
+    [(def: #export (<name> table condition prev)
+       (-> Table Condition Base-Query Base-Query)
+       (:abstraction
+        (format (:representation prev)
+                " " <join-text> " "
+                (: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 [<function> <sql-op>]
+    [(def: #export (<function> left right)
+       (-> Any-Query Any-Query (Query Without-Where Without-Having No-Order No-Group No-Limit No-Offset))
+       (:abstraction
+        (format (:representation left)
+                " " <sql-op> " "
+                (:representation right))))]
+
+    [union     "UNION"]
+    [union-all "UNION ALL"]
+    [intersect "INTERSECT"]
+    )
+
+  (do-template [<name> <sql> <variables> <input> <output>]
+    [(def: #export (<name> value query)
+       (All <variables>
+         (-> Nat <input> <output>))
+       (:abstraction
+        (format (:representation query)
+                " " <sql> " "
+                (%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 [<name> <sql>]
+    [(def: #export <name>
+       Order
+       (:abstraction <sql>))]
+
+    [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 [<name> <attr>]
+    [(def: #export (<name> attr)
+       (-> (Schema Value) (Schema Value))
+       (:abstraction
+        (format (:representation attr) " " <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 [<name> <sql>]
+    [(def: #export (<name> table)
+       (-> Table Definition)
+       (:abstraction
+        (format <sql> " 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 [<name> <type>]
+    [(def: #export (<name> name)
+       (-> Text <type>)
+       (:abstraction name))]
+
+    [column Column]
+    [table Table]
+    [view View]
+    [index Index]
+    [db DB]
+    )
+
+  (do-template [<name> <type> <sql>]
+    [(def: #export <name>
+       (-> <type> Definition)
+       (|>> :representation (format <sql> " ") :abstraction))]
+
+    [create-db  DB    "CREATE DATABASE"]
+    [drop-db    DB    "DROP DATABASE"]
+    [drop-view  View  "DROP VIEW"]
+    )
+
+  (do-template [<name> <sql>]
+    [(def: #export (<name> view query)
+       (-> View Any-Query Definition)
+       (:abstraction
+        (format <sql> " " (: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))))
+  )