(library (sph storage dg relation path-find node)
  (export
    node-combinator->consume
    node-combinator->consume-one
    node-combinator->get
    node-procedures)
  (import
    (rnrs exceptions)
    (rnrs lists)
    (sph)
    (sph hashtable)
    (sph list)
    (sph storage dg)
    (sph storage dg one)
    (sph storage dg relation path-find base)
    (sph storage dg stream)
    (srfi srfi-41)
    (except (srfi srfi-1) map))

  ;for evaluating node (sub-) expressions.

  (define (node-or-get s t get result-get field accessor)
    "list/false:id-list list/false:id-list procedure:{list:source list:target symbol:retrieve-field -> relation-record-stream} any ... -> relation-record-stream"
    (get s t #f))

  (define (node-or-consume-one result s get result-get field accessor)
    "relation-record-stream id-list procedure:{source target retrieve} any ... -> relation-record-stream
     filter relations that have \"s\" ids in the source position (left or right, depending on how the get procedure interprets it)"
    ;*-get always includes the processing for an "or" side
    result)

  (define (node-or-consume results get result-get field accessor . data)
    "(relation-record-stream ...) procedure procedure symbol procedure false/stream -> relation-record-stream
     evaluate the node-expr of this type for (source-fields-of-results target-fields-of-results)
     results represents the reduced set of relations that still could possibly match"
    (apply stream-append results))

  (define (node-and-get s t get result-get field accessor)
    ;uses the "retrieve" parameter of get for optimisation.
    ;loads a set of possible target ids and reduces the set and if there are targets left it gets all relevant relation records
    (let loop ((s-rest s) (t-result t))
      (if (null? t-result) stream-null
        (if (null? s-rest) (get s t-result #f)
          (loop (tail s-rest) (stream->list (get (list (first s-rest)) t-result field)))))))

  (define (node-and-consume-one result s get result-get field accessor)
    (let loop ((s-part s) (t #f))
      (if (null? s-part) (result-get result s t)
        (loop (tail s-part)
          (stream->list (stream-map accessor (result-get result (list (first s-part)) t)))))))

  (define (node-and-consume results get result-get field accessor . data)
    ;get targets that occur in all result-sets and then filter all relations with those targets
    (let
      (t
        (apply intersection (map (l (result) (stream->list (stream-map accessor result))) results)))
      (fold (l (result r) (stream-append (stream-filter (l (a) (memv (accessor a) t)) result) r))
        stream-null results)))

  (define (node-not-consume-one result s get result-get field accessor)
    (stream-filter (l (a) (stream-null? (get s (list (accessor a)) field))) result))

  (define (node-not-consume results get result-get field accessor possible-targets)
    "list procedure procedure symbol procedure stream -> stream"
    ;see path-find.scm for more details about how "not" is evaluated.
    (let (non-targets (append-map stream->list (map (l (a) (stream-map accessor a)) results)))
      (stream-filter (l (a) (not (containsv? non-targets (accessor a))))
        (if possible-targets possible-targets (get #f #f #f)))))

  (define (node-only-get s t get result-get field accessor)
    (let (other-field (dg-direction-invert field))
      (stream-filter
        (l (a) (list-set-eqv? s (stream->list (get #f (list (accessor a)) other-field))))
        (node-and-get s t get result-get field accessor))))

  (define (node-only-consume-one result s get result-get field accessor)
    (let (other-accessor (dg-direction-field-accessor-invert accessor))
      (stream-filter
        (l (e)
          (list-set-eqv? s
            (stream->list (stream-map other-accessor (stream->list (get result #f (list (get e))))))))
        (node-and-consume-one result s get result-get field accessor))))

  (define (node-only-consume results get result-get field accessor . data)
    (let*
      ( (result (apply stream-append results))
        (other-accessor (dg-direction-field-accessor-invert accessor))
        (s (stream->list (stream-map other-accessor result))))
      (stream-filter
        (l (relation-record)
          (list-set-eqv? s
            (stream->list
              (stream-map other-accessor (result-get result #f (list (accessor relation-record)))))))
        result)))

  (define-as node-procedures ht-create-symbol-q
    or (vector node-or-get node-or-consume-one node-or-consume)
    and (vector node-and-get node-and-consume-one node-and-consume)
    only (vector node-only-get node-only-consume-one node-only-consume)
    not (vector #f node-not-consume-one node-not-consume))

  (define (node-combinator->get a) (vector-ref (ht-ref node-procedures a) 0))
  (define (node-combinator->consume-one a) (vector-ref (ht-ref node-procedures a) 1))
  (define (node-combinator->consume a) (vector-ref (ht-ref node-procedures a) 2)))