Skip to content

Instantly share code, notes, and snippets.

@toomasv toomasv/dbquery.red
Created Feb 28, 2019

Embed
What would you like to do?
Simple query dialect
Red [
Author: "Toomas Vooglaid"
Date: 2019-02-27
Challenge: https://gitter.im/red/help?at=5c75b4d7d2d62067b7101b03
File: %dbquery.red
Purpose: {Simple query dialect}
TBD: {change delete}
]
;@GiuseppeChillemi [February 26, 2019 11:51 PM](https://gitter.im/red/help?at=5c75b4d7d2d62067b7101b03)
assign: func [words values][
collect [
forall words [
keep to-set-word words/1
keep either block? values [
values/(index? words)
][
values
]
]
]
]
dbs: clear []
selection: clear []
fields: clear []
dbquery: func [code /local s i j f idx vals][
vals: clear []
parse code [
some [
'add [s: ;(probe s)
'db word! (
repend dbs [db-name: s/2 db: copy []]
)
| 'table [
word! opt ['with 'fields] set spec block! (
repend db [
table-name: s/2
table: compose/only [spec: (spec) rows: []]
]
)
| word! (
repend db [
table-name: s/2
table: copy/deep [spec: [] rows: []]
]
)
]
| ['fields block! | 'field word!] (
append spec: table/spec s/2
)
| 'row block! (
new-line tail rows on
append/only rows: table/rows s/2
)
| 'rows block! (
append rows: table/rows s/2
new-line/all rows on
)
]
| 'use [s: (spec: none)
'db word! (db: select dbs s/2)
| 'table word! (
table: select db s/2
cols: extract table/spec 2
values: context assign cols none
selection: table/rows
)
| 'field (clear fields) [
word! (
idx: (index? find table/spec s/2) / 2 + 1
foreach row selection [
append/only fields pick row idx
]
)
| integer! (
foreach row selection [
append/only fields pick row s/2
]
)
]
| 'fields block! (
clear fields
foreach row selection [
append/only fields copy collect/into [
foreach f s/2 [
either integer? f [
keep pick row f
][
idx: (index? find table/spec f) / 2 + 1
keep pick row idx
]
]
] clear vals
]
)
]
| 'select [s: (selection: clear [])
'row integer! (append/only selection row: pick table/rows s/2)
| 'rows [
'where block! (
foreach row table/rows [
set values row
if all bind s/3 values [
append/only selection row
]
]
)
| block! (
parse s/2 [any [i:
integer! '- integer! (
repeat j length? table/rows [
if all [j >= i/1 j <= i/3][
append/only selection table/rows/:j
]
]
)
| integer! '- 'end (
repeat j length? table/rows [
if j >= i/1 [
append/only selection table/rows/:j
]
]
)
| integer! (append/only selection table/rows/(i/1))
]]
)
]
]
]
]
]
comment [
code: [
add db redverse
add table persons
add fields [
alias [email!] fname [string!] lname [string!]
]
add rows [
[@GiuseppeChillemi "Giuseppe" "Chillemi"]
[@rebolek "Boleslav" "Březovský"]
[@nedzadarek "Nedza" "Darek"]
[@toomasv "Toomas" "Vooglaid"]
]
]
dbquery code
dbquery [use table persons]
dbquery [select row 1] selection
;== [
; [@GiuseppeChillemi "Giuseppe" "Chillemi"]
;]
dbquery [select rows [2 4]] selection
;== [
; [@rebolek "Boleslav" "Březovský"]
; [@toomasv "Toomas" "Vooglaid"]
;]
dbquery [add rows [[@greggirwin "Gregg" "Irwin"][@gtewalt "Greg" "Tewalt"]]]
dbquery [select rows where [find/match fname "G"]] selection
;== [
; [@GiuseppeChillemi "Giuseppe" "Chillemi"]
; [@greggirwin "Gregg" "Irwin"]
; [@gtewalt "Greg" "Tewalt"]
;]
dbquery [use field alias] fields
;== [@GiuseppeChillemi @greggirwin @gtewalt]
dbquery [select rows where [find lname "k"] use fields [fname lname]] fields
;== [["Boleslav" "Březovský"] ["Nedza" "Darek"]]
dbquery [select row 1 use field 2] fields
;== ["Giuseppe"]
append clear fields/1 "Giacomo"
;== "Giacomo"
dbquery [select row 1] selection
;== [
; [@GiuseppeChillemi "Giacomo" "Chillemi"]
;]
length? rows
;== 6
take at rows 4
;== [@toomasv "Toomas" "Vooglaid"]
dbquery [use table persons] selection
;== [
; [@GiuseppeChillemi "Giuseppe" "Chillemi"]
; [@rebolek "Boleslav" "Březovský"]
; [@nedzadarek "Nedza" "Darek"]
; [@greggirwin "Gregg" "Irwin"]
; [@gtewalt "Greg" "Tewalt"]
;]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.