Simple query dialect

dbquery.red

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"]
;]
]