add db.sql

diff --git a/extra/db/sql/sql-tests.factor b/extra/db/sql/sql-tests.factor
new file mode 100644 (file)
index 0000000..2133b0e
--- /dev/null
+++ b/extra/db/sql/sql-tests.factor
@@ -0,0 +1,42 @@
+USING: kernel db.sql ;
+IN: db.sql.tests
+
+TUPLE: person name age ;
+: insert-1
+    { insert
+        { table "person" }
+        { columns "name" "age" }
+        { values "erg" 26 }
+    } ;
+
+: update-1
+    { update "person"
+       { set { "name" "erg" }
+             { "age" 6 } }
+       { where { "age" 6 } }
+    } ;
+
+: select-1
+    { select
+        { columns
+                "branchno"
+                { count "staffno" as "mycount" }
+                { sum "salary" as "mysum" } }
+        { from "staff" "lol" }
+        { where
+                { "salary" > all
+                    { select
+                        { columns "salary" }
+                        { from "staff" }
+                        { where { "branchno" "b003" } }
+                    }
+                }
+                { "branchno" > 3 } }
+        { group-by "branchno" "lol2" }
+        { having { count "staffno" > 1 } }
+        { order-by "branchno" }
+        { offset 40 }
+        { limit 20 }
+    } ;
+
+

diff --git a/extra/db/sql/sql.factor b/extra/db/sql/sql.factor
new file mode 100755 (executable)
index 0000000..062eab8
--- /dev/null
+++ b/extra/db/sql/sql.factor
@@ -0,0 +1,70 @@
+USING: kernel parser quotations tuples words
+namespaces.lib namespaces sequences bake arrays combinators
+prettyprint strings math.parser new-slots accessors
+sequences.lib math symbols ;
+USE: tools.walker
+IN: db.sql
+
+SYMBOLS: insert update delete select distinct columns from as
+where group-by having order-by limit offset is-null desc all
+any count avg table values ;
+
+: input-spec, 1, ;
+: output-spec, 2, ;
+: input, 3, ;
+: output, 4, ;
+
+DEFER: sql%
+
+: (sql-interleave) ( seq sep -- )
+    [ sql% ] curry [ sql% ] interleave ;
+
+: sql-interleave ( seq str sep -- )
+    swap sql% (sql-interleave) ;
+
+: sql-function, ( seq function -- )
+    sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ;
+
+: sql-array% ( array -- )
+    unclip
+    {
+        { columns [ "," (sql-interleave) ] }
+        { from [ "from" "," sql-interleave ] }
+        { where [ "where" "and" sql-interleave ] }
+        { group-by [ "group by" "," sql-interleave ] }
+        { having [ "having" "," sql-interleave ] }
+        { order-by [ "order by" "," sql-interleave ] }
+        { offset [ "offset" sql% sql% ] }
+        { limit [ "limit" sql% sql% ] }
+        { select [ "(select" sql% sql% ")" sql% ] }
+        { table [ sql% ] }
+        { set [ "set" "," sql-interleave ] }
+        { values [ "values(" sql% "," (sql-interleave) ")" sql% ] }
+        { count [ "count" sql-function, ] }
+        { sum [ "sum" sql-function, ] }
+        { avg [ "avg" sql-function, ] }
+        { min [ "min" sql-function, ] }
+        { max [ "max" sql-function, ] }
+        [ sql% [ sql% ] each ]
+    } case ;
+
+TUPLE: no-sql-match ;
+: sql% ( obj -- )
+    {
+        { [ dup string? ] [ " " 0% 0% ] }
+        { [ dup array? ] [ sql-array% ] }
+        { [ dup number? ] [ number>string sql% ] }
+        { [ dup symbol? ] [ unparse sql% ] }
+        { [ dup word? ] [ unparse sql% ] }
+        { [ t ] [ T{ no-sql-match } throw ] }
+    } cond ;
+
+: parse-sql ( obj -- sql in-spec out-spec in out )
+    [
+        unclip {
+            { insert [ "insert into" sql% ] }
+            { update [ "update" sql% ] }
+            { delete [ "delete" sql% ] }
+            { select [ "select" sql% ] }
+        } case [ sql% ] each
+    ] { "" { } { } { } { } } nmake ;