basis/db/sqlite/sqlite.factor

   1 ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien arrays assocs classes compiler db
   4 hashtables io.files kernel math math.parser namespaces
   5 prettyprint sequences strings classes.tuple alien.c-types
   6 continuations db.sqlite.lib db.sqlite.ffi db.tuples
   7 words combinators.lib db.types combinators math.intervals
   8 io namespaces.lib accessors vectors math.ranges random
   9 math.bitfields.lib db.queries destructors ;
  10 USE: tools.walker
  11 IN: db.sqlite
  12
  13 TUPLE: sqlite-db < db path ;
  14
  15 M: sqlite-db make-db* ( path db -- db )
  16     swap >>path ;
  17
  18 M: sqlite-db db-open ( db -- db )
  19     dup path>> sqlite-open >>handle ;
  20
  21 M: sqlite-db db-close ( handle -- ) sqlite-close ;
  22 M: sqlite-db dispose ( db -- ) db-dispose ;
  23
  24 TUPLE: sqlite-statement < statement ;
  25
  26 TUPLE: sqlite-result-set < result-set has-more? ;
  27
  28 M: sqlite-db <simple-statement> ( str in out -- obj )
  29     <prepared-statement> ;
  30
  31 M: sqlite-db <prepared-statement> ( str in out -- obj )
  32     sqlite-statement construct-statement ;
  33
  34 : sqlite-maybe-prepare ( statement -- statement )
  35     dup handle>> [
  36         db get handle>> over sql>> sqlite-prepare
  37         >>handle
  38     ] unless ;
  39
  40 M: sqlite-statement dispose ( statement -- )
  41     handle>>
  42     [ [ sqlite3_reset drop ] keep sqlite-finalize ] when* ;
  43
  44 M: sqlite-result-set dispose ( result-set -- )
  45     f >>handle drop ;
  46
  47 : reset-statement ( statement -- )
  48     sqlite-maybe-prepare handle>> sqlite-reset ;
  49
  50 : reset-bindings ( statement -- )
  51     sqlite-maybe-prepare
  52     handle>> [ sqlite3_reset drop ] [ sqlite3_clear_bindings drop ] bi ;
  53
  54 M: sqlite-statement low-level-bind ( statement -- )
  55     [ bind-params>> ] [ handle>> ] bi
  56     [ swap [ key>> ] [ value>> ] [ type>> ] tri sqlite-bind-type ] curry each ;
  57
  58 M: sqlite-statement bind-statement* ( statement -- )
  59     sqlite-maybe-prepare
  60     dup bound?>> [ dup reset-bindings ] when
  61     low-level-bind ;
  62
  63 GENERIC: sqlite-bind-conversion ( tuple obj -- array )
  64
  65 TUPLE: sqlite-low-level-binding < low-level-binding key type ;
  66 : <sqlite-low-level-binding> ( key value type -- obj )
  67     sqlite-low-level-binding new
  68         swap >>type
  69         swap >>value
  70         swap >>key ;
  71
  72 M: sql-spec sqlite-bind-conversion ( tuple spec -- array )
  73     [ column-name>> ":" prepend ]
  74     [ slot-name>> rot get-slot-named ]
  75     [ type>> ] tri <sqlite-low-level-binding> ;
  76
  77 M: literal-bind sqlite-bind-conversion ( tuple literal-bind -- array )
  78     nip [ key>> ] [ value>> ] [ type>> ] tri
  79     <sqlite-low-level-binding> ;
  80
  81 M: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array )
  82     tuck
  83     [ generator-singleton>> eval-generator tuck ] [ slot-name>> ] bi
  84     rot set-slot-named
  85     >r [ key>> ] [ type>> ] bi r> swap <sqlite-low-level-binding> ;
  86
  87 M: sqlite-statement bind-tuple ( tuple statement -- )
  88     [
  89         in-params>> [ sqlite-bind-conversion ] with map
  90     ] keep bind-statement ;
  91
  92 : last-insert-id ( -- id )
  93     db get handle>> sqlite3_last_insert_rowid
  94     dup zero? [ "last-id failed" throw ] when ;
  95
  96 M: sqlite-db insert-tuple* ( tuple statement -- )
  97     execute-statement last-insert-id swap set-primary-key ;
  98
  99 M: sqlite-result-set #columns ( result-set -- n )
 100     handle>> sqlite-#columns ;
 101
 102 M: sqlite-result-set row-column ( result-set n -- obj )
 103     [ handle>> ] [ sqlite-column ] bi* ;
 104
 105 M: sqlite-result-set row-column-typed ( result-set n -- obj )
 106     dup pick out-params>> nth type>>
 107     >r >r handle>> r> r> sqlite-column-typed ;
 108
 109 M: sqlite-result-set advance-row ( result-set -- )
 110     dup handle>> sqlite-next >>has-more? drop ;
 111
 112 M: sqlite-result-set more-rows? ( result-set -- ? )
 113     has-more?>> ;
 114
 115 M: sqlite-statement query-results ( query -- result-set )
 116     sqlite-maybe-prepare
 117     dup handle>> sqlite-result-set construct-result-set
 118     dup advance-row ;
 119
 120 M: sqlite-db create-sql-statement ( class -- statement )
 121     [
 122         "create table " 0% 0%
 123         "(" 0% [ ", " 0% ] [
 124             dup column-name>> 0%
 125             " " 0%
 126             dup type>> lookup-create-type 0%
 127             modifiers 0%
 128         ] interleave ");" 0%
 129     ] query-make ;
 130
 131 M: sqlite-db drop-sql-statement ( class -- statement )
 132     [ "drop table " 0% 0% ";" 0% drop ] query-make ;
 133
 134 M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
 135     [
 136         "insert into " 0% 0%
 137         "(" 0%
 138         remove-db-assigned-id
 139         dup [ ", " 0% ] [ column-name>> 0% ] interleave
 140         ") values(" 0%
 141         [ ", " 0% ] [
 142             dup type>> +random-id+ = [
 143                 [ slot-name>> ]
 144                 [
 145                     column-name>> ":" prepend dup 0%
 146                     random-id-generator
 147                 ] [ type>> ] tri <generator-bind> 1,
 148             ] [
 149                 bind%
 150             ] if
 151         ] interleave
 152         ");" 0%
 153     ] query-make ;
 154
 155 M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
 156     <insert-db-assigned-statement> ;
 157
 158 M: sqlite-db bind# ( spec obj -- )
 159     >r
 160     [ column-name>> ":" swap next-sql-counter 3append dup 0% ]
 161     [ type>> ] bi
 162     r> <literal-bind> 1, ;
 163
 164 M: sqlite-db bind% ( spec -- )
 165     dup 1, column-name>> ":" prepend 0% ;
 166
 167 M: sqlite-db persistent-table ( -- assoc )
 168     H{
 169         { +db-assigned-id+ { "integer primary key" "integer primary key" "primary key" } }
 170         { +user-assigned-id+ { f f "primary key" } }
 171         { +random-id+ { "integer primary key" "integer primary key" "primary key" } }
 172         { INTEGER { "integer" "integer" "primary key" } }
 173         { BIG-INTEGER { "bigint" "bigint" } }
 174         { SIGNED-BIG-INTEGER { "bigint" "bigint" } }
 175         { UNSIGNED-BIG-INTEGER { "bigint" "bigint" } }
 176         { TEXT { "text" "text" } }
 177         { VARCHAR { "text" "text" } }
 178         { DATE { "date" "date" } }
 179         { TIME { "time" "time" } }
 180         { DATETIME { "datetime" "datetime" } }
 181         { TIMESTAMP { "timestamp" "timestamp" } }
 182         { DOUBLE { "real" "real" } }
 183         { BLOB { "blob" "blob" } }
 184         { FACTOR-BLOB { "blob" "blob" } }
 185         { URL { "text" "text" } }
 186         { +autoincrement+ { f f "autoincrement" } }
 187         { +unique+ { f f "unique" } }
 188         { +default+ { f f "default" } }
 189         { +null+ { f f "null" } }
 190         { +not-null+ { f f "not null" } }
 191         { system-random-generator { f f f } }
 192         { secure-random-generator { f f f } }
 193         { random-generator { f f f } }
 194     } ;
 195
 196 M: sqlite-db compound ( str seq -- str' )
 197     over {
 198         { "default" [ first number>string join-space ] }
 199         [ 2drop ]
 200     } case ;