(library (sph storage dg relation path-find path)
  (export
    dg-path-find-combinators
    dg-path-find-default-combinator
    dg-path-find-path-not
    dg-path-find-path-only
    dg-path-find-path-prepare)
  (import
    (rnrs exceptions)
    (rnrs hashtables)
    (rnrs lists)
    (rnrs sorting)
    (sph)
    (sph hashtable)
    (sph list)
    (sph one)
    (sph storage dg relation path-find base)
    (sph storage dg relation path-find node)
    (only (guile) identity))

  (define sph-storage-dg-relation-path-find-path "path-find path processing")
  (define dg-path-find-combinators (vector->list (ht-keys node-procedures)))

  (define (iterate* proc a . states)
    (letrec
      ( (loop
          (l (rest . states)
            (if (null? rest)
              (if (or (null? states) (not (null? (tail states)))) states (first states))
              (apply proc (first rest) rest loop states)))))
      (apply loop a states)))

  (define (remove-combinator a) (if (symbol? (first a)) (tail a) a))

  (define-syntax-rule (define-path-find-path-contains name unary-modifier)
    (define (name a search-values) "path (integer ...) -> boolean"
      (if (null? a) #f
        (any
          (l (e)
            (if (list? e) (name e search-values) (unary-modifier (contains? search-values e memv))))
          (remove-combinator a)))))

  (define-path-find-path-contains path-find-path-contains-some-not? not)
  (define-path-find-path-contains path-find-path-contains-some? identity)

  (define (dg-path-find-path-not a filter-ids)
    "list list -> list
     if any identifier in path occurs in filter-ids, return an empty list"
    (map-unless
      (l (e)
        (if (integer? e) (if (contains? filter-ids e) #f e)
          (if (list? e)
            (if (or (null? e) (eqv? (q *) (first e))) #f
              ;subtle difference to dg-filter-path
              (if (path-find-path-contains-some? e filter-ids) #f e))
            ;subtle difference to dg-filter-path-find-path
            (if (eq? (q *) e) (pair (q not) filter-ids) e))))
      not (list) a))

  (define (dg-path-find-path-only a filter-ids)
    "list list -> list
     if any identifier in path does not occur in filter-ids, return an empty list"
    (map-unless
      (l (e)
        (if (integer? e) (if (contains? filter-ids e) e #f)
          (if (list? e)
            (if (or (null? e) (eqv? (q *) (first e))) #f
              (if (path-find-path-contains-some-not? e filter-ids) #f e))
            (if (eqv? (q *) e) filter-ids #f))))
      not (list) a))

  (define dg-path-find-default-combinator (q or))

  (define (dg-path-find-path-prepare-second-level rest r first? parent-combinator)
    "second-level: node-expressions"
    (if (null? rest) (simplify-list (reverse r))
      (let (e (first rest))
        (if (list? e)
          (if (null? e) null
            (and-let* ((e (dg-path-find-path-prepare-second-level e (list) #t parent-combinator)))
              (if (null? e) null
                (dg-path-find-path-prepare-second-level (tail rest)
                  ;example: (and 1 (and 2)) -> (and 1 2)
                  (if
                    (and (not (negative-combinator? parent-combinator))
                      (eq? parent-combinator (first e)))
                    (append (reverse (tail e)) r)
                    (if (integer? (first e)) (append (reverse e) r) (pair e r)))
                  #f parent-combinator))))
          (if (integer? e)
            (dg-path-find-path-prepare-second-level (tail rest) (pair e r) #f parent-combinator)
            (and first? (symbol? e)
              (contains? dg-path-find-combinators e)
              (and-let* ((b (dg-path-find-path-prepare-second-level (tail rest) (pair e r) #f e)))
                (wrap-unary-combinator-arguments e b))))))))

  (define (wrap-unary-combinator-arguments combinator a) "(not 1 2) -> (not (or 1 2))"
    (if (unary-combinator? combinator)
      (if (and (= 2 (length a)) (not (integer? (second a)))) a
        (list combinator (pair (q or) (tail a))))
      a))

  (define (dg-path-find-path-prepare path)
    "list -> false/list
     validates, optimises and completes paths"
    (let
      (r
        (iterate*
          (l (a rest continue r)
            (if (list? a)
              (if (null? a) a
                (if (eqv? (q *) (first a))
                  (let (a (and (flat? a) (every integer? (tail a)) a))
                    (and a (continue (tail-or-null rest) (pair a r))))
                  (let
                    (a
                      (dg-path-find-path-prepare-second-level a (list)
                        #t dg-path-find-default-combinator))
                    (and a
                      (if (null? a) a
                        (continue (tail-or-null rest)
                          (pair (if (symbol? (first a)) a (pair dg-path-find-default-combinator a))
                            r)))))))
              (let
                (a
                  (if (integer? a) (list dg-path-find-default-combinator a)
                    (if (eqv? (q *) a) a (if (not a) (q *) #f))))
                (and a (continue (tail-or-null rest) (pair a r))))))
          path (list)))
      (and r (if (length-one? r) (list (first r) (q *)) (reverse r))))))