diff --git a/unfinished/sql/sql-tests.factor b/unfinished/sql/sql-tests.factor new file mode 100644 index 0000000000..0b57c2d8fa --- /dev/null +++ b/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 } + } ; diff --git a/unfinished/sql/sql.factor b/unfinished/sql/sql.factor new file mode 100755 index 0000000000..ba0673ae24 --- /dev/null +++ b/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 ;