basis/db/sql/sql.factor

   1 USING: kernel parser quotations classes.tuple words math.order
   2 nmake namespaces sequences arrays combinators
   3 prettyprint strings math.parser 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-where ( seq -- )
  27 B
  28     [
  29         [ second 0, ]
  30         [ first 0, ]
  31         [ third 1, \ ? 0, ] tri
  32     ] each ;
  33
  34 : sql-array% ( array -- )
  35 B
  36     unclip
  37     {
  38         { \ create [ "create table" sql% ] }
  39         { \ drop [ "drop table" sql% ] }
  40         { \ insert [ "insert into" sql% ] }
  41         { \ update [ "update" sql% ] }
  42         { \ delete [ "delete" sql% ] }
  43         { \ select [ B "select" sql% "," (sql-interleave) ] }
  44         { \ columns [ "," (sql-interleave) ] }
  45         { \ from [ "from" "," sql-interleave ] }
  46         { \ where [ B "where" 0, sql-where ] }
  47         { \ group-by [ "group by" "," sql-interleave ] }
  48         { \ having [ "having" "," sql-interleave ] }
  49         { \ order-by [ "order by" "," sql-interleave ] }
  50         { \ offset [ "offset" sql% sql% ] }
  51         { \ limit [ "limit" sql% sql% ] }
  52         { \ select [ "(select" sql% sql% ")" sql% ] }
  53         { \ table [ sql% ] }
  54         { \ set [ "set" "," sql-interleave ] }
  55         { \ values [ "values(" sql% "," (sql-interleave) ")" sql% ] }
  56         { \ count [ "count" sql-function, ] }
  57         { \ sum [ "sum" sql-function, ] }
  58         { \ avg [ "avg" sql-function, ] }
  59         { \ min [ "min" sql-function, ] }
  60         { \ max [ "max" sql-function, ] }
  61         [ sql% [ sql% ] each ]
  62     } case ;
  63
  64 ERROR: no-sql-match ;
  65 : sql% ( obj -- )
  66     {
  67         { [ dup string? ] [ 0, ] }
  68         { [ dup array? ] [ sql-array% ] }
  69         { [ dup number? ] [ number>string sql% ] }
  70         { [ dup symbol? ] [ unparse sql% ] }
  71         { [ dup word? ] [ unparse sql% ] }
  72         { [ dup quotation? ] [ call ] }
  73         [ no-sql-match ]
  74     } cond ;
  75
  76 : parse-sql ( obj -- sql in-spec out-spec in out )
  77     [ [ sql% ] each ] { { } { } { } } nmake ;