unfinished/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 db ;
   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     [
  28         [ second 0, ]
  29         [ first 0, ]
  30         [ third 1, \ ? 0, ] tri
  31     ] each ;
  32
  33 HOOK: sql-create db ( object -- )
  34 M: db sql-create ( object -- )
  35     drop
  36     "create table" sql% ;
  37
  38 HOOK: sql-drop db ( object -- )
  39 M: db sql-drop ( object -- )
  40     drop
  41     "drop table" sql% ;
  42
  43 HOOK: sql-insert db ( object -- )
  44 M: db sql-insert ( object -- )
  45     drop
  46     "insert into" sql% ;
  47
  48 HOOK: sql-update db ( object -- )
  49 M: db sql-update ( object -- )
  50     drop
  51     "update" sql% ;
  52
  53 HOOK: sql-delete db ( object -- )
  54 M: db sql-delete ( object -- )
  55     drop
  56     "delete" sql% ;
  57
  58 HOOK: sql-select db ( object -- )
  59 M: db sql-select ( object -- )
  60     "select" sql% "," (sql-interleave) ;
  61
  62 HOOK: sql-columns db ( object -- )
  63 M: db sql-columns ( object -- )
  64     "," (sql-interleave) ;
  65
  66 HOOK: sql-from db ( object -- )
  67 M: db sql-from ( object -- )
  68     "from" "," sql-interleave ;
  69
  70 HOOK: sql-where db ( object -- )
  71 M: db sql-where ( object -- )
  72     "where" 0, sql-where, ;
  73
  74 HOOK: sql-group-by db ( object -- )
  75 M: db sql-group-by ( object -- )
  76     "group by" "," sql-interleave ;
  77
  78 HOOK: sql-having db ( object -- )
  79 M: db sql-having ( object -- )
  80     "having" "," sql-interleave ;
  81
  82 HOOK: sql-order-by db ( object -- )
  83 M: db sql-order-by ( object -- )
  84     "order by" "," sql-interleave ;
  85
  86 HOOK: sql-offset db ( object -- )
  87 M: db sql-offset ( object -- )
  88     "offset" sql% sql% ;
  89
  90 HOOK: sql-limit db ( object -- )
  91 M: db sql-limit ( object -- )
  92     "limit" sql% sql% ;
  93
  94 ! GENERIC: sql-subselect db ( object -- )
  95 ! M: db sql-subselectselect ( object -- )
  96     ! "(select" sql% sql% ")" sql% ;
  97
  98 HOOK: sql-table db ( object -- )
  99 M: db sql-table ( object -- )
 100     sql% ;
 101
 102 HOOK: sql-set db ( object -- )
 103 M: db sql-set ( object -- )
 104     "set" "," sql-interleave ;
 105
 106 HOOK: sql-values db ( object -- )
 107 M: db sql-values ( object -- )
 108     "values(" sql% "," (sql-interleave) ")" sql% ;
 109
 110 HOOK: sql-count db ( object -- )
 111 M: db sql-count ( object -- )
 112     "count" sql-function, ;
 113
 114 HOOK: sql-sum db ( object -- )
 115 M: db sql-sum ( object -- )
 116     "sum" sql-function, ;
 117
 118 HOOK: sql-avg db ( object -- )
 119 M: db sql-avg ( object -- )
 120     "avg" sql-function, ;
 121
 122 HOOK: sql-min db ( object -- )
 123 M: db sql-min ( object -- )
 124     "min" sql-function, ;
 125
 126 HOOK: sql-max db ( object -- )
 127 M: db sql-max ( object -- )
 128     "max" sql-function, ;
 129
 130 : sql-array% ( array -- )
 131     unclip
 132     {
 133         { \ create [ sql-create ] }
 134         { \ drop [ sql-drop ] }
 135         { \ insert [ sql-insert ] }
 136         { \ update [ sql-update ] }
 137         { \ delete [ sql-delete ] }
 138         { \ select [ sql-select ] }
 139         { \ columns [ sql-columns ] }
 140         { \ from [ sql-from ] }
 141         { \ where [ sql-where ] }
 142         { \ group-by [ sql-group-by ] }
 143         { \ having [ sql-having ] }
 144         { \ order-by [ sql-order-by ] }
 145         { \ offset [ sql-offset ] }
 146         { \ limit [ sql-limit ] }
 147         { \ table [ sql-table ] }
 148         { \ set [ sql-set ] }
 149         { \ values [ sql-values ] }
 150         { \ count [ sql-count ] }
 151         { \ sum [ sql-sum ] }
 152         { \ avg [ sql-avg ] }
 153         { \ min [ sql-min ] }
 154         { \ max [ sql-max ] }
 155         [ sql% [ sql% ] each ]
 156     } case ;
 157
 158 ERROR: no-sql-match ;
 159 : sql% ( obj -- )
 160     {
 161         { [ dup string? ] [ 0, ] }
 162         { [ dup array? ] [ sql-array% ] }
 163         { [ dup number? ] [ number>string sql% ] }
 164         { [ dup symbol? ] [ unparse sql% ] }
 165         { [ dup word? ] [ unparse sql% ] }
 166         { [ dup quotation? ] [ call ] }
 167         [ no-sql-match ]
 168     } cond ;
 169
 170 : parse-sql ( obj -- sql in-spec out-spec in out )
 171     [ [ sql% ] each ] { { } { } { } } nmake
 172     [ " " join ] 2dip ;