moved sql to unfinished

unfinished/sql/sql-tests.factor

@@ -0,0 +1,42 @@
+USING: kernel namespaces db.sql sequences math ;
+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 }
+    } ;

unfinished/sql/sql.factor

@@ -0,0 +1,172 @@
+USING: kernel parser quotations classes.tuple words math.order
+nmake namespaces sequences arrays combinators
+prettyprint strings math.parser math symbols db ;
+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, ( obj -- ) 1, ;
+: output-spec, ( obj -- ) 2, ;
+: input, ( obj -- ) 3, ;
+: output, ( obj -- ) 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-where, ( seq -- )
+    [
+        [ second 0, ]
+        [ first 0, ]
+        [ third 1, \ ? 0, ] tri
+    ] each ;
+
+HOOK: sql-create db ( object -- )
+M: db sql-create ( object -- )
+    drop
+    "create table" sql% ;
+
+HOOK: sql-drop db ( object -- )
+M: db sql-drop ( object -- )
+    drop
+    "drop table" sql% ;
+
+HOOK: sql-insert db ( object -- )
+M: db sql-insert ( object -- )
+    drop
+    "insert into" sql% ;
+
+HOOK: sql-update db ( object -- )
+M: db sql-update ( object -- )
+    drop
+    "update" sql% ;
+
+HOOK: sql-delete db ( object -- )
+M: db sql-delete ( object -- )
+    drop
+    "delete" sql% ;
+
+HOOK: sql-select db ( object -- )
+M: db sql-select ( object -- )
+    "select" sql% "," (sql-interleave) ;
+
+HOOK: sql-columns db ( object -- )
+M: db sql-columns ( object -- )
+    "," (sql-interleave) ;
+
+HOOK: sql-from db ( object -- )
+M: db sql-from ( object -- )
+    "from" "," sql-interleave ;
+
+HOOK: sql-where db ( object -- )
+M: db sql-where ( object -- )
+    "where" 0, sql-where, ;
+
+HOOK: sql-group-by db ( object -- )
+M: db sql-group-by ( object -- )
+    "group by" "," sql-interleave ;
+
+HOOK: sql-having db ( object -- )
+M: db sql-having ( object -- )
+    "having" "," sql-interleave ;
+
+HOOK: sql-order-by db ( object -- )
+M: db sql-order-by ( object -- )
+    "order by" "," sql-interleave ;
+
+HOOK: sql-offset db ( object -- )
+M: db sql-offset ( object -- )
+    "offset" sql% sql% ;
+
+HOOK: sql-limit db ( object -- )
+M: db sql-limit ( object -- )
+    "limit" sql% sql% ;
+
+! GENERIC: sql-subselect db ( object -- )
+! M: db sql-subselectselect ( object -- )
+    ! "(select" sql% sql% ")" sql% ;
+
+HOOK: sql-table db ( object -- )
+M: db sql-table ( object -- )
+    sql% ;
+
+HOOK: sql-set db ( object -- )
+M: db sql-set ( object -- )
+    "set" "," sql-interleave ;
+
+HOOK: sql-values db ( object -- )
+M: db sql-values ( object -- )
+    "values(" sql% "," (sql-interleave) ")" sql% ;
+
+HOOK: sql-count db ( object -- )
+M: db sql-count ( object -- )
+    "count" sql-function, ;
+
+HOOK: sql-sum db ( object -- )
+M: db sql-sum ( object -- )
+    "sum" sql-function, ;
+
+HOOK: sql-avg db ( object -- )
+M: db sql-avg ( object -- )
+    "avg" sql-function, ;
+
+HOOK: sql-min db ( object -- )
+M: db sql-min ( object -- )
+    "min" sql-function, ;
+
+HOOK: sql-max db ( object -- )
+M: db sql-max ( object -- )
+    "max" sql-function, ;
+
+: sql-array% ( array -- )
+    unclip
+    {
+        { \ create [ sql-create ] }
+        { \ drop [ sql-drop ] }
+        { \ insert [ sql-insert ] }
+        { \ update [ sql-update ] }
+        { \ delete [ sql-delete ] }
+        { \ select [ sql-select ] }
+        { \ columns [ sql-columns ] }
+        { \ from [ sql-from ] }
+        { \ where [ sql-where ] }
+        { \ group-by [ sql-group-by ] }
+        { \ having [ sql-having ] }
+        { \ order-by [ sql-order-by ] }
+        { \ offset [ sql-offset ] }
+        { \ limit [ sql-limit ] }
+        { \ table [ sql-table ] }
+        { \ set [ sql-set ] }
+        { \ values [ sql-values ] }
+        { \ count [ sql-count ] }
+        { \ sum [ sql-sum ] }
+        { \ avg [ sql-avg ] }
+        { \ min [ sql-min ] }
+        { \ max [ sql-max ] }
+        [ sql% [ sql% ] each ]
+    } case ;
+
+ERROR: no-sql-match ;
+: sql% ( obj -- )
+    {
+        { [ dup string? ] [ 0, ] }
+        { [ dup array? ] [ sql-array% ] }
+        { [ dup number? ] [ number>string sql% ] }
+        { [ dup symbol? ] [ unparse sql% ] }
+        { [ dup word? ] [ unparse sql% ] }
+        { [ dup quotation? ] [ call ] }
+        [ no-sql-match ]
+    } cond ;
+
+: parse-sql ( obj -- sql in-spec out-spec in out )
+    [ [ sql% ] each ] { { } { } { } } nmake
+    [ " " join ] 2dip ;