extra/db/sql/sql.factor

   1 USING: kernel parser quotations classes.tuple words math.order
   2 namespaces.lib namespaces sequences arrays combinators
   3 prettyprint strings math.parser sequences.lib math symbols ;
   4 IN: db.sql
   5
   6 SYMBOLS: insert update delete select distinct columns from as
   7 where group-by having order-by limit offset is-null desc all
   8 any count avg table values ;
   9
  10 : input-spec, ( obj -- ) 1, ;
  11 : output-spec, ( obj -- ) 2, ;
  12 : input, ( obj -- ) 3, ;
  13 : output, ( obj -- ) 4, ;
  14
  15 DEFER: sql%
  16
  17 : (sql-interleave) ( seq sep -- )
  18     [ sql% ] curry [ sql% ] interleave ;
  19
  20 : sql-interleave ( seq str sep -- )
  21     swap sql% (sql-interleave) ;
  22
  23 : sql-function, ( seq function -- )
  24     sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ;
  25
  26 : sql-array% ( array -- )
  27     unclip
  28     {
  29         { \ columns [ "," (sql-interleave) ] }
  30         { \ from [ "from" "," sql-interleave ] }
  31         { \ where [ "where" "and" sql-interleave ] }
  32         { \ group-by [ "group by" "," sql-interleave ] }
  33         { \ having [ "having" "," sql-interleave ] }
  34         { \ order-by [ "order by" "," sql-interleave ] }
  35         { \ offset [ "offset" sql% sql% ] }
  36         { \ limit [ "limit" sql% sql% ] }
  37         { \ select [ "(select" sql% sql% ")" sql% ] }
  38         { \ table [ sql% ] }
  39         { \ set [ "set" "," sql-interleave ] }
  40         { \ values [ "values(" sql% "," (sql-interleave) ")" sql% ] }
  41         { \ count [ "count" sql-function, ] }
  42         { \ sum [ "sum" sql-function, ] }
  43         { \ avg [ "avg" sql-function, ] }
  44         { \ min [ "min" sql-function, ] }
  45         { \ max [ "max" sql-function, ] }
  46         [ sql% [ sql% ] each ]
  47     } case ;
  48
  49 ERROR: no-sql-match ;
  50 : sql% ( obj -- )
  51     {
  52         { [ dup string? ] [ " " 0% 0% ] }
  53         { [ dup array? ] [ sql-array% ] }
  54         { [ dup number? ] [ number>string sql% ] }
  55         { [ dup symbol? ] [ unparse sql% ] }
  56         { [ dup word? ] [ unparse sql% ] }
  57         { [ dup quotation? ] [ call ] }
  58         [ no-sql-match ]
  59     } cond ;
  60
  61 : parse-sql ( obj -- sql in-spec out-spec in out )
  62     [
  63         unclip {
  64             { \ create [ "create table" sql% ] }
  65             { \ drop [ "drop table" sql% ] }
  66             { \ insert [ "insert into" sql% ] }
  67             { \ update [ "update" sql% ] }
  68             { \ delete [ "delete" sql% ] }
  69             { \ select [ "select" sql% ] }
  70         } case [ sql% ] each
  71     ] { "" { } { } { } { } } nmake ;