factor/unfinished/sql/sql.factor

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 ;