├── .gitignore ├── README.md ├── cl-linq-tests.asd ├── cl-linq-tests.lisp ├── cl-linq.asd └── cl-linq.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *~ -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | cl-linq 2 | === 3 | 4 | A simple queryable interface for tabular datasets. 5 | 6 | Examples: 7 | 8 | ``` 9 | CL-USER> (cl-linq:query :contains 1 '(1 2 3 4)) 10 | T 11 | CL-USER> (cl-linq:query :all #'oddp '(1 2 3 )) 12 | NIL 13 | CL-USER> (cl-linq:query :all #'oddp '(1 3 5 )) 14 | T 15 | CL-USER> 16 | CL-USER> (defparameter *people* 17 | `(((:name . "stephen") (:email . "s@email.com") (:age . 33)) 18 | ((:name . "bob") (:email . "b@email.com") (:age . 49)) 19 | ((:name . "foo") (:email . "f@email.com") (:age . 10)))) 20 | *PEOPLE* 21 | CL-USER> (cl-linq:query 22 | :select '(:name :age) 23 | :from *people* 24 | :where #'(lambda (row) 25 | (> (cdr (assoc :age row)) 21))) 26 | (("bob" 49) ("stephen" 33)) 27 | ``` 28 | 29 | Bugs 30 | --- 31 | 32 | * group-by appears not to work 33 | 34 | Maintainer: 35 | --- 36 | 37 | None. This project has algorithmic inefficiencies structurally. If 38 | someone wants to take it and run, please do so without worrying about 39 | asking for permission. 40 | 41 | 42 | Contributors: 43 | --- 44 | 45 | * Stephen "deliciousrobots" Goss 46 | * Paul Nathan 47 | 48 | 49 | License 50 | --- 51 | LLGPL 52 | -------------------------------------------------------------------------------- /cl-linq-tests.asd: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;;; cl-linq-test.asd 3 | ;;;; license: llgpl 4 | 5 | (asdf:defsystem #:cl-linq-tests 6 | :depends-on ( #:cl-linq #:fiveam) 7 | :components ((:file "cl-linq-tests")) 8 | :name "cl-linq-tests" 9 | :version "1.0" 10 | :maintainer "Paul Nathan" 11 | :author "Paul Nathan" 12 | :licence "LLGPL" 13 | :description "Tests for cl-linq") 14 | -------------------------------------------------------------------------------- /cl-linq-tests.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :cl-linq-tests 2 | (:use 3 | :common-lisp 4 | :cl-linq) 5 | (:export 6 | #:run-tests)) 7 | (in-package :cl-linq-tests) 8 | 9 | (def-suite cl-linq-tests 10 | :description "CL-LINQ tests") 11 | (in-suite cl-linq-tests) 12 | 13 | (test select-columns 14 | (let ((data 15 | '((a b c) 16 | (1 2 3) 17 | (4 5 6))) 18 | (data-assoc 19 | '(((:name . "bob") (:age . 20)) 20 | ((:name . "frank") (:age . 25))))) 21 | (is (equalp 22 | '((a c) 23 | (1 3) 24 | (4 6)) 25 | (cl-linq::select-columns data '(0 2)))) 26 | (is (equalp 27 | '((3 (c b a)) 28 | (3 (3 2 1)) 29 | (3 (6 5 4))) 30 | (cl-linq::select-columns data (list #'length #'reverse)))) 31 | (is (equalp 32 | '((20 "bob") 33 | (25 "frank")) 34 | (cl-linq::select-columns data-assoc '(:age :name)))))) 35 | 36 | 37 | (defparameter *people* 38 | `(((:name . "stephen") (:email . "s@email.com") (:age . 33)) 39 | ((:name . "bob") (:email . "b@email.com") (:age . 49)) 40 | ((:name . "foo") (:email . "f@email.com") (:age . 10)))) 41 | 42 | (defparameter *subjects* 43 | '((itb001 1 john 4.0) 44 | (itb001 1 bob 4.0) 45 | (itb001 1 mickey 2.0) 46 | (itb001 2 jenny 4.0) 47 | (itb001 2 james 3.0) 48 | (mkb114 1 john 3.0) 49 | (mkb114 1 erica 3.3))) 50 | 51 | (test more-data-tests 52 | (is (equalp 53 | '(("bob" 49) ("stephen" 33)) 54 | (query 55 | :select '(:name :age) 56 | :from *people* 57 | :where #'(lambda (row) 58 | (> (cdr (assoc :age row)) 21))))) 59 | (is (equalp 60 | '((ITB001 5) (MKB114 2)) 61 | (query 62 | :select t 63 | :from *subjects* 64 | :group-by '(0) ;first index 65 | :aggregating-by (list #'length)))) 66 | (is (equalp 67 | '(((ITB001 5) (ITB001 3.4)) 68 | ((MKB114 2) (MKB114 3.15))) 69 | (query 70 | :select t 71 | :from *subjects* 72 | :group-by '(0) 73 | :aggregating-by 74 | (list #'length 75 | #'(lambda (data) 76 | (/ (apply #'+ (mapcar #'fourth data)) (length data))))))) 77 | (is (equalp 78 | '((ITB001 . 4) 79 | (MKB114 . 2)) 80 | (cl-linq:QUERY 81 | :select t 82 | :from *subjects* 83 | :where #'(lambda (row) 84 | (> (fourth row) 2.0 )) 85 | :group-by '(0) 86 | :aggregating-by #'length)))) 87 | 88 | (defun run-tests () 89 | (run! 'cl-linq-tests)) 90 | -------------------------------------------------------------------------------- /cl-linq.asd: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;;; cl-linq.asd 3 | ;;;; license: llgpl 4 | 5 | (asdf:defsystem #:cl-linq 6 | :depends-on ( #:alexandria #:anaphora) 7 | :components ((:file "cl-linq")) 8 | :name "cl-linq" 9 | :version "1.0" 10 | :maintainer "Paul Nathan" 11 | :author "Paul Nathan" 12 | :licence "LLGPL" 13 | :description "CL LINQ style interface with strains of SQL" 14 | :long-description 15 | "DSL for managing and querying datasets in a SQL/LINQ style 16 | syntax. cl-linq provides a simple and usable set of primitives to 17 | make data examination straightforward. ") 18 | -------------------------------------------------------------------------------- /cl-linq.lisp: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;;; cl-linq.lisp 3 | ;;;; 4 | ;;;; Author: Paul Nathan 5 | ;;;; 6 | ;;;; License: LLGPL 7 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8 | ;;; Rationale. LINQ has proven to be an effective and immensely 9 | ;;; popular addition to C#. After many times fussing and fiddling with 10 | ;;; data handling functions, it became badly apparent to me that LINQ 11 | ;;; or a SQL-esque knockoff designed around the idea of aggregating 12 | ;;; and quering (relatively) generic datasets was needed. LOOP is not 13 | ;;; enough. LOOP is an iteration construct that happens to have 14 | ;;; aggregation and selection capabilities. 15 | 16 | ;;; This library is slow. See REBUILD.md. 17 | 18 | (defpackage :cl-linq 19 | (:use 20 | :common-lisp 21 | :anaphora) 22 | (:export 23 | #:query 24 | #:cl-linq-select)) 25 | (in-package :cl-linq) 26 | 27 | (defun selector-to-lambda (selector) 28 | "Convert a selector to a function." 29 | (typecase selector 30 | (function selector) 31 | (integer (lambda (row) (elt row selector))) 32 | (symbol (lambda (row) (cdr (assoc selector row)))) 33 | (t (error "Unable to determine selector")))) 34 | 35 | (defun select-columns (data-rows selectors) 36 | "Do a selection on a sequence, supports a sequence of 37 | sequences using MAP and produces a list of lists." 38 | (let ((selectors (if (consp selectors) selectors (list selectors)))) 39 | (let ((selectors (mapcar #'selector-to-lambda selectors))) 40 | (map 'list 41 | (lambda (row) 42 | (map 'list 43 | (lambda (f) 44 | (funcall f row)) 45 | selectors)) 46 | data-rows)))) 47 | 48 | (defun group-by-tool (group-by results &key (test #'equalp) ) 49 | ;;initial cut: taking the index of the table to group by 50 | 51 | ;; WARNING: we are grouping by EQUALP. Probably not ideal. 52 | (let ((dummy-table (make-hash-table :test test))) 53 | (loop for row in results 54 | do 55 | (loop for g in group-by 56 | do 57 | (let ((row-idx (elt row g))) 58 | (if (not (gethash row-idx dummy-table)) 59 | (setf (gethash row-idx dummy-table) 60 | (list row)) 61 | (push row (gethash row-idx dummy-table)))))) 62 | (alexandria:hash-table-alist dummy-table))) 63 | 64 | 65 | ;; peculiar name because it has to get exported. This should help 66 | ;; minimize any namespace clashes. Note that the macro should really 67 | ;; generate some sort of FLET here instead of a full defun, but this 68 | ;; is easier to debug. After unit tests are added this will be easier. 69 | (defun cl-linq-select (columns data 70 | &key 71 | (predicate nil) 72 | (aggregation-functions nil) 73 | (having nil) 74 | (group-by nil)) 75 | 76 | (let ((results) 77 | (data-length (length data))) 78 | 79 | ;; Conditionally select rows 80 | (loop 81 | for i from 0 below data-length do 82 | ;; iteraton via elt to support the sequence abstraction 83 | (let ((row (elt data i))) 84 | 85 | (if predicate 86 | (when (funcall predicate row) 87 | (push row results)) 88 | (push row results)))) 89 | 90 | ;; Select columns 91 | (let ((selected-results 92 | (if (or (eq columns t) 93 | (eq columns '*)) 94 | results 95 | (select-columns results columns)))) 96 | 97 | ;; Based on the selected columns, determine if we need to GROUP 98 | ;; BY. 99 | (let ((grouped-results 100 | (if group-by 101 | (group-by-tool 102 | group-by 103 | having 104 | selected-results) 105 | selected-results))) 106 | 107 | (if aggregation-functions 108 | 109 | (loop for group in grouped-results 110 | collect 111 | (let ((aggregation 112 | ;; Special case it based on whether we get a 113 | ;; list of functions or not. 114 | (if (consp aggregation-functions) 115 | (loop for function in aggregation-functions 116 | collect 117 | ;; special case it: group-bys have a 118 | ;; different structure than regular 119 | ;; tables. 120 | (if group-by 121 | (funcall function (cdr group)) 122 | (funcall function group))) 123 | (if group-by 124 | (funcall aggregation-functions (cdr group)) 125 | (funcall aggregation-functions group))))) 126 | 127 | ;; cons in the key to the group 128 | (if group-by 129 | (cons (car group) 130 | aggregation) 131 | aggregation))) 132 | grouped-results))))) 133 | 134 | (defmacro select-parser (selectors &key from where group-by having aggregating-by) 135 | "SELECT (t | ) FROM (WHERE predicate) 136 | 137 | Data is expected to be a 2D loopable list of lists." 138 | `(cl-linq-select ,selectors ,from 139 | :predicate ,where 140 | :group-by ,group-by 141 | :having ,having 142 | :aggregation-functions ,aggregating-by)) 143 | 144 | 145 | (defmacro all-parser (pred sequence) 146 | `(every ,pred ,sequence)) 147 | 148 | ;;(all-parser #'oddp '(1 3 5)) 149 | 150 | ;;(all-parser #'(lambda (val) t) '(1 2 5)) 151 | 152 | 153 | (defmacro any-parser (pred seq) 154 | `(some ,pred ,seq)) 155 | 156 | ;;(any-parser #'oddp '(1 2 5)) 157 | 158 | (defmacro contains-parser (val seq) 159 | `(any-parser 160 | #'(lambda (ele) 161 | (eql ele ,val)) 162 | ,seq)) 163 | 164 | ;;(contains-parser 3 '(1 2 3 4)) 165 | 166 | (defmacro sum-parser (data key) 167 | `(reduce #'+ ,data :key ,key)) 168 | 169 | (defmacro query (operation &rest args) 170 | (ecase operation 171 | (:group-by 172 | `(group-by ,group-by-tool ,@args)) 173 | (:min 174 | `(min-parser ,operation ,@args)) 175 | (:all 176 | `(all-parser ,(first args) ,(second args))) 177 | (:contains 178 | `(contains-parser ,(first args) ,(second args))) 179 | (:any 180 | `(any-parser ,(first args) ,(second args))) 181 | (:sum 182 | `(sum-parser ,(first args) ,(second args))) 183 | (:reduce 184 | `(reduce ,(second args) ,(first args) ,(third args))) 185 | (:select 186 | `(select-parser ,@args)))) 187 | --------------------------------------------------------------------------------