401 lines
16 KiB
Scheme
401 lines
16 KiB
Scheme
;; -*- Mode: Scheme; geiser-scheme-implementation: guile; tab-width: 2 -*-
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; dql.scm
|
|
;;; Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
|
|
;;;
|
|
;;; This file is part of scheme-dql: you can redistribute it and/or modify it
|
|
;;; under the terms of the GNU Affero General Public License as published by the
|
|
;;; Free Software Foundation, version 3 of the License.
|
|
;;;
|
|
;;; scheme-dql is distributed in the hope that it will be useful, but WITHOUT
|
|
;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
|
;;; more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License along with
|
|
;;; scheme-dql. If not, see <https://www.gnu.org/licenses/>.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
#|
|
|
This module creates an interface for processing alist data in the same sense as
|
|
how sqlite is used for processing data. The data is in alists stored and read
|
|
by the calling application in the same way as how json is used. The querry
|
|
syntax is fixed from SQL like how irregex fixed regular expressions.
|
|
|#
|
|
|
|
;; TODO move non public functions to sub modules and generate api documentation
|
|
;; for this module with https://luis-felipe.gitlab.io/guile-documenta/.
|
|
|
|
(define-module (dql dql)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (ice-9 pretty-print)
|
|
#:use-module (ice-9 optargs)
|
|
#:use-module (oop goops))
|
|
|
|
(define-public alist?
|
|
(lambda (test-list)
|
|
"Check if the test data is an alist with the keys as strings.
|
|
|
|
@strong{test-list} (list):
|
|
The data to check.
|
|
|
|
@strong{return} (bool):
|
|
True if the test data is an alist with the keys as strings, false
|
|
otherwise."
|
|
(if (pair? test-list)
|
|
(every (lambda (ass)
|
|
(if (pair? ass)
|
|
(or (string? (car ass))
|
|
(symbol? (car ass)))
|
|
#f))
|
|
test-list)
|
|
#f)))
|
|
|
|
(define path-val
|
|
(lambda (path data)
|
|
"Return the code that can determine the last key of the path, where the path
|
|
forms a list of keys with each following key is read from the data of the
|
|
preceding key.
|
|
|
|
@strong{path} (list):
|
|
A list of key strings in the sequence as how you should traverse the
|
|
data to get to the value.
|
|
|
|
@strong{data} (alist):
|
|
The a-list data tree to retrieve the value from.
|
|
|
|
@strong{return} (any):
|
|
The value stored by the last key in the path."
|
|
(if (null? (cdr path))
|
|
`(assoc-ref ,data ,(car path))
|
|
(path-val (cdr path)
|
|
`(assoc-ref ,data ,(car path))))))
|
|
|
|
(define-public dql-data->list
|
|
(lambda (data)
|
|
"Function to convert the supplied data into a list of alists from a non
|
|
list like a vector that could be represented as a list of alists or ill
|
|
formatted data.
|
|
|
|
@strong{data} (any data type that could be represented as a list):
|
|
The source data to convert.
|
|
|
|
@strong{return} (list of alists):
|
|
The input data converted to a list of alists.
|
|
|
|
Only vectors and ill formatted lists of alists are supported at the moment
|
|
but more could be added like arrays etc."
|
|
(cond ((vector? data)
|
|
(vector->list data))
|
|
((list? data)
|
|
(cond ((and (pair? data) (pair? (car data)) (null? (cdr data))
|
|
(pair? (car data)) (pair? (caar data)) (null? (cdar data)))
|
|
;;Hack to handle nestling of answers.
|
|
(caar data))
|
|
((alist? data)
|
|
;;Hack for if alist no inside list.
|
|
(list data))
|
|
(else data)))
|
|
(else (error (string-append "Data not a list but \""
|
|
(object->string (class-of data))
|
|
"\"!\n"))))))
|
|
|
|
(define map-query-symbols
|
|
(lambda (query data)
|
|
"Function to map the querry keywords to their representative functions.
|
|
|
|
@strong{query} (dql-querry):
|
|
The querry to map.
|
|
|
|
@strong{data} (symbol)
|
|
The symbol representing the data.
|
|
|
|
@strong(return) (function call):
|
|
The call to the correct function.
|
|
|
|
Only the first symbol is used to determine what function to apply the
|
|
function handle it from there and will call this function again if needed."
|
|
(cond ((eq? (car query) 'filter)
|
|
(dql-filter (cdr query) data))
|
|
((eq? (car query) 'select)
|
|
(dql-select (cdr query) data))
|
|
((eq? (car query) 'sort)
|
|
(dql-sort (cdr query) data))
|
|
((eq? (car query) 'alter)
|
|
(dql-alter (cdr query) data))
|
|
(else (error (string-append "ERROR: Unimplemented query \""
|
|
(object->string (car query))
|
|
"\"!"))))))
|
|
|
|
(define first-parm-other
|
|
(lambda (parms . local)
|
|
"Function to determine if the first parameter is a local parameter or an
|
|
sub querry that will supply the data for this query.
|
|
|
|
@strong{parms} (dql-query):
|
|
The query to analyze.
|
|
|
|
@strong{local} (symbols):
|
|
The function local symbols that define local parameters.
|
|
|
|
@strong{return} (bool):
|
|
True if the first parameter is a sub query false otherwise."
|
|
(and (pair? parms)
|
|
(pair? (car parms))
|
|
(not (any (lambda (parm)
|
|
(eq? (caar parms) parm))
|
|
local)))))
|
|
|
|
(define dql-boolean-where
|
|
(lambda (bool-op filters entry)
|
|
"Function to return the code that can determine if the data processed by the
|
|
code should be selected for processing or not.
|
|
|
|
@strong{bool-op} (symbol):
|
|
The boolean operation to use for multiple selections.
|
|
|
|
@strong{filters} (filter list):
|
|
The list of callback filters for this query.
|
|
|
|
@strong{entry} (symbol)
|
|
The symbol representing the data entry.
|
|
|
|
@strong{return} (code):
|
|
The code that will analyze the data.
|
|
|
|
A filter is in the form of @code{(where <callback> <key> <key-n>)} where the
|
|
keys are passed as is to @ref(path-val) and the return from that as the data
|
|
to the callback function.
|
|
|
|
A boolean keyword like @samp{and} or @samp{or} will result in a tail call
|
|
with the rest of the entries as filters."
|
|
(if (or (eq? bool-op 'and)
|
|
(eq? bool-op 'or))
|
|
(append (list bool-op)
|
|
(map (lambda (rule)
|
|
(if (eq? (car rule) 'where)
|
|
`(,(cadr rule) ,(path-val (cddr rule)
|
|
entry))
|
|
(dql-boolean-where (car rule)
|
|
(cdr rule)
|
|
entry)))
|
|
filters))
|
|
(error (string-append "Unimplemented boolean operand \""
|
|
(symbol->string bool-op)
|
|
"\" for where!")))))
|
|
|
|
(define dql-filter
|
|
(lambda (query data)
|
|
"Function to return the code that will filter the data entries based on the
|
|
@xref{where, dql-boolean-where} rules of the query.
|
|
|
|
@strong{query} (dql-query):
|
|
The query to generate the code for.
|
|
|
|
@strong{data} (symbol)
|
|
The symbol representing the data.
|
|
|
|
@strong{return} (code):
|
|
The code that will process the data according to the query."
|
|
(let ((fpo (first-parm-other query 'where 'and 'or))
|
|
(entry (gensym)))
|
|
`(filter-map (lambda (,entry)
|
|
(if ,(dql-boolean-where 'and
|
|
(if fpo
|
|
(cdr query)
|
|
query)
|
|
entry)
|
|
,entry #f))
|
|
(dql-data->list ,(if fpo
|
|
(map-query-symbols (car query)
|
|
data)
|
|
data))))))
|
|
|
|
(define dql-sort
|
|
(lambda (query data)
|
|
"Function to return the code that will sort the data entries based on the
|
|
@code{by} rules of the query.
|
|
|
|
@strong{query} (dql-query):
|
|
The query to generate the code for.
|
|
|
|
@strong{data} (symbol)
|
|
The symbol representing the data.
|
|
|
|
@strong{return} (code):
|
|
The code that will process the data according to the query."
|
|
(let ((fpo (first-parm-other query 'by)))
|
|
(let ((first-parm (if fpo
|
|
(cadr query)
|
|
(car query)))
|
|
(a (gensym))
|
|
(b (gensym)))
|
|
`(sort (dql->data->list ,(if fpo
|
|
(map-query-symbols (car query)
|
|
data)
|
|
(if (null? (cdr query))
|
|
data
|
|
`(dql-sort ,(cdr query)))))
|
|
(lambda (,a ,b)
|
|
,((cadr first-parm)
|
|
(path-val (cddr first-parm) a)
|
|
(path-val (cddr first-parm) b))))))))
|
|
|
|
(define dql-alter
|
|
(lambda (query data)
|
|
"Function to return the code that will alter the data entries based on the
|
|
@xref{where, dql-boolean-where} filter as the first rule and then the
|
|
subsequent @code{insert}, @code{update} and @code{drop} rules of the query.
|
|
|
|
@strong{query} (dql-query):
|
|
The query to generate the code for.
|
|
|
|
@strong{data} (symbol)
|
|
The symbol representing the data.
|
|
|
|
@strong{return} (code):
|
|
The code that will process the data according to the query."
|
|
(let* ((fpo (first-parm-other query 'insert 'update 'drop 'where))
|
|
(entry (gensym))
|
|
(parm->code
|
|
(lambda (parm)
|
|
;;TODO get entry from path-val.
|
|
(cond ((eq? (car parm) 'update)
|
|
`(set! ,entry
|
|
(assoc-set! ,entry ,(second parm) ,(third parm))))
|
|
((eq? (car parm) 'insert)
|
|
`(set! ,entry
|
|
(acons ,(second parm) ,(third parm) ,entry)))
|
|
((eq? (car parm) 'drop)
|
|
`(set! ,entry
|
|
(assoc-remove! ,entry
|
|
,(second parm))))
|
|
(else (error (string-append "Illegal parameter \""
|
|
(symbol->string (car parm))
|
|
"\" for alter")))))))
|
|
`(map ,(append (list 'lambda (list entry))
|
|
(list (append (list 'if
|
|
(if fpo
|
|
(if (first-parm-other (cdr query)
|
|
'where)
|
|
#t
|
|
(dql-boolean-where 'where
|
|
(cadr query)
|
|
entry))
|
|
(if (first-parm-other query 'where)
|
|
#t
|
|
(dql-boolean-where 'where
|
|
(car query)
|
|
entry))))
|
|
(list (append (list 'begin)
|
|
(map parm->code
|
|
(if fpo
|
|
(cdr query)
|
|
query))))))
|
|
(list entry))
|
|
(dql-data->list ,(if fpo
|
|
(map-query-symbols (car query) data)
|
|
data))))))
|
|
|
|
(define dql-select
|
|
(lambda (query data)
|
|
"Function to return the code that will select a subsections of the
|
|
associations of the alist data entries based on the @code{parm},
|
|
@code{parm-as} and @code{parm-val} rules of the query.
|
|
|
|
@strong{query} (dql-query):
|
|
The query to generate the code for.
|
|
|
|
@strong{data} (symbol)
|
|
The symbol representing the data.
|
|
|
|
@strong{return} (code):
|
|
The code that will process the data according to the query."
|
|
(let* ((fpo (first-parm-other query 'parm 'parm-as 'parm-val))
|
|
(entry (gensym))
|
|
(parm->code
|
|
(lambda (parm)
|
|
(cond ((eq? (car parm) 'parm)
|
|
(let ((last-parm (last parm))
|
|
(rest-parms (drop-right (cdr parm) 1)))
|
|
`(assoc ,last-parm
|
|
,(if (null? rest-parms)
|
|
entry
|
|
(path-val rest-parms
|
|
entry)))))
|
|
((eq? (car parm) 'parm-as)
|
|
`(cons ,(car (cdr parm))
|
|
,(path-val (cdr (cdr parm))
|
|
entry)))
|
|
((eq? (car parm) 'parm-val)
|
|
(let ((last-parm (last parm))
|
|
(rest-parms (drop-right (cdr parm) 1)))
|
|
`(assoc-ref ,(if (null? rest-parms)
|
|
entry
|
|
(path-val rest-parms
|
|
entry))
|
|
,last-parm)))
|
|
(else
|
|
(error "Illegal parameter for select."))))))
|
|
`(map (lambda (,entry)
|
|
,(append (list 'list)
|
|
(map parm->code
|
|
(if fpo (cdr query) query))))
|
|
(dql-data->list ,(if fpo
|
|
(map-query-symbols (car query) data)
|
|
data))))))
|
|
|
|
(defmacro*-public dql (query #:key (print-query #f))
|
|
"The main exported macro to return the lambda that will process the data
|
|
based on the query.
|
|
|
|
@strong{query} (dql-query):
|
|
The query to generate the code for.
|
|
|
|
@strong{print-query} (boolean)
|
|
Option to @code{pretty-print} the generated lambda's code.
|
|
|
|
@strong{return} (lambda):
|
|
The lambda function that will process the data according to the query."
|
|
(let ((data (gensym)))
|
|
(if print-query
|
|
(begin (display "generated query for ")
|
|
(display print-query)
|
|
(display ":")
|
|
(newline)
|
|
(pretty-print `(lambda (,data)
|
|
,(map-query-symbols query data)))))
|
|
`(lambda (,data)
|
|
,(map-query-symbols query data))))
|
|
|
|
(define-public dql-write
|
|
(lambda (data path)
|
|
"A helper procedure to write the data to a file.
|
|
|
|
@strong{data} (alist-data):
|
|
The data to write to the file.
|
|
|
|
@strong{path} (string):
|
|
The file path to write the data to.
|
|
|
|
@strong{return} (undefined):"
|
|
(let ((output-port (open-output-file path)))
|
|
(pretty-print data output-port
|
|
#:display? #f
|
|
#:width 600
|
|
#:max-expr-width 600)
|
|
(close output-port))))
|
|
|
|
(define-public dql-read
|
|
(lambda (path)
|
|
"A helper function to read data from a file.
|
|
|
|
@strong{path} (string):
|
|
The file path to read the data from.
|
|
|
|
@strong{return} (alist-data):
|
|
The data read from the file."
|
|
(let* ((input-port (open-input-file path))
|
|
(data (read input-port)))
|
|
(close input-port)
|
|
data)))
|