Coverage report: /development/source/library/org/datagraph/spocq-shard/src/store/rdfcache/lucene-index.lisp

KindCoveredAll%
expression0323 0.0
branch038 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 ;; (load "/development/source/library/org/datagraph/spocq/src/store/lucene-index.lisp")
5
 
6
 (defparameter *lucene-operator-map*
7
   (loop for symbol being each external-symbol in :spocq.a
8
         for lucene-symbol = (find-symbol (symbol-name symbol) :lucene)
9
         when lucene-symbol
10
         collect (cons symbol lucene-symbol)))
11
 
12
 (defparameter *statement-patterns* nil)
13
 
14
 (defclass lucene-index (repository-index)
15
   ()
16
   (:documentation "cf http://lucene.apache.org/core/2_9_4/queryparsersyntax.html"))
17
 
18
 (defun lucene-field-name (predicate)
19
   (let* ((string (iri-lexical-form predicate))
20
          (punctuation (position #\/ string :from-end t)))
21
     (if punctuation (subseq string (1+ punctuation)) string)))
22
 
23
 (defun lucene-invalid-expression (&rest form)
24
   (error "Invalid licene expression: ~s." form))
25
 
26
 
27
 (defmethod compute-index-statements ((index lucene-index) statements filters)
28
   (let ((subjects (remove-duplicates (mapcar #'statement-subject statements))))
29
     (loop for subject in subjects
30
           collect (loop for statement in statements
31
                         with predicates = ()
32
                         with objects = ()
33
                         with graph = nil
34
                         with subject-filters = ()
35
                         when (eq subject (statement-subject statement))
36
                         do (let ((object (statement-object statement)))
37
                              (push (statement-predicate statement) predicates)
38
                              (push object objects)
39
                              (if graph
40
                                (assert (equalp graph (statement-context statement)) ()
41
                                        "Invalid index pattern; spans graphs: ~s." statements)
42
                                (setf graph (statement-context statement)))
43
                              (loop for filter in filters
44
                                    for filter-variables = (expression-variables filter)
45
                                    when (or (find subject filter-variables) (find object filter-variables))
46
                                    do (pushnew filter subject-filters)))
47
                         finally (return `(bgp:index-match ,subject ,predicates ,objects ,graph
48
                                                          :test ,(reduce #'(lambda (e1 &optional e2)
49
                                                                             (if e2 `(spocq.a:&& ,e1 ,e2) e1))
50
                                                                         subject-filters :key #'second)))))))
51
 
52
 
53
 (defmethod translate-index-expression ((index lucene-index) (expression list) (variable-term-map list))
54
   (apply #'rewrite-to-lucene (sublis variable-term-map expression)))
55
 
56
 
57
 (defgeneric rewrite-to-lucene (operator &rest args)
58
   (:method ((op (eql 'spocq.a:|strends|)) &rest args)
59
     (destructuring-bind (predicate value) args
60
       (format nil "~a:\"*~a\"" (lucene-field-name predicate) value)))
61
   
62
   (:method ((op (eql 'spocq.a:|strstarts|)) &rest args)
63
     (destructuring-bind (predicate value) args
64
       (format nil "~a:\"~a*\"" (lucene-field-name predicate) value)))
65
   
66
   (:method ((op (eql 'spocq.a:|\|\||)) &rest args)
67
     (destructuring-bind (expr1 expr2) args
68
       (format nil "~a OR ~a" (apply #'rewrite-to-lucene expr1) (apply #'rewrite-to-lucene expr2))))
69
   
70
   (:method ((op (eql 'spocq.a:|&&|)) &rest args)
71
     (destructuring-bind (expr1 expr2) args
72
       (flet ((filter-relation-components (expr)
73
                (let ((op (first expr)))
74
                  (when (member op '(spocq.a:< spocq.a:> spocq.a:<= spocq.a:>=))
75
                    (cond ((iri-p (second expr))
76
                           (values op (second expr) (third expr)))
77
                          ((iri-p (third expr))
78
                           (values (rest (assoc op '((spocq.a:< . spocq.a:>) (spocq.a:> . spocq.a:<)
79
                                                     (spocq.a:<= . spocq.a:>=) (spocq.a:>= . spocq.a:<=))))
80
                                   (third expr) (second expr)))
81
                          (t
82
                           nil))))))
83
         (multiple-value-bind (op1 term1 bounds1) (filter-relation-components expr1)
84
           (multiple-value-bind (op2 term2 bounds2) (filter-relation-components expr2)
85
             (cond ((and (equalp term1 term2)
86
                         (= (length (set-difference '(spocq.a:< spocq.a:> spocq.a:<= spocq.a:>=) (list op1 op2))) 2))
87
                    (case op1
88
                      ((spocq.a:|<| spocq.a:|<=|)
89
                       (case op2
90
                         ((spocq.a:|>| spocq.a:|>=|)
91
                          (format nil "~a:~:[(~;[~]~s TO ~s~:[)~;]~]"
92
                                  (lucene-field-name term1)
93
                                  (eq op2 'spocq.a:|>=|)
94
                                  bounds2 bounds1
95
                                  (eq op1 'spocq.a:|<=|)))
96
                         (t 
97
                          (lucene-invalid-expression '&& expr1 expr2))))
98
                      ((spocq.a:|>| spocq.a:|>=|)
99
                       (case op2
100
                         ((spocq.a:|<| spocq.a:|<=|)
101
                          (format nil "~a:~:[(~;[~]~s TO ~s~:[)~;]~]"
102
                                  (lucene-field-name term1)
103
                                  (eq op1 'spocq.a:|>=|)
104
                                  bounds1 bounds2
105
                                  (eq op2 'spocq.a:|<=|)))
106
                         (t 
107
                          (lucene-invalid-expression '&& expr1 expr2))))
108
                      (t 
109
                       (lucene-invalid-expression '&& expr1 expr2))))
110
                   (t
111
                    (format nil "( ~a AND ~a )" (apply #'rewrite-to-lucene expr1) (apply #'rewrite-to-lucene expr2)))))))))
112
   
113
   (:method ((op (eql 'spocq.a:|!|)) &rest args)
114
     (format nil "NOT (~a)" (apply #'rewrite-to-lucene (first args))))
115
   
116
   (:method ((op (eql 'spocq.a:|=|)) &rest args)
117
     (destructuring-bind (expr1 expr2) args
118
       (cond ((iri-p expr1)
119
              (when (iri-p expr2)
120
                (lucene-invalid-expression '= expr1 expr2))
121
              (format nil "~a:~s" (lucene-field-name expr1) expr2))
122
             ((iri-p expr2)
123
              (when (iri-p expr1)
124
                (lucene-invalid-expression '= expr1 expr2))
125
              (format nil "~a:~s" (lucene-field-name expr2) expr1))
126
             (t
127
              (lucene-invalid-expression '= expr1 expr2)))))
128
   
129
   (:method ((op (eql 'spocq.a:|!=|)) &rest args)
130
     (format nil "NOT (~a)" (apply #'rewrite-to-lucene 'spocq.a:|=| args)))
131
   
132
   (:method ((op (eql 'spocq.a:|<|)) &rest args)
133
     (destructuring-bind (expr1 expr2) args
134
       (cond ((iri-p expr1)
135
              (when (iri-p expr2)
136
                (lucene-invalid-expression '< expr1 expr2))
137
              (format nil "~a:[* TO ~s)" (lucene-field-name expr1) expr2))
138
             ((iri-p expr2)
139
              (when (iri-p expr1)
140
                (lucene-invalid-expression '< expr1 expr2))
141
              (format nil "~a:(~s TO *]" (lucene-field-name expr2) expr1))
142
             (t
143
              (lucene-invalid-expression '< expr1 expr2)))))
144
   
145
   (:method ((op (eql 'spocq.a:|<=|)) &rest args)
146
     (destructuring-bind (expr1 expr2) args
147
       (cond ((iri-p expr1)
148
              (when (iri-p expr2)
149
                (lucene-invalid-expression '< expr1 expr2))
150
              (format nil "~a:[* TO ~s]" (lucene-field-name expr1) expr2))
151
             ((iri-p expr2)
152
              (when (iri-p expr1)
153
                (lucene-invalid-expression '< expr1 expr2))
154
              (format nil "~a:[~s TO *]" (lucene-field-name expr2) expr1))
155
             (t
156
              (lucene-invalid-expression '< expr1 expr2)))))
157
   
158
   (:method ((op (eql 'spocq.a:|>|)) &rest args)
159
     (destructuring-bind (expr1 expr2) args
160
       (rewrite-to-lucene 'spocq.a:|<| expr2 expr1)))
161
   
162
   (:method ((op (eql 'spocq.a:|>=|)) &rest args)
163
     (destructuring-bind (expr1 expr2) args
164
       (rewrite-to-lucene 'spocq.a:|<=| expr2 expr1))))