(define-module (webid-oidc rdf-index)
  #:use-module (oop goops)
  #:use-module (rdf rdf)
  #:use-module (web uri)
  #:export
  (
   with-index
   ))

(define (normalize uri)
  ;; It is possible to hide triples by percent-escaping
  ;; some characters, so that match will fail to see
  ;; them. With normalization, it should be impossible.
  (when (string? uri)
    (set! uri (string->uri uri)))
  (let ((scheme (uri-scheme uri))
        (userinfo (uri-userinfo uri))
        (host (uri-host uri))
        (port (uri-port uri))
        (path (uri-path uri))
        (query (uri-query uri))
        (fragment (uri-fragment uri)))
    (let ((normalized-scheme scheme)
          (normalized-userinfo userinfo)
          (normalized-host host)
          (normalized-port port)
          (normalized-path
           (let ((path-ends-in-slash? (string-suffix? "/" path)))
             (string-append
              "/"
              (encode-and-join-uri-path
               (split-and-decode-uri-path path))
              (if (and (not (equal? path "/"))
                       path-ends-in-slash?)
                  "/"
                  ""))))
          (normalized-query
           (and query
                (uri-encode (uri-decode query))))
          (normalized-fragment
           (and fragment
                (uri-encode (uri-decode fragment)))))
      (build-uri normalized-scheme
                 #:userinfo normalized-userinfo
                 #:host normalized-host
                 #:port normalized-port
                 #:path normalized-path
                 #:query normalized-query
                 #:fragment normalized-fragment))))

(define (normalize-object object)
  (if (string? object)
      (uri->string (normalize object))
      object))

(define-class <rdf-index> ()
  (triples #:init-keyword #:triples #:getter triples)
  (subject-index #:init-thunk (lambda () (make-hash-table))
                 #:getter subject-index)
  (predicate-index #:init-thunk (lambda () (make-hash-table))
                   #:getter predicate-index)
  (object-index #:init-thunk (lambda () (make-hash-table))
                #:getter object-index))

(define (build-index triples)
  (let ((ret (make <rdf-index> #:triples (list->vector triples))))
    (define (do-index n triples)
      (unless (null? triples)
        (let ((first (car triples))
              (rest (cdr triples)))
          (let ((s (normalize-object (rdf-triple-subject first)))
                (p (normalize-object (rdf-triple-predicate first)))
                (o (normalize-object (rdf-triple-object first))))
            (let ((other-s (hash-ref (subject-index ret) s '()))
                  (other-p (hash-ref (predicate-index ret) p '()))
                  (other-o (hash-ref (object-index ret) o '()))
                  (i (- n 1)))
              (hash-set! (subject-index ret) s (cons i other-s))
              (hash-set! (predicate-index ret) p (cons i other-p))
              (hash-set! (object-index ret) o (cons i other-o))))
          (do-index (- n 1) rest))))
    (do-index (length triples) (reverse triples))
    ret))

(define (intersection-2 a b)
  (cond
   ((not a) b)
   ((not b) a)
   ((or (null? a) (null? b))
    '())
   ((< (car a) (car b))
    (intersection-2 (cdr a) b))
   ((> (car a) (car b))
    (intersection-2 a (cdr b)))
   (else
    (cons (car a) (intersection-2 (cdr a) (cdr b))))))

(define (intersection a . rest)
  (if (null? rest)
      a
      (let ((b (car rest))
            (true-rest (cdr rest)))
        (apply intersection (intersection-2 a b) true-rest))))

(define (rdf-match index subject predicate object)
  (let ((by-subject
         (and subject
              (hash-ref (subject-index index)
                        (normalize-object subject)
                        '())))
        (by-predicate
         (and predicate
              (hash-ref (predicate-index index)
                        (normalize-object predicate)
                        '())))
        (by-object
         (and object
              (hash-ref (object-index index)
                        (normalize-object object)
                        '()))))
    (let ((indices (intersection by-subject by-predicate by-object)))
      (define (accumulate-triples acc i)
        (if (null? i)
            (reverse acc)
            (let ((t (vector-ref (triples index) (car i))))
              (accumulate-triples (cons t acc) (cdr i)))))
      (if indices
          (accumulate-triples '() indices)
          (vector->list (triples index))))))
        
        
(define (with-index graph f)
  (let ((index (build-index graph)))
    (f (lambda (s p o)
         (rdf-match index s p o)))))